From 9885f52fd01f6516396571333c9d64589aae796e Mon Sep 17 00:00:00 2001 From: Alexander Bock Date: Sat, 4 Jan 2014 18:24:33 +0100 Subject: [PATCH] initial commit of transferred code from the old project --- .gitignore | 1 + .gitmodules | 3 + CMakeLists.txt | 106 + CREDITS | 3 + config/single.xml | 24 + ext/ghoul | 1 + ext/lua/CMakeLists.txt | 86 + ext/lua/include/lapi.h | 24 + ext/lua/include/lauxlib.h | 212 + ext/lua/include/lcode.h | 83 + ext/lua/include/lctype.h | 95 + ext/lua/include/ldebug.h | 34 + ext/lua/include/ldo.h | 46 + ext/lua/include/lfunc.h | 33 + ext/lua/include/lgc.h | 157 + ext/lua/include/llex.h | 78 + ext/lua/include/llimits.h | 309 + ext/lua/include/lmem.h | 57 + ext/lua/include/lobject.h | 607 + ext/lua/include/lopcodes.h | 288 + ext/lua/include/lparser.h | 119 + ext/lua/include/lstate.h | 228 + ext/lua/include/lstring.h | 46 + ext/lua/include/ltable.h | 45 + ext/lua/include/ltm.h | 57 + ext/lua/include/lua.h | 444 + ext/lua/include/lua.hpp | 9 + ext/lua/include/luaconf.h | 551 + ext/lua/include/lualib.h | 55 + ext/lua/include/lundump.h | 28 + ext/lua/include/lvm.h | 44 + ext/lua/include/lzio.h | 65 + ext/lua/src/lapi.c | 1284 ++ ext/lua/src/lauxlib.c | 959 ++ ext/lua/src/lbaselib.c | 458 + ext/lua/src/lbitlib.c | 212 + ext/lua/src/lcode.c | 881 + ext/lua/src/lcorolib.c | 155 + ext/lua/src/lctype.c | 52 + ext/lua/src/ldblib.c | 398 + ext/lua/src/ldebug.c | 593 + ext/lua/src/ldo.c | 681 + ext/lua/src/ldump.c | 173 + ext/lua/src/lfunc.c | 161 + ext/lua/src/lgc.c | 1220 ++ ext/lua/src/linit.c | 67 + ext/lua/src/liolib.c | 666 + ext/lua/src/llex.c | 530 + ext/lua/src/lmathlib.c | 279 + ext/lua/src/lmem.c | 99 + ext/lua/src/loadlib.c | 725 + ext/lua/src/lobject.c | 287 + ext/lua/src/lopcodes.c | 107 + ext/lua/src/loslib.c | 323 + ext/lua/src/lparser.c | 1638 ++ ext/lua/src/lstate.c | 323 + ext/lua/src/lstring.c | 185 + ext/lua/src/lstrlib.c | 1019 ++ ext/lua/src/ltable.c | 588 + ext/lua/src/ltablib.c | 283 + ext/lua/src/ltm.c | 77 + ext/lua/src/lundump.c | 258 + ext/lua/src/lvm.c | 867 + ext/lua/src/lzio.c | 76 + ext/spice/CMakeLists.txt | 28 + ext/spice/include/SpiceCK.h | 155 + ext/spice/include/SpiceCel.h | 441 + ext/spice/include/SpiceEK.h | 448 + ext/spice/include/SpiceEll.h | 115 + ext/spice/include/SpiceGF.h | 319 + ext/spice/include/SpicePln.h | 106 + ext/spice/include/SpiceSPK.h | 128 + ext/spice/include/SpiceUsr.h | 217 + ext/spice/include/SpiceZad.h | 205 + ext/spice/include/SpiceZdf.h | 246 + ext/spice/include/SpiceZfc.h | 13228 ++++++++++++++++ ext/spice/include/SpiceZim.h | 1358 ++ ext/spice/include/SpiceZmc.h | 975 ++ ext/spice/include/SpiceZpl.h | 109 + ext/spice/include/SpiceZpr.h | 3853 +++++ ext/spice/include/SpiceZst.h | 199 + ext/spice/include/f2c.h | 654 + ext/spice/include/f2cMang.h | 390 + ext/spice/include/fio.h | 107 + ext/spice/include/fmt.h | 100 + ext/spice/include/fp.h | 28 + ext/spice/include/lio.h | 74 + ext/spice/include/rawio.h | 41 + ext/spice/include/signal1.h | 118 + ext/spice/include/zzalloc.h | 125 + ext/spice/include/zzerror.h | 80 + ext/spice/src/cspice/F77_aloc.c | 32 + ext/spice/src/cspice/SpiceCK.h | 155 + ext/spice/src/cspice/SpiceCel.h | 441 + ext/spice/src/cspice/SpiceEK.h | 448 + ext/spice/src/cspice/SpiceEll.h | 115 + ext/spice/src/cspice/SpiceGF.h | 319 + ext/spice/src/cspice/SpicePln.h | 106 + ext/spice/src/cspice/SpiceSPK.h | 128 + ext/spice/src/cspice/SpiceUsr.h | 217 + ext/spice/src/cspice/SpiceZad.h | 205 + ext/spice/src/cspice/SpiceZdf.h | 246 + ext/spice/src/cspice/SpiceZfc.h | 13228 ++++++++++++++++ ext/spice/src/cspice/SpiceZim.h | 1358 ++ ext/spice/src/cspice/SpiceZmc.h | 975 ++ ext/spice/src/cspice/SpiceZpl.h | 109 + ext/spice/src/cspice/SpiceZpr.h | 3853 +++++ ext/spice/src/cspice/SpiceZst.h | 199 + ext/spice/src/cspice/abort_.c | 32 + ext/spice/src/cspice/accept.c | 318 + ext/spice/src/cspice/alltru.c | 154 + ext/spice/src/cspice/ana.c | 281 + ext/spice/src/cspice/appndc.c | 188 + ext/spice/src/cspice/appndc_c.c | 286 + ext/spice/src/cspice/appndd.c | 188 + ext/spice/src/cspice/appndd_c.c | 216 + ext/spice/src/cspice/appndi.c | 186 + ext/spice/src/cspice/appndi_c.c | 218 + ext/spice/src/cspice/approx.c | 144 + ext/spice/src/cspice/astrip.c | 239 + ext/spice/src/cspice/axisar.c | 255 + ext/spice/src/cspice/axisar_c.c | 226 + ext/spice/src/cspice/b1900.c | 126 + ext/spice/src/cspice/b1900_c.c | 136 + ext/spice/src/cspice/b1950.c | 144 + ext/spice/src/cspice/b1950_c.c | 154 + ext/spice/src/cspice/backspace.c | 69 + ext/spice/src/cspice/badkpv.c | 393 + ext/spice/src/cspice/badkpv_c.c | 281 + ext/spice/src/cspice/bedec.c | 278 + ext/spice/src/cspice/beint.c | 227 + ext/spice/src/cspice/benum.c | 214 + ext/spice/src/cspice/beuns.c | 225 + ext/spice/src/cspice/bodc2n.c | 265 + ext/spice/src/cspice/bodc2n_c.c | 313 + ext/spice/src/cspice/bodc2s.c | 249 + ext/spice/src/cspice/bodc2s_c.c | 262 + ext/spice/src/cspice/boddef.c | 301 + ext/spice/src/cspice/boddef_c.c | 319 + ext/spice/src/cspice/bodeul.c | 622 + ext/spice/src/cspice/bodfnd.c | 214 + ext/spice/src/cspice/bodfnd_c.c | 210 + ext/spice/src/cspice/bodmat.c | 842 + ext/spice/src/cspice/bodn2c.c | 286 + ext/spice/src/cspice/bodn2c_c.c | 317 + ext/spice/src/cspice/bods2c.c | 311 + ext/spice/src/cspice/bods2c_c.c | 296 + ext/spice/src/cspice/bodvar.c | 216 + ext/spice/src/cspice/bodvar_c.c | 209 + ext/spice/src/cspice/bodvcd.c | 314 + ext/spice/src/cspice/bodvcd_c.c | 270 + ext/spice/src/cspice/bodvrd.c | 368 + ext/spice/src/cspice/bodvrd_c.c | 299 + ext/spice/src/cspice/brcktd.c | 174 + ext/spice/src/cspice/brcktd_c.c | 183 + ext/spice/src/cspice/brckti.c | 174 + ext/spice/src/cspice/brckti_c.c | 183 + ext/spice/src/cspice/bschoc.c | 205 + ext/spice/src/cspice/bschoc_c.c | 317 + ext/spice/src/cspice/bschoi.c | 196 + ext/spice/src/cspice/bschoi_c.c | 231 + ext/spice/src/cspice/bsrchc.c | 201 + ext/spice/src/cspice/bsrchc_c.c | 304 + ext/spice/src/cspice/bsrchd.c | 189 + ext/spice/src/cspice/bsrchd_c.c | 161 + ext/spice/src/cspice/bsrchi.c | 189 + ext/spice/src/cspice/bsrchi_c.c | 160 + ext/spice/src/cspice/byebye.c | 170 + ext/spice/src/cspice/c_abs.c | 14 + ext/spice/src/cspice/c_cos.c | 17 + ext/spice/src/cspice/c_div.c | 37 + ext/spice/src/cspice/c_exp.c | 19 + ext/spice/src/cspice/c_log.c | 17 + ext/spice/src/cspice/c_sin.c | 17 + ext/spice/src/cspice/c_sqrt.c | 35 + ext/spice/src/cspice/cabs.c | 103 + ext/spice/src/cspice/card_c.c | 228 + ext/spice/src/cspice/cardc.c | 225 + ext/spice/src/cspice/cardd.c | 223 + ext/spice/src/cspice/cardi.c | 218 + ext/spice/src/cspice/cgv2el.c | 194 + ext/spice/src/cspice/cgv2el_c.c | 179 + ext/spice/src/cspice/chbase.c | 401 + ext/spice/src/cspice/chbder.c | 389 + ext/spice/src/cspice/chbint.c | 315 + ext/spice/src/cspice/chbval.c | 285 + ext/spice/src/cspice/chckid.c | 276 + ext/spice/src/cspice/chgirf.c | 1601 ++ ext/spice/src/cspice/chkin_c.c | 218 + ext/spice/src/cspice/chkout_c.c | 215 + ext/spice/src/cspice/cidfrm_c.c | 216 + ext/spice/src/cspice/ckbsr.c | 4222 +++++ ext/spice/src/cspice/ckcls.c | 209 + ext/spice/src/cspice/ckcls_c.c | 148 + ext/spice/src/cspice/ckcov.c | 902 ++ ext/spice/src/cspice/ckcov_c.c | 648 + ext/spice/src/cspice/cke01.c | 387 + ext/spice/src/cspice/cke02.c | 389 + ext/spice/src/cspice/cke03.c | 545 + ext/spice/src/cspice/cke04.c | 566 + ext/spice/src/cspice/cke05.c | 1067 ++ ext/spice/src/cspice/ckfrot.c | 290 + ext/spice/src/cspice/ckfxfm.c | 351 + ext/spice/src/cspice/ckgp.c | 1026 ++ ext/spice/src/cspice/ckgp_c.c | 721 + ext/spice/src/cspice/ckgpav.c | 1208 ++ ext/spice/src/cspice/ckgpav_c.c | 759 + ext/spice/src/cspice/ckgr01.c | 403 + ext/spice/src/cspice/ckgr02.c | 359 + ext/spice/src/cspice/ckgr03.c | 396 + ext/spice/src/cspice/ckgr04.c | 534 + ext/spice/src/cspice/ckgr05.c | 521 + ext/spice/src/cspice/cklpf_c.c | 190 + ext/spice/src/cspice/ckmeta.c | 419 + ext/spice/src/cspice/cknr01.c | 325 + ext/spice/src/cspice/cknr02.c | 318 + ext/spice/src/cspice/cknr03.c | 324 + ext/spice/src/cspice/cknr04.c | 433 + ext/spice/src/cspice/cknr05.c | 304 + ext/spice/src/cspice/ckobj.c | 433 + ext/spice/src/cspice/ckobj_c.c | 348 + ext/spice/src/cspice/ckopn.c | 212 + ext/spice/src/cspice/ckopn_c.c | 194 + ext/spice/src/cspice/ckpfs.c | 622 + ext/spice/src/cspice/ckr01.c | 602 + ext/spice/src/cspice/ckr02.c | 659 + ext/spice/src/cspice/ckr03.c | 995 ++ ext/spice/src/cspice/ckr04.c | 783 + ext/spice/src/cspice/ckr05.c | 1251 ++ ext/spice/src/cspice/ckupf_c.c | 146 + ext/spice/src/cspice/ckw01.c | 772 + ext/spice/src/cspice/ckw01_c.c | 546 + ext/spice/src/cspice/ckw02.c | 839 + ext/spice/src/cspice/ckw02_c.c | 544 + ext/spice/src/cspice/ckw03.c | 951 ++ ext/spice/src/cspice/ckw03_c.c | 667 + ext/spice/src/cspice/ckw04a.c | 764 + ext/spice/src/cspice/ckw04b.c | 948 ++ ext/spice/src/cspice/ckw04e.c | 328 + ext/spice/src/cspice/ckw05.c | 1112 ++ ext/spice/src/cspice/ckw05_c.c | 701 + ext/spice/src/cspice/clearc.c | 139 + ext/spice/src/cspice/cleard.c | 136 + ext/spice/src/cspice/cleari.c | 136 + ext/spice/src/cspice/clight.c | 156 + ext/spice/src/cspice/clight_c.c | 146 + ext/spice/src/cspice/close.c | 94 + ext/spice/src/cspice/clpool_c.c | 179 + ext/spice/src/cspice/cmprss.c | 204 + ext/spice/src/cspice/cmprss_c.c | 278 + ext/spice/src/cspice/cnmfrm_c.c | 223 + ext/spice/src/cspice/conics.c | 436 + ext/spice/src/cspice/conics_c.c | 203 + ext/spice/src/cspice/convrt.c | 414 + ext/spice/src/cspice/convrt_c.c | 248 + ext/spice/src/cspice/copy_c.c | 272 + ext/spice/src/cspice/copyc.c | 263 + ext/spice/src/cspice/copyd.c | 199 + ext/spice/src/cspice/copyi.c | 200 + ext/spice/src/cspice/countc.c | 319 + ext/spice/src/cspice/cpos.c | 226 + ext/spice/src/cspice/cpos_c.c | 226 + ext/spice/src/cspice/cposr.c | 234 + ext/spice/src/cspice/cposr_c.c | 230 + ext/spice/src/cspice/cvpool_c.c | 245 + ext/spice/src/cspice/cyacip.c | 286 + ext/spice/src/cspice/cyadip.c | 239 + ext/spice/src/cspice/cyaiip.c | 238 + ext/spice/src/cspice/cyclac.c | 322 + ext/spice/src/cspice/cyclad.c | 267 + ext/spice/src/cspice/cyclai.c | 265 + ext/spice/src/cspice/cyclec.c | 325 + ext/spice/src/cspice/cyllat.c | 206 + ext/spice/src/cspice/cyllat_c.c | 211 + ext/spice/src/cspice/cylrec.c | 183 + ext/spice/src/cspice/cylrec_c.c | 182 + ext/spice/src/cspice/cylsph.c | 190 + ext/spice/src/cspice/cylsph_c.c | 197 + ext/spice/src/cspice/d_abs.c | 12 + ext/spice/src/cspice/d_acos.c | 13 + ext/spice/src/cspice/d_asin.c | 13 + ext/spice/src/cspice/d_atan.c | 13 + ext/spice/src/cspice/d_atn2.c | 13 + ext/spice/src/cspice/d_cnjg.c | 12 + ext/spice/src/cspice/d_cos.c | 13 + ext/spice/src/cspice/d_cosh.c | 13 + ext/spice/src/cspice/d_dim.c | 10 + ext/spice/src/cspice/d_exp.c | 13 + ext/spice/src/cspice/d_imag.c | 10 + ext/spice/src/cspice/d_int.c | 13 + ext/spice/src/cspice/d_lg10.c | 15 + ext/spice/src/cspice/d_log.c | 13 + ext/spice/src/cspice/d_mod.c | 40 + ext/spice/src/cspice/d_nint.c | 14 + ext/spice/src/cspice/d_prod.c | 10 + ext/spice/src/cspice/d_sign.c | 12 + ext/spice/src/cspice/d_sin.c | 13 + ext/spice/src/cspice/d_sinh.c | 13 + ext/spice/src/cspice/d_sqrt.c | 13 + ext/spice/src/cspice/d_tan.c | 13 + ext/spice/src/cspice/d_tanh.c | 13 + ext/spice/src/cspice/dacosh.c | 178 + ext/spice/src/cspice/dacosn.c | 176 + ext/spice/src/cspice/dafa2b.c | 271 + ext/spice/src/cspice/dafac.c | 720 + ext/spice/src/cspice/dafac_c.c | 258 + ext/spice/src/cspice/dafah.c | 4965 ++++++ ext/spice/src/cspice/dafana.c | 2457 +++ ext/spice/src/cspice/dafarr.c | 477 + ext/spice/src/cspice/dafb2a.c | 263 + ext/spice/src/cspice/dafb2t.c | 864 + ext/spice/src/cspice/dafbbs_c.c | 246 + ext/spice/src/cspice/dafbfs_c.c | 247 + ext/spice/src/cspice/dafbt.c | 917 ++ ext/spice/src/cspice/dafcls_c.c | 180 + ext/spice/src/cspice/dafcs_c.c | 256 + ext/spice/src/cspice/dafdc.c | 206 + ext/spice/src/cspice/dafdc_c.c | 156 + ext/spice/src/cspice/dafec.c | 846 + ext/spice/src/cspice/dafec_c.c | 302 + ext/spice/src/cspice/daffa.c | 4239 +++++ ext/spice/src/cspice/daffna_c.c | 263 + ext/spice/src/cspice/daffpa_c.c | 265 + ext/spice/src/cspice/dafgda.c | 244 + ext/spice/src/cspice/dafgda_c.c | 193 + ext/spice/src/cspice/dafgn_c.c | 290 + ext/spice/src/cspice/dafgs_c.c | 261 + ext/spice/src/cspice/dafgsr_c.c | 208 + ext/spice/src/cspice/dafopr_c.c | 205 + ext/spice/src/cspice/dafopw_c.c | 308 + ext/spice/src/cspice/dafps.c | 367 + ext/spice/src/cspice/dafps_c.c | 243 + ext/spice/src/cspice/dafra.c | 365 + ext/spice/src/cspice/dafrcr.c | 256 + ext/spice/src/cspice/dafrda.c | 318 + ext/spice/src/cspice/dafrda_c.c | 211 + ext/spice/src/cspice/dafrfr.c | 280 + ext/spice/src/cspice/dafrfr_c.c | 228 + ext/spice/src/cspice/dafrrr.c | 392 + ext/spice/src/cspice/dafrs_c.c | 228 + ext/spice/src/cspice/dafrwa.c | 316 + ext/spice/src/cspice/dafrwd.c | 2304 +++ ext/spice/src/cspice/daft2b.c | 815 + ext/spice/src/cspice/daftb.c | 900 ++ ext/spice/src/cspice/dafus_c.c | 197 + ext/spice/src/cspice/dafwcr.c | 240 + ext/spice/src/cspice/dafwda.c | 262 + ext/spice/src/cspice/dafwfr.c | 478 + ext/spice/src/cspice/dasa2l.c | 1042 ++ ext/spice/src/cspice/dasac.c | 548 + ext/spice/src/cspice/dasac_c.c | 273 + ext/spice/src/cspice/dasacr.c | 502 + ext/spice/src/cspice/dasacu.c | 799 + ext/spice/src/cspice/dasadc.c | 532 + ext/spice/src/cspice/dasadd.c | 412 + ext/spice/src/cspice/dasadi.c | 391 + ext/spice/src/cspice/dasbt.c | 1311 ++ ext/spice/src/cspice/dascls.c | 363 + ext/spice/src/cspice/dascls_c.c | 202 + ext/spice/src/cspice/dascud.c | 828 + ext/spice/src/cspice/dasdc.c | 251 + ext/spice/src/cspice/dasec.c | 752 + ext/spice/src/cspice/dasec_c.c | 306 + ext/spice/src/cspice/dasecu.c | 235 + ext/spice/src/cspice/dasfm.c | 6452 ++++++++ ext/spice/src/cspice/dasine.c | 176 + ext/spice/src/cspice/dasioc.c | 299 + ext/spice/src/cspice/dasiod.c | 301 + ext/spice/src/cspice/dasioi.c | 297 + ext/spice/src/cspice/daslla.c | 204 + ext/spice/src/cspice/dasopr_c.c | 180 + ext/spice/src/cspice/dasrcr.c | 465 + ext/spice/src/cspice/dasrdc.c | 480 + ext/spice/src/cspice/dasrdd.c | 328 + ext/spice/src/cspice/dasrdi.c | 325 + ext/spice/src/cspice/dasrfr.c | 322 + ext/spice/src/cspice/dasrwr.c | 3906 +++++ ext/spice/src/cspice/dassdr.c | 948 ++ ext/spice/src/cspice/dastb.c | 2249 +++ ext/spice/src/cspice/dasudc.c | 477 + ext/spice/src/cspice/dasudd.c | 393 + ext/spice/src/cspice/dasudi.c | 389 + ext/spice/src/cspice/daswfr.c | 474 + ext/spice/src/cspice/datanh.c | 176 + ext/spice/src/cspice/dcbrt.c | 142 + ext/spice/src/cspice/dcyldr.c | 251 + ext/spice/src/cspice/dcyldr_c.c | 213 + ext/spice/src/cspice/delfil.c | 286 + ext/spice/src/cspice/deltet.c | 424 + ext/spice/src/cspice/deltet_c.c | 211 + ext/spice/src/cspice/derf_.c | 12 + ext/spice/src/cspice/derfc_.c | 14 + ext/spice/src/cspice/det.c | 134 + ext/spice/src/cspice/det_c.c | 134 + ext/spice/src/cspice/dfe.c | 141 + ext/spice/src/cspice/dgeodr.c | 288 + ext/spice/src/cspice/dgeodr_c.c | 237 + ext/spice/src/cspice/dhfa.c | 346 + ext/spice/src/cspice/diags2.c | 574 + ext/spice/src/cspice/diags2_c.c | 551 + ext/spice/src/cspice/diff_c.c | 358 + ext/spice/src/cspice/diffc.c | 310 + ext/spice/src/cspice/diffd.c | 268 + ext/spice/src/cspice/diffi.c | 267 + ext/spice/src/cspice/dlatdr.c | 253 + ext/spice/src/cspice/dlatdr_c.c | 218 + ext/spice/src/cspice/dnearp.c | 528 + ext/spice/src/cspice/dolio.c | 20 + ext/spice/src/cspice/dp2hx.c | 568 + ext/spice/src/cspice/dp2hx_c.c | 275 + ext/spice/src/cspice/dpfmt.c | 623 + ext/spice/src/cspice/dpgrdr.c | 674 + ext/spice/src/cspice/dpgrdr_c.c | 555 + ext/spice/src/cspice/dpmax.c | 170 + ext/spice/src/cspice/dpmax_c.c | 185 + ext/spice/src/cspice/dpmin.c | 150 + ext/spice/src/cspice/dpmin_c.c | 163 + ext/spice/src/cspice/dpr.c | 158 + ext/spice/src/cspice/dpr_c.c | 141 + ext/spice/src/cspice/dpspce.c | 795 + ext/spice/src/cspice/dpstr.c | 472 + ext/spice/src/cspice/dpstrf.c | 366 + ext/spice/src/cspice/drdcyl.c | 211 + ext/spice/src/cspice/drdcyl_c.c | 215 + ext/spice/src/cspice/drdgeo.c | 449 + ext/spice/src/cspice/drdgeo_c.c | 253 + ext/spice/src/cspice/drdlat.c | 212 + ext/spice/src/cspice/drdlat_c.c | 213 + ext/spice/src/cspice/drdpgr.c | 696 + ext/spice/src/cspice/drdpgr_c.c | 577 + ext/spice/src/cspice/drdsph.c | 224 + ext/spice/src/cspice/drdsph_c.c | 220 + ext/spice/src/cspice/drotat.c | 253 + ext/spice/src/cspice/dsphdr.c | 252 + ext/spice/src/cspice/dsphdr_c.c | 218 + ext/spice/src/cspice/dtime_.c | 128 + ext/spice/src/cspice/dtpool_c.c | 222 + ext/spice/src/cspice/ducrss.c | 194 + ext/spice/src/cspice/ducrss_c.c | 189 + ext/spice/src/cspice/due.c | 70 + ext/spice/src/cspice/dvcrss.c | 166 + ext/spice/src/cspice/dvcrss_c.c | 175 + ext/spice/src/cspice/dvdot.c | 158 + ext/spice/src/cspice/dvdot_c.c | 159 + ext/spice/src/cspice/dvhat.c | 249 + ext/spice/src/cspice/dvhat_c.c | 271 + ext/spice/src/cspice/dvnorm.c | 254 + ext/spice/src/cspice/dvnorm_c.c | 227 + ext/spice/src/cspice/dvpool_c.c | 161 + ext/spice/src/cspice/dvsep.c | 349 + ext/spice/src/cspice/dvsep_c.c | 239 + ext/spice/src/cspice/dxtrct.c | 363 + ext/spice/src/cspice/edlimb.c | 446 + ext/spice/src/cspice/edlimb_c.c | 406 + ext/spice/src/cspice/edterm.c | 766 + ext/spice/src/cspice/ef1asc_.c | 35 + ext/spice/src/cspice/ef1cmc_.c | 14 + ext/spice/src/cspice/ekacec.c | 683 + ext/spice/src/cspice/ekacec_c.c | 487 + ext/spice/src/cspice/ekaced.c | 686 + ext/spice/src/cspice/ekaced_c.c | 392 + ext/spice/src/cspice/ekacei.c | 688 + ext/spice/src/cspice/ekacei_c.c | 389 + ext/spice/src/cspice/ekaclc.c | 730 + ext/spice/src/cspice/ekaclc_c.c | 696 + ext/spice/src/cspice/ekacld.c | 728 + ext/spice/src/cspice/ekacld_c.c | 555 + ext/spice/src/cspice/ekacli.c | 727 + ext/spice/src/cspice/ekacli_c.c | 555 + ext/spice/src/cspice/ekappr.c | 838 + ext/spice/src/cspice/ekappr_c.c | 294 + ext/spice/src/cspice/ekbseg.c | 1384 ++ ext/spice/src/cspice/ekbseg_c.c | 548 + ext/spice/src/cspice/ekccnt_c.c | 273 + ext/spice/src/cspice/ekcii_c.c | 354 + ext/spice/src/cspice/ekcls.c | 157 + ext/spice/src/cspice/ekcls_c.c | 151 + ext/spice/src/cspice/ekdelr.c | 734 + ext/spice/src/cspice/ekdelr_c.c | 211 + ext/spice/src/cspice/ekffld.c | 480 + ext/spice/src/cspice/ekffld_c.c | 416 + ext/spice/src/cspice/ekfind.c | 1333 ++ ext/spice/src/cspice/ekfind_c.c | 674 + ext/spice/src/cspice/ekgc_c.c | 435 + ext/spice/src/cspice/ekgd_c.c | 408 + ext/spice/src/cspice/ekgi_c.c | 411 + ext/spice/src/cspice/ekifld.c | 714 + ext/spice/src/cspice/ekifld_c.c | 677 + ext/spice/src/cspice/ekinsr.c | 1094 ++ ext/spice/src/cspice/ekinsr_c.c | 294 + ext/spice/src/cspice/eklef_c.c | 221 + ext/spice/src/cspice/eknelt_c.c | 344 + ext/spice/src/cspice/eknseg.c | 238 + ext/spice/src/cspice/eknseg_c.c | 156 + ext/spice/src/cspice/ekntab_c.c | 151 + ext/spice/src/cspice/ekopn.c | 356 + ext/spice/src/cspice/ekopn_c.c | 190 + ext/spice/src/cspice/ekopr.c | 172 + ext/spice/src/cspice/ekopr_c.c | 176 + ext/spice/src/cspice/ekops.c | 311 + ext/spice/src/cspice/ekops_c.c | 152 + ext/spice/src/cspice/ekopw.c | 215 + ext/spice/src/cspice/ekopw_c.c | 213 + ext/spice/src/cspice/ekpsel.c | 1150 ++ ext/spice/src/cspice/ekpsel_c.c | 796 + ext/spice/src/cspice/ekqmgr.c | 7491 +++++++++ ext/spice/src/cspice/ekrcec.c | 597 + ext/spice/src/cspice/ekrcec_c.c | 289 + ext/spice/src/cspice/ekrced.c | 579 + ext/spice/src/cspice/ekrced_c.c | 237 + ext/spice/src/cspice/ekrcei.c | 578 + ext/spice/src/cspice/ekrcei_c.c | 229 + ext/spice/src/cspice/ekshdw.c | 125 + ext/spice/src/cspice/ekssum.c | 722 + ext/spice/src/cspice/ekssum_c.c | 446 + ext/spice/src/cspice/ektnam_c.c | 198 + ext/spice/src/cspice/ekucec.c | 600 + ext/spice/src/cspice/ekucec_c.c | 357 + ext/spice/src/cspice/ekuced.c | 600 + ext/spice/src/cspice/ekuced_c.c | 294 + ext/spice/src/cspice/ekucei.c | 595 + ext/spice/src/cspice/ekucei_c.c | 287 + ext/spice/src/cspice/ekuef_c.c | 145 + ext/spice/src/cspice/el2cgv.c | 185 + ext/spice/src/cspice/el2cgv_c.c | 179 + ext/spice/src/cspice/elemc.c | 190 + ext/spice/src/cspice/elemc_c.c | 206 + ext/spice/src/cspice/elemd.c | 191 + ext/spice/src/cspice/elemd_c.c | 170 + ext/spice/src/cspice/elemi.c | 190 + ext/spice/src/cspice/elemi_c.c | 173 + ext/spice/src/cspice/elltof.c | 346 + ext/spice/src/cspice/enchar.c | 400 + ext/spice/src/cspice/endfile.c | 119 + ext/spice/src/cspice/eqchr.c | 515 + ext/spice/src/cspice/eqncpv.c | 548 + ext/spice/src/cspice/eqstr.c | 387 + ext/spice/src/cspice/eqstr_c.c | 487 + ext/spice/src/cspice/erf_.c | 12 + ext/spice/src/cspice/erfc_.c | 12 + ext/spice/src/cspice/err.c | 270 + ext/spice/src/cspice/erract.c | 495 + ext/spice/src/cspice/erract_c.c | 432 + ext/spice/src/cspice/errch.c | 445 + ext/spice/src/cspice/errch_c.c | 247 + ext/spice/src/cspice/errdev.c | 420 + ext/spice/src/cspice/errdev_c.c | 277 + ext/spice/src/cspice/errdp.c | 381 + ext/spice/src/cspice/errdp_c.c | 208 + ext/spice/src/cspice/errfnm.c | 271 + ext/spice/src/cspice/errhan.c | 438 + ext/spice/src/cspice/errint.c | 354 + ext/spice/src/cspice/errint_c.c | 206 + ext/spice/src/cspice/errprt.c | 479 + ext/spice/src/cspice/errprt_c.c | 376 + ext/spice/src/cspice/esrchc.c | 173 + ext/spice/src/cspice/esrchc_c.c | 230 + ext/spice/src/cspice/et2lst.c | 592 + ext/spice/src/cspice/et2lst_c.c | 389 + ext/spice/src/cspice/et2utc.c | 816 + ext/spice/src/cspice/et2utc_c.c | 370 + ext/spice/src/cspice/etcal.c | 630 + ext/spice/src/cspice/etcal_c.c | 255 + ext/spice/src/cspice/etime_.c | 121 + ext/spice/src/cspice/eul2m.c | 484 + ext/spice/src/cspice/eul2m_c.c | 414 + ext/spice/src/cspice/eul2xf_c.c | 367 + ext/spice/src/cspice/ev2lin.c | 1268 ++ ext/spice/src/cspice/even.c | 146 + ext/spice/src/cspice/exact.c | 140 + ext/spice/src/cspice/excess.c | 242 + ext/spice/src/cspice/exists.c | 264 + ext/spice/src/cspice/exists_c.c | 179 + ext/spice/src/cspice/exit_.c | 37 + ext/spice/src/cspice/expln.c | 332 + ext/spice/src/cspice/expool_c.c | 183 + ext/spice/src/cspice/f2c.h | 654 + ext/spice/src/cspice/f2cMang.h | 390 + ext/spice/src/cspice/failed_c.c | 254 + ext/spice/src/cspice/fetchc.c | 222 + ext/spice/src/cspice/fetchd.c | 227 + ext/spice/src/cspice/fetchi.c | 227 + ext/spice/src/cspice/fillc.c | 145 + ext/spice/src/cspice/filld.c | 143 + ext/spice/src/cspice/filli.c | 142 + ext/spice/src/cspice/fio.h | 107 + ext/spice/src/cspice/fmt.c | 516 + ext/spice/src/cspice/fmt.h | 100 + ext/spice/src/cspice/fmtlib.c | 45 + ext/spice/src/cspice/fn2lun.c | 227 + ext/spice/src/cspice/fndlun.c | 1037 ++ ext/spice/src/cspice/fndnwd.c | 224 + ext/spice/src/cspice/fp.h | 28 + ext/spice/src/cspice/frame.c | 285 + ext/spice/src/cspice/frame_c.c | 270 + ext/spice/src/cspice/framex.c | 2589 +++ ext/spice/src/cspice/frinfo_c.c | 196 + ext/spice/src/cspice/frmchg.c | 875 + ext/spice/src/cspice/frmget.c | 360 + ext/spice/src/cspice/frmnam_c.c | 238 + ext/spice/src/cspice/frstnb.c | 159 + ext/spice/src/cspice/frstnp.c | 178 + ext/spice/src/cspice/frstpc.c | 185 + ext/spice/src/cspice/ftell_.c | 46 + ext/spice/src/cspice/ftncls_c.c | 219 + ext/spice/src/cspice/furnsh_c.c | 383 + ext/spice/src/cspice/gcd.c | 176 + ext/spice/src/cspice/gcpool_c.c | 359 + ext/spice/src/cspice/gdpool_c.c | 306 + ext/spice/src/cspice/georec.c | 340 + ext/spice/src/cspice/georec_c.c | 257 + ext/spice/src/cspice/getcml_c.c | 179 + ext/spice/src/cspice/getelm.c | 306 + ext/spice/src/cspice/getelm_c.c | 443 + ext/spice/src/cspice/getenv_.c | 194 + ext/spice/src/cspice/getfat.c | 1197 ++ ext/spice/src/cspice/getfat_c.c | 282 + ext/spice/src/cspice/getfov.c | 1319 ++ ext/spice/src/cspice/getfov_c.c | 624 + ext/spice/src/cspice/getlun.c | 240 + ext/spice/src/cspice/getmsg.c | 309 + ext/spice/src/cspice/getmsg_c.c | 282 + ext/spice/src/cspice/gfbail.c | 215 + ext/spice/src/cspice/gfbail_c.c | 189 + ext/spice/src/cspice/gfclrh_c.c | 186 + ext/spice/src/cspice/gfdist.c | 1382 ++ ext/spice/src/cspice/gfdist_c.c | 1139 ++ ext/spice/src/cspice/gfevnt.c | 2414 +++ ext/spice/src/cspice/gfevnt_c.c | 1561 ++ ext/spice/src/cspice/gffove.c | 1708 ++ ext/spice/src/cspice/gffove_c.c | 1638 ++ ext/spice/src/cspice/gfinth_c.c | 233 + ext/spice/src/cspice/gfocce.c | 1267 ++ ext/spice/src/cspice/gfocce_c.c | 1247 ++ ext/spice/src/cspice/gfoclt.c | 1342 ++ ext/spice/src/cspice/gfoclt_c.c | 1172 ++ ext/spice/src/cspice/gfposc.c | 1556 ++ ext/spice/src/cspice/gfposc_c.c | 1039 ++ ext/spice/src/cspice/gfrefn.c | 168 + ext/spice/src/cspice/gfrefn_c.c | 183 + ext/spice/src/cspice/gfrepf_c.c | 206 + ext/spice/src/cspice/gfrepi_c.c | 291 + ext/spice/src/cspice/gfrepu_c.c | 238 + ext/spice/src/cspice/gfrfov.c | 1085 ++ ext/spice/src/cspice/gfrfov_c.c | 898 ++ ext/spice/src/cspice/gfrprt.c | 1121 ++ ext/spice/src/cspice/gfrr.c | 1253 ++ ext/spice/src/cspice/gfrr_c.c | 889 ++ ext/spice/src/cspice/gfsep.c | 1332 ++ ext/spice/src/cspice/gfsep_c.c | 1015 ++ ext/spice/src/cspice/gfsntc.c | 1708 ++ ext/spice/src/cspice/gfsntc_c.c | 1300 ++ ext/spice/src/cspice/gfsstp_c.c | 174 + ext/spice/src/cspice/gfstep.c | 340 + ext/spice/src/cspice/gfstep_c.c | 186 + ext/spice/src/cspice/gfsubc.c | 1588 ++ ext/spice/src/cspice/gfsubc_c.c | 1086 ++ ext/spice/src/cspice/gftfov.c | 1098 ++ ext/spice/src/cspice/gftfov_c.c | 904 ++ ext/spice/src/cspice/gfuds.c | 1303 ++ ext/spice/src/cspice/gfuds_c.c | 957 ++ ext/spice/src/cspice/gipool_c.c | 306 + ext/spice/src/cspice/gnpool_c.c | 380 + ext/spice/src/cspice/h_abs.c | 12 + ext/spice/src/cspice/h_dim.c | 10 + ext/spice/src/cspice/h_dnnt.c | 13 + ext/spice/src/cspice/h_indx.c | 26 + ext/spice/src/cspice/h_len.c | 10 + ext/spice/src/cspice/h_mod.c | 10 + ext/spice/src/cspice/h_nint.c | 13 + ext/spice/src/cspice/h_sign.c | 12 + ext/spice/src/cspice/halfpi.c | 175 + ext/spice/src/cspice/halfpi_c.c | 163 + ext/spice/src/cspice/hl_ge.c | 12 + ext/spice/src/cspice/hl_gt.c | 12 + ext/spice/src/cspice/hl_le.c | 12 + ext/spice/src/cspice/hl_lt.c | 12 + ext/spice/src/cspice/hrmesp.c | 484 + ext/spice/src/cspice/hrmint.c | 486 + ext/spice/src/cspice/hx2dp.c | 730 + ext/spice/src/cspice/hx2dp_c.c | 293 + ext/spice/src/cspice/hx2int.c | 552 + ext/spice/src/cspice/hyptof.c | 426 + ext/spice/src/cspice/i_abs.c | 12 + ext/spice/src/cspice/i_dim.c | 10 + ext/spice/src/cspice/i_dnnt.c | 13 + ext/spice/src/cspice/i_indx.c | 26 + ext/spice/src/cspice/i_len.c | 10 + ext/spice/src/cspice/i_mod.c | 10 + ext/spice/src/cspice/i_nint.c | 13 + ext/spice/src/cspice/i_sign.c | 12 + ext/spice/src/cspice/ident.c | 139 + ext/spice/src/cspice/ident_c.c | 149 + ext/spice/src/cspice/idw2at.c | 385 + ext/spice/src/cspice/iio.c | 148 + ext/spice/src/cspice/illum.c | 748 + ext/spice/src/cspice/illum_c.c | 625 + ext/spice/src/cspice/ilnw.c | 77 + ext/spice/src/cspice/ilumin.c | 1396 ++ ext/spice/src/cspice/ilumin_c.c | 800 + ext/spice/src/cspice/inedpl.c | 521 + ext/spice/src/cspice/inedpl_c.c | 459 + ext/spice/src/cspice/inelpl.c | 565 + ext/spice/src/cspice/inelpl_c.c | 585 + ext/spice/src/cspice/inquire.c | 106 + ext/spice/src/cspice/inrypl.c | 791 + ext/spice/src/cspice/inrypl_c.c | 838 + ext/spice/src/cspice/inslac.c | 267 + ext/spice/src/cspice/inslad.c | 259 + ext/spice/src/cspice/inslai.c | 259 + ext/spice/src/cspice/insrtc.c | 270 + ext/spice/src/cspice/insrtc_c.c | 307 + ext/spice/src/cspice/insrtd.c | 236 + ext/spice/src/cspice/insrtd_c.c | 261 + ext/spice/src/cspice/insrti.c | 236 + ext/spice/src/cspice/insrti_c.c | 242 + ext/spice/src/cspice/inssub.c | 303 + ext/spice/src/cspice/int2hx.c | 334 + ext/spice/src/cspice/inter_c.c | 350 + ext/spice/src/cspice/interc.c | 297 + ext/spice/src/cspice/interd.c | 252 + ext/spice/src/cspice/interi.c | 252 + ext/spice/src/cspice/intmax.c | 255 + ext/spice/src/cspice/intmax_c.c | 209 + ext/spice/src/cspice/intmin.c | 257 + ext/spice/src/cspice/intmin_c.c | 204 + ext/spice/src/cspice/intord.c | 229 + ext/spice/src/cspice/intstr.c | 262 + ext/spice/src/cspice/inttxt.c | 291 + ext/spice/src/cspice/invert.c | 195 + ext/spice/src/cspice/invert_c.c | 212 + ext/spice/src/cspice/invort.c | 257 + ext/spice/src/cspice/invort_c.c | 194 + ext/spice/src/cspice/invstm.c | 219 + ext/spice/src/cspice/ioerr.c | 250 + ext/spice/src/cspice/irftrn.c | 206 + ext/spice/src/cspice/iso2utc.c | 446 + ext/spice/src/cspice/isopen.c | 213 + ext/spice/src/cspice/isordv.c | 297 + ext/spice/src/cspice/isordv_c.c | 245 + ext/spice/src/cspice/isrchc.c | 155 + ext/spice/src/cspice/isrchc_c.c | 239 + ext/spice/src/cspice/isrchd.c | 155 + ext/spice/src/cspice/isrchd_c.c | 157 + ext/spice/src/cspice/isrchi.c | 150 + ext/spice/src/cspice/isrchi_c.c | 156 + ext/spice/src/cspice/isrot.c | 296 + ext/spice/src/cspice/isrot_c.c | 285 + ext/spice/src/cspice/iswhsp_c.c | 205 + ext/spice/src/cspice/j1900.c | 126 + ext/spice/src/cspice/j1900_c.c | 120 + ext/spice/src/cspice/j1950.c | 126 + ext/spice/src/cspice/j1950_c.c | 120 + ext/spice/src/cspice/j2000.c | 126 + ext/spice/src/cspice/j2000_c.c | 134 + ext/spice/src/cspice/j2100.c | 126 + ext/spice/src/cspice/j2100_c.c | 122 + ext/spice/src/cspice/jul2gr.c | 796 + ext/spice/src/cspice/jyear.c | 128 + ext/spice/src/cspice/jyear_c.c | 126 + ext/spice/src/cspice/kclear_c.c | 163 + ext/spice/src/cspice/kdata_c.c | 355 + ext/spice/src/cspice/keeper.c | 2812 ++++ ext/spice/src/cspice/kepleq.c | 234 + ext/spice/src/cspice/kinfo_c.c | 314 + ext/spice/src/cspice/kpsolv.c | 292 + ext/spice/src/cspice/ktotal_c.c | 196 + ext/spice/src/cspice/kxtrct.c | 335 + ext/spice/src/cspice/kxtrct_c.c | 385 + ext/spice/src/cspice/l_ge.c | 12 + ext/spice/src/cspice/l_gt.c | 12 + ext/spice/src/cspice/l_le.c | 12 + ext/spice/src/cspice/l_lt.c | 12 + ext/spice/src/cspice/lastnb.c | 162 + ext/spice/src/cspice/lastnb_c.c | 173 + ext/spice/src/cspice/lastpc.c | 184 + ext/spice/src/cspice/latcyl.c | 173 + ext/spice/src/cspice/latcyl_c.c | 170 + ext/spice/src/cspice/latrec.c | 208 + ext/spice/src/cspice/latrec_c.c | 188 + ext/spice/src/cspice/latsph.c | 178 + ext/spice/src/cspice/latsph_c.c | 180 + ext/spice/src/cspice/lbitbits.c | 62 + ext/spice/src/cspice/lbitshft.c | 11 + ext/spice/src/cspice/lbuild.c | 235 + ext/spice/src/cspice/lcase.c | 184 + ext/spice/src/cspice/lcase_c.c | 218 + ext/spice/src/cspice/ldpool_c.c | 203 + ext/spice/src/cspice/lgresp.c | 427 + ext/spice/src/cspice/lgrind.c | 455 + ext/spice/src/cspice/lgrint.c | 392 + ext/spice/src/cspice/lio.h | 74 + ext/spice/src/cspice/ljust.c | 173 + ext/spice/src/cspice/lmpool_c.c | 260 + ext/spice/src/cspice/lnkan.c | 239 + ext/spice/src/cspice/lnkfsl.c | 376 + ext/spice/src/cspice/lnkhl.c | 255 + ext/spice/src/cspice/lnkila.c | 317 + ext/spice/src/cspice/lnkilb.c | 318 + ext/spice/src/cspice/lnkini.c | 242 + ext/spice/src/cspice/lnknfn.c | 179 + ext/spice/src/cspice/lnknxt.c | 255 + ext/spice/src/cspice/lnkprv.c | 255 + ext/spice/src/cspice/lnksiz.c | 170 + ext/spice/src/cspice/lnktl.c | 267 + ext/spice/src/cspice/lnkxsl.c | 366 + ext/spice/src/cspice/locati.c | 498 + ext/spice/src/cspice/locln.c | 606 + ext/spice/src/cspice/lparse.c | 332 + ext/spice/src/cspice/lparse_c.c | 300 + ext/spice/src/cspice/lparsm.c | 350 + ext/spice/src/cspice/lparsm_c.c | 295 + ext/spice/src/cspice/lparss.c | 487 + ext/spice/src/cspice/lparss_c.c | 299 + ext/spice/src/cspice/lread.c | 700 + ext/spice/src/cspice/lspcn.c | 404 + ext/spice/src/cspice/lspcn_c.c | 314 + ext/spice/src/cspice/lstcld.c | 247 + ext/spice/src/cspice/lstcli.c | 232 + ext/spice/src/cspice/lstlec.c | 267 + ext/spice/src/cspice/lstlec_c.c | 322 + ext/spice/src/cspice/lstled.c | 227 + ext/spice/src/cspice/lstled_c.c | 178 + ext/spice/src/cspice/lstlei.c | 307 + ext/spice/src/cspice/lstlei_c.c | 178 + ext/spice/src/cspice/lstltc.c | 264 + ext/spice/src/cspice/lstltc_c.c | 325 + ext/spice/src/cspice/lstltd.c | 224 + ext/spice/src/cspice/lstltd_c.c | 178 + ext/spice/src/cspice/lstlti.c | 305 + ext/spice/src/cspice/lstlti_c.c | 179 + ext/spice/src/cspice/ltime.c | 367 + ext/spice/src/cspice/ltime_c.c | 318 + ext/spice/src/cspice/ltrim.c | 164 + ext/spice/src/cspice/lun2fn.c | 214 + ext/spice/src/cspice/lwrite.c | 302 + ext/spice/src/cspice/lx4dec.c | 281 + ext/spice/src/cspice/lx4dec_c.c | 254 + ext/spice/src/cspice/lx4num.c | 219 + ext/spice/src/cspice/lx4num_c.c | 243 + ext/spice/src/cspice/lx4sgn.c | 210 + ext/spice/src/cspice/lx4sgn_c.c | 242 + ext/spice/src/cspice/lx4uns.c | 256 + ext/spice/src/cspice/lx4uns_c.c | 237 + ext/spice/src/cspice/lxname.c | 1002 ++ ext/spice/src/cspice/lxqstr.c | 329 + ext/spice/src/cspice/lxqstr_c.c | 293 + ext/spice/src/cspice/m2eul.c | 954 ++ ext/spice/src/cspice/m2eul_c.c | 501 + ext/spice/src/cspice/m2q.c | 632 + ext/spice/src/cspice/m2q_c.c | 486 + ext/spice/src/cspice/matchi.c | 405 + ext/spice/src/cspice/matchi_c.c | 204 + ext/spice/src/cspice/matchw.c | 431 + ext/spice/src/cspice/matchw_c.c | 204 + ext/spice/src/cspice/maxac.c | 182 + ext/spice/src/cspice/maxad.c | 172 + ext/spice/src/cspice/maxai.c | 172 + ext/spice/src/cspice/maxd_c.c | 234 + ext/spice/src/cspice/maxi_c.c | 233 + ext/spice/src/cspice/mequ.c | 139 + ext/spice/src/cspice/mequ_c.c | 137 + ext/spice/src/cspice/mequg.c | 157 + ext/spice/src/cspice/mequg_c.c | 154 + ext/spice/src/cspice/minac.c | 182 + ext/spice/src/cspice/minad.c | 169 + ext/spice/src/cspice/minai.c | 169 + ext/spice/src/cspice/mind_c.c | 234 + ext/spice/src/cspice/mini_c.c | 233 + ext/spice/src/cspice/mkprodct.csh | 318 + ext/spice/src/cspice/movec.c | 169 + ext/spice/src/cspice/moved.c | 152 + ext/spice/src/cspice/movei.c | 164 + ext/spice/src/cspice/mtxm.c | 203 + ext/spice/src/cspice/mtxm_c.c | 200 + ext/spice/src/cspice/mtxmg.c | 232 + ext/spice/src/cspice/mtxmg_c.c | 299 + ext/spice/src/cspice/mtxv.c | 199 + ext/spice/src/cspice/mtxv_c.c | 186 + ext/spice/src/cspice/mtxvg.c | 204 + ext/spice/src/cspice/mtxvg_c.c | 277 + ext/spice/src/cspice/mxm.c | 191 + ext/spice/src/cspice/mxm_c.c | 183 + ext/spice/src/cspice/mxmg.c | 216 + ext/spice/src/cspice/mxmg_c.c | 305 + ext/spice/src/cspice/mxmt.c | 203 + ext/spice/src/cspice/mxmt_c.c | 201 + ext/spice/src/cspice/mxmtg.c | 233 + ext/spice/src/cspice/mxmtg_c.c | 323 + ext/spice/src/cspice/mxv.c | 179 + ext/spice/src/cspice/mxv_c.c | 167 + ext/spice/src/cspice/mxvg.c | 187 + ext/spice/src/cspice/mxvg_c.c | 276 + ext/spice/src/cspice/namfrm_c.c | 190 + ext/spice/src/cspice/nblen.c | 145 + ext/spice/src/cspice/nbwid.c | 191 + ext/spice/src/cspice/ncpos.c | 217 + ext/spice/src/cspice/ncpos_c.c | 229 + ext/spice/src/cspice/ncposr.c | 216 + ext/spice/src/cspice/ncposr_c.c | 231 + ext/spice/src/cspice/nearpt.c | 1794 +++ ext/spice/src/cspice/nearpt_c.c | 295 + ext/spice/src/cspice/nextwd.c | 259 + ext/spice/src/cspice/notru.c | 152 + ext/spice/src/cspice/nparsd.c | 1072 ++ ext/spice/src/cspice/nparsi.c | 341 + ext/spice/src/cspice/npedln.c | 597 + ext/spice/src/cspice/npedln_c.c | 564 + ext/spice/src/cspice/npelpt.c | 367 + ext/spice/src/cspice/npelpt_c.c | 352 + ext/spice/src/cspice/nplnpt.c | 221 + ext/spice/src/cspice/nplnpt_c.c | 202 + ext/spice/src/cspice/nthwd.c | 258 + ext/spice/src/cspice/nvc2pl.c | 273 + ext/spice/src/cspice/nvc2pl_c.c | 254 + ext/spice/src/cspice/nvp2pl.c | 242 + ext/spice/src/cspice/nvp2pl_c.c | 210 + ext/spice/src/cspice/odd.c | 150 + ext/spice/src/cspice/open.c | 449 + ext/spice/src/cspice/opsgnd.c | 145 + ext/spice/src/cspice/opsgni.c | 150 + ext/spice/src/cspice/ordc.c | 221 + ext/spice/src/cspice/ordc_c.c | 269 + ext/spice/src/cspice/ordd.c | 222 + ext/spice/src/cspice/ordd_c.c | 255 + ext/spice/src/cspice/orderc.c | 186 + ext/spice/src/cspice/orderc_c.c | 245 + ext/spice/src/cspice/orderd.c | 189 + ext/spice/src/cspice/orderd_c.c | 178 + ext/spice/src/cspice/orderi.c | 188 + ext/spice/src/cspice/orderi_c.c | 181 + ext/spice/src/cspice/ordi.c | 221 + ext/spice/src/cspice/ordi_c.c | 253 + ext/spice/src/cspice/oscelt.c | 674 + ext/spice/src/cspice/oscelt_c.c | 281 + ext/spice/src/cspice/outmsg.c | 944 ++ ext/spice/src/cspice/packac.c | 254 + ext/spice/src/cspice/packad.c | 248 + ext/spice/src/cspice/packai.c | 250 + ext/spice/src/cspice/parsqs.c | 413 + ext/spice/src/cspice/partof.c | 227 + ext/spice/src/cspice/pck03a.c | 374 + ext/spice/src/cspice/pck03b.c | 827 + ext/spice/src/cspice/pck03e.c | 334 + ext/spice/src/cspice/pckbsr.c | 3012 ++++ ext/spice/src/cspice/pckcls.c | 203 + ext/spice/src/cspice/pckcov.c | 574 + ext/spice/src/cspice/pckcov_c.c | 473 + ext/spice/src/cspice/pcke02.c | 219 + ext/spice/src/cspice/pcke03.c | 408 + ext/spice/src/cspice/pckeul.c | 254 + ext/spice/src/cspice/pckfrm.c | 415 + ext/spice/src/cspice/pckfrm_c.c | 328 + ext/spice/src/cspice/pcklof_c.c | 181 + ext/spice/src/cspice/pckmat.c | 393 + ext/spice/src/cspice/pckopn.c | 213 + ext/spice/src/cspice/pckpds.c | 260 + ext/spice/src/cspice/pckr02.c | 227 + ext/spice/src/cspice/pckr03.c | 236 + ext/spice/src/cspice/pckuds.c | 203 + ext/spice/src/cspice/pckuof_c.c | 150 + ext/spice/src/cspice/pckw02.c | 487 + ext/spice/src/cspice/pcpool_c.c | 326 + ext/spice/src/cspice/pcwid.c | 197 + ext/spice/src/cspice/pdpool_c.c | 270 + ext/spice/src/cspice/pgrrec.c | 614 + ext/spice/src/cspice/pgrrec_c.c | 521 + ext/spice/src/cspice/pi.c | 159 + ext/spice/src/cspice/pi_c.c | 148 + ext/spice/src/cspice/pipool_c.c | 269 + ext/spice/src/cspice/pjelpl.c | 367 + ext/spice/src/cspice/pjelpl_c.c | 386 + ext/spice/src/cspice/pl2nvc.c | 228 + ext/spice/src/cspice/pl2nvc_c.c | 224 + ext/spice/src/cspice/pl2nvp.c | 175 + ext/spice/src/cspice/pl2nvp_c.c | 173 + ext/spice/src/cspice/pl2psv.c | 294 + ext/spice/src/cspice/pl2psv_c.c | 288 + ext/spice/src/cspice/plnsns.c | 241 + ext/spice/src/cspice/polyds.c | 311 + ext/spice/src/cspice/pool.c | 8085 ++++++++++ ext/spice/src/cspice/pos.c | 220 + ext/spice/src/cspice/pos_c.c | 228 + ext/spice/src/cspice/posr.c | 227 + ext/spice/src/cspice/posr_c.c | 228 + ext/spice/src/cspice/pow_ci.c | 20 + ext/spice/src/cspice/pow_dd.c | 13 + ext/spice/src/cspice/pow_di.c | 35 + ext/spice/src/cspice/pow_hh.c | 33 + ext/spice/src/cspice/pow_ii.c | 33 + ext/spice/src/cspice/pow_ri.c | 35 + ext/spice/src/cspice/pow_zi.c | 54 + ext/spice/src/cspice/pow_zz.c | 23 + ext/spice/src/cspice/prefix.c | 203 + ext/spice/src/cspice/prodad.c | 165 + ext/spice/src/cspice/prodai.c | 164 + ext/spice/src/cspice/prompt.c | 397 + ext/spice/src/cspice/prompt_c.c | 285 + ext/spice/src/cspice/prop2b.c | 1076 ++ ext/spice/src/cspice/prop2b_c.c | 220 + ext/spice/src/cspice/prsdp.c | 150 + ext/spice/src/cspice/prsdp_c.c | 165 + ext/spice/src/cspice/prsint.c | 142 + ext/spice/src/cspice/prsint_c.c | 157 + ext/spice/src/cspice/prtenc.c | 361 + ext/spice/src/cspice/prtpkg.c | 808 + ext/spice/src/cspice/psv2pl.c | 254 + ext/spice/src/cspice/psv2pl_c.c | 222 + ext/spice/src/cspice/putact.c | 355 + ext/spice/src/cspice/putcml_c.c | 177 + ext/spice/src/cspice/putdev.c | 472 + ext/spice/src/cspice/putlms.c | 391 + ext/spice/src/cspice/putsms.c | 361 + ext/spice/src/cspice/pxform.c | 226 + ext/spice/src/cspice/pxform_c.c | 225 + ext/spice/src/cspice/q2m.c | 592 + ext/spice/src/cspice/q2m_c.c | 468 + ext/spice/src/cspice/qderiv.c | 225 + ext/spice/src/cspice/qdq2av.c | 722 + ext/spice/src/cspice/qdq2av_c.c | 717 + ext/spice/src/cspice/quote.c | 183 + ext/spice/src/cspice/qxq.c | 441 + ext/spice/src/cspice/qxq_c.c | 449 + ext/spice/src/cspice/r_abs.c | 12 + ext/spice/src/cspice/r_acos.c | 13 + ext/spice/src/cspice/r_asin.c | 13 + ext/spice/src/cspice/r_atan.c | 13 + ext/spice/src/cspice/r_atn2.c | 13 + ext/spice/src/cspice/r_cnjg.c | 11 + ext/spice/src/cspice/r_cos.c | 13 + ext/spice/src/cspice/r_cosh.c | 13 + ext/spice/src/cspice/r_dim.c | 10 + ext/spice/src/cspice/r_exp.c | 13 + ext/spice/src/cspice/r_imag.c | 10 + ext/spice/src/cspice/r_int.c | 13 + ext/spice/src/cspice/r_lg10.c | 15 + ext/spice/src/cspice/r_log.c | 13 + ext/spice/src/cspice/r_mod.c | 40 + ext/spice/src/cspice/r_nint.c | 14 + ext/spice/src/cspice/r_sign.c | 12 + ext/spice/src/cspice/r_sin.c | 13 + ext/spice/src/cspice/r_sinh.c | 13 + ext/spice/src/cspice/r_sqrt.c | 13 + ext/spice/src/cspice/r_tan.c | 13 + ext/spice/src/cspice/r_tanh.c | 13 + ext/spice/src/cspice/radrec.c | 197 + ext/spice/src/cspice/radrec_c.c | 170 + ext/spice/src/cspice/rav2xf.c | 267 + ext/spice/src/cspice/rav2xf_c.c | 295 + ext/spice/src/cspice/rawio.h | 41 + ext/spice/src/cspice/raxisa.c | 349 + ext/spice/src/cspice/raxisa_c.c | 243 + ext/spice/src/cspice/rdencc.c | 538 + ext/spice/src/cspice/rdencd.c | 338 + ext/spice/src/cspice/rdenci.c | 326 + ext/spice/src/cspice/rdfmt.c | 476 + ext/spice/src/cspice/rdker.c | 1084 ++ ext/spice/src/cspice/rdkvar.c | 391 + ext/spice/src/cspice/rdnbl.c | 214 + ext/spice/src/cspice/rdtext.c | 989 ++ ext/spice/src/cspice/rdtext_c.c | 251 + ext/spice/src/cspice/readla.c | 334 + ext/spice/src/cspice/readln.c | 217 + ext/spice/src/cspice/reccyl.c | 199 + ext/spice/src/cspice/reccyl_c.c | 204 + ext/spice/src/cspice/recgeo.c | 320 + ext/spice/src/cspice/recgeo_c.c | 272 + ext/spice/src/cspice/reclat.c | 228 + ext/spice/src/cspice/reclat_c.c | 239 + ext/spice/src/cspice/recpgr.c | 657 + ext/spice/src/cspice/recpgr_c.c | 548 + ext/spice/src/cspice/recrad.c | 201 + ext/spice/src/cspice/recrad_c.c | 209 + ext/spice/src/cspice/recsph.c | 208 + ext/spice/src/cspice/recsph_c.c | 220 + ext/spice/src/cspice/refchg.c | 679 + ext/spice/src/cspice/remlac.c | 255 + ext/spice/src/cspice/remlad.c | 251 + ext/spice/src/cspice/remlai.c | 251 + ext/spice/src/cspice/removc.c | 210 + ext/spice/src/cspice/removc_c.c | 257 + ext/spice/src/cspice/removd.c | 205 + ext/spice/src/cspice/removd_c.c | 244 + ext/spice/src/cspice/removi.c | 205 + ext/spice/src/cspice/removi_c.c | 222 + ext/spice/src/cspice/remsub.c | 241 + ext/spice/src/cspice/reordc.c | 248 + ext/spice/src/cspice/reordc_c.c | 270 + ext/spice/src/cspice/reordd.c | 227 + ext/spice/src/cspice/reordd_c.c | 223 + ext/spice/src/cspice/reordi.c | 224 + ext/spice/src/cspice/reordi_c.c | 221 + ext/spice/src/cspice/reordl.c | 221 + ext/spice/src/cspice/reordl_c.c | 265 + ext/spice/src/cspice/replch.c | 172 + ext/spice/src/cspice/replwd.c | 301 + ext/spice/src/cspice/repmc.c | 292 + ext/spice/src/cspice/repmc_c.c | 395 + ext/spice/src/cspice/repmct.c | 343 + ext/spice/src/cspice/repmct_c.c | 378 + ext/spice/src/cspice/repmd.c | 313 + ext/spice/src/cspice/repmd_c.c | 381 + ext/spice/src/cspice/repmf.c | 352 + ext/spice/src/cspice/repmf_c.c | 440 + ext/spice/src/cspice/repmi.c | 274 + ext/spice/src/cspice/repmi_c.c | 364 + ext/spice/src/cspice/repmot.c | 344 + ext/spice/src/cspice/repmot_c.c | 366 + ext/spice/src/cspice/repsub.c | 333 + ext/spice/src/cspice/reset.c | 239 + ext/spice/src/cspice/reset_c.c | 196 + ext/spice/src/cspice/return.c | 274 + ext/spice/src/cspice/return_c.c | 237 + ext/spice/src/cspice/rewind.c | 24 + ext/spice/src/cspice/rjust.c | 195 + ext/spice/src/cspice/rmaind.c | 171 + ext/spice/src/cspice/rmaini.c | 155 + ext/spice/src/cspice/rmdupc.c | 185 + ext/spice/src/cspice/rmdupd.c | 179 + ext/spice/src/cspice/rmdupi.c | 179 + ext/spice/src/cspice/rotate.c | 222 + ext/spice/src/cspice/rotate_c.c | 183 + ext/spice/src/cspice/rotget.c | 343 + ext/spice/src/cspice/rotmat.c | 238 + ext/spice/src/cspice/rotmat_c.c | 194 + ext/spice/src/cspice/rotvec.c | 242 + ext/spice/src/cspice/rotvec_c.c | 228 + ext/spice/src/cspice/rpd.c | 158 + ext/spice/src/cspice/rpd_c.c | 137 + ext/spice/src/cspice/rquad.c | 350 + ext/spice/src/cspice/rquad_c.c | 380 + ext/spice/src/cspice/rsfe.c | 428 + ext/spice/src/cspice/rsli.c | 103 + ext/spice/src/cspice/rsne.c | 609 + ext/spice/src/cspice/rtrim.c | 164 + ext/spice/src/cspice/s_cat.c | 75 + ext/spice/src/cspice/s_cmp.c | 44 + ext/spice/src/cspice/s_copy.c | 51 + ext/spice/src/cspice/s_paus.c | 88 + ext/spice/src/cspice/s_rnge.c | 288 + ext/spice/src/cspice/s_stop.c | 52 + ext/spice/src/cspice/saelgv.c | 491 + ext/spice/src/cspice/saelgv_c.c | 489 + ext/spice/src/cspice/samch.c | 197 + ext/spice/src/cspice/samchi.c | 204 + ext/spice/src/cspice/sameai.c | 155 + ext/spice/src/cspice/samsbi.c | 238 + ext/spice/src/cspice/samsub.c | 222 + ext/spice/src/cspice/sc01.c | 3244 ++++ ext/spice/src/cspice/scanit.c | 1580 ++ ext/spice/src/cspice/scanrj.c | 202 + ext/spice/src/cspice/scard_c.c | 219 + ext/spice/src/cspice/scardc.c | 217 + ext/spice/src/cspice/scardd.c | 211 + ext/spice/src/cspice/scardi.c | 210 + ext/spice/src/cspice/scdecd.c | 671 + ext/spice/src/cspice/scdecd_c.c | 473 + ext/spice/src/cspice/sce2c.c | 294 + ext/spice/src/cspice/sce2c_c.c | 275 + ext/spice/src/cspice/sce2s.c | 354 + ext/spice/src/cspice/sce2s_c.c | 379 + ext/spice/src/cspice/sce2t.c | 324 + ext/spice/src/cspice/sce2t_c.c | 285 + ext/spice/src/cspice/scencd.c | 699 + ext/spice/src/cspice/scencd_c.c | 473 + ext/spice/src/cspice/scfmt.c | 324 + ext/spice/src/cspice/scfmt_c.c | 359 + ext/spice/src/cspice/sclu01.c | 1205 ++ ext/spice/src/cspice/scpars.c | 800 + ext/spice/src/cspice/scpart.c | 447 + ext/spice/src/cspice/scpart_c.c | 228 + ext/spice/src/cspice/scps01.c | 627 + ext/spice/src/cspice/scs2e.c | 296 + ext/spice/src/cspice/scs2e_c.c | 268 + ext/spice/src/cspice/sct2e.c | 334 + ext/spice/src/cspice/sct2e_c.c | 295 + ext/spice/src/cspice/sctiks.c | 346 + ext/spice/src/cspice/sctiks_c.c | 328 + ext/spice/src/cspice/sctran.c | 539 + ext/spice/src/cspice/sctype.c | 282 + ext/spice/src/cspice/sdiff_c.c | 359 + ext/spice/src/cspice/sdiffc.c | 322 + ext/spice/src/cspice/sdiffd.c | 272 + ext/spice/src/cspice/sdiffi.c | 272 + ext/spice/src/cspice/set_c.c | 354 + ext/spice/src/cspice/setc.c | 602 + ext/spice/src/cspice/setd.c | 599 + ext/spice/src/cspice/seterr.c | 428 + ext/spice/src/cspice/seti.c | 599 + ext/spice/src/cspice/setmsg.c | 207 + ext/spice/src/cspice/setmsg_c.c | 198 + ext/spice/src/cspice/sfe.c | 31 + ext/spice/src/cspice/sgfcon.c | 625 + ext/spice/src/cspice/sgfpkt.c | 807 + ext/spice/src/cspice/sgfref.c | 698 + ext/spice/src/cspice/sgfrvi.c | 1272 ++ ext/spice/src/cspice/sgmeta.c | 910 ++ ext/spice/src/cspice/sgseqw.c | 4341 +++++ ext/spice/src/cspice/sharpr.c | 164 + ext/spice/src/cspice/shellc.c | 172 + ext/spice/src/cspice/shellc_c.c | 227 + ext/spice/src/cspice/shelld.c | 166 + ext/spice/src/cspice/shelld_c.c | 141 + ext/spice/src/cspice/shelli.c | 166 + ext/spice/src/cspice/shelli_c.c | 139 + ext/spice/src/cspice/shiftc.c | 209 + ext/spice/src/cspice/shiftl.c | 237 + ext/spice/src/cspice/shiftr.c | 234 + ext/spice/src/cspice/sig_die.c | 120 + ext/spice/src/cspice/sigdgt.c | 358 + ext/spice/src/cspice/sigerr.c | 372 + ext/spice/src/cspice/sigerr_c.c | 229 + ext/spice/src/cspice/signal1.h | 118 + ext/spice/src/cspice/signal_.c | 15 + ext/spice/src/cspice/sincpt.c | 2256 +++ ext/spice/src/cspice/sincpt_c.c | 1266 ++ ext/spice/src/cspice/size_c.c | 224 + ext/spice/src/cspice/sizec.c | 212 + ext/spice/src/cspice/sized.c | 209 + ext/spice/src/cspice/sizei.c | 204 + ext/spice/src/cspice/smsgnd.c | 146 + ext/spice/src/cspice/smsgni.c | 146 + ext/spice/src/cspice/somfls.c | 155 + ext/spice/src/cspice/somtru.c | 155 + ext/spice/src/cspice/spca2b.c | 225 + ext/spice/src/cspice/spcac.c | 776 + ext/spice/src/cspice/spcb2a.c | 215 + ext/spice/src/cspice/spcb2t.c | 297 + ext/spice/src/cspice/spcdc.c | 219 + ext/spice/src/cspice/spcec.c | 394 + ext/spice/src/cspice/spcopn.c | 210 + ext/spice/src/cspice/spcrfl.c | 829 + ext/spice/src/cspice/spct2b.c | 455 + ext/spice/src/cspice/spd.c | 127 + ext/spice/src/cspice/spd_c.c | 133 + ext/spice/src/cspice/sphcyl.c | 171 + ext/spice/src/cspice/sphcyl_c.c | 169 + ext/spice/src/cspice/sphlat.c | 178 + ext/spice/src/cspice/sphlat_c.c | 170 + ext/spice/src/cspice/sphrec.c | 201 + ext/spice/src/cspice/sphrec_c.c | 186 + ext/spice/src/cspice/sphsd.c | 254 + ext/spice/src/cspice/spk14a.c | 377 + ext/spice/src/cspice/spk14a_c.c | 410 + ext/spice/src/cspice/spk14b.c | 843 + ext/spice/src/cspice/spk14b_c.c | 455 + ext/spice/src/cspice/spk14e.c | 335 + ext/spice/src/cspice/spk14e_c.c | 382 + ext/spice/src/cspice/spkacs.c | 733 + ext/spice/src/cspice/spkacs_c.c | 523 + ext/spice/src/cspice/spkapo.c | 834 + ext/spice/src/cspice/spkapo_c.c | 663 + ext/spice/src/cspice/spkapp.c | 914 ++ ext/spice/src/cspice/spkapp_c.c | 706 + ext/spice/src/cspice/spkaps.c | 828 + ext/spice/src/cspice/spkaps_c.c | 595 + ext/spice/src/cspice/spkbsr.c | 3259 ++++ ext/spice/src/cspice/spkcls.c | 212 + ext/spice/src/cspice/spkcls_c.c | 139 + ext/spice/src/cspice/spkcov.c | 579 + ext/spice/src/cspice/spkcov_c.c | 478 + ext/spice/src/cspice/spke01.c | 362 + ext/spice/src/cspice/spke02.c | 248 + ext/spice/src/cspice/spke03.c | 239 + ext/spice/src/cspice/spke05.c | 328 + ext/spice/src/cspice/spke08.c | 327 + ext/spice/src/cspice/spke09.c | 323 + ext/spice/src/cspice/spke10.c | 485 + ext/spice/src/cspice/spke12.c | 245 + ext/spice/src/cspice/spke13.c | 242 + ext/spice/src/cspice/spke14.c | 226 + ext/spice/src/cspice/spke15.c | 589 + ext/spice/src/cspice/spke17.c | 278 + ext/spice/src/cspice/spke18.c | 492 + ext/spice/src/cspice/spkez.c | 1417 ++ ext/spice/src/cspice/spkez_c.c | 865 + ext/spice/src/cspice/spkezp.c | 1030 ++ ext/spice/src/cspice/spkezp_c.c | 803 + ext/spice/src/cspice/spkezr.c | 1021 ++ ext/spice/src/cspice/spkezr_c.c | 866 + ext/spice/src/cspice/spkgeo.c | 1063 ++ ext/spice/src/cspice/spkgeo_c.c | 292 + ext/spice/src/cspice/spkgps.c | 1016 ++ ext/spice/src/cspice/spkgps_c.c | 282 + ext/spice/src/cspice/spklef_c.c | 237 + ext/spice/src/cspice/spkltc.c | 919 ++ ext/spice/src/cspice/spkltc_c.c | 526 + ext/spice/src/cspice/spkobj.c | 422 + ext/spice/src/cspice/spkobj_c.c | 337 + ext/spice/src/cspice/spkopa.c | 225 + ext/spice/src/cspice/spkopa_c.c | 199 + ext/spice/src/cspice/spkopn.c | 216 + ext/spice/src/cspice/spkopn_c.c | 204 + ext/spice/src/cspice/spkpds.c | 287 + ext/spice/src/cspice/spkpds_c.c | 201 + ext/spice/src/cspice/spkpos.c | 958 ++ ext/spice/src/cspice/spkpos_c.c | 811 + ext/spice/src/cspice/spkpv.c | 288 + ext/spice/src/cspice/spkpvn.c | 473 + ext/spice/src/cspice/spkr01.c | 291 + ext/spice/src/cspice/spkr02.c | 243 + ext/spice/src/cspice/spkr03.c | 247 + ext/spice/src/cspice/spkr05.c | 476 + ext/spice/src/cspice/spkr08.c | 368 + ext/spice/src/cspice/spkr09.c | 485 + ext/spice/src/cspice/spkr10.c | 667 + ext/spice/src/cspice/spkr12.c | 200 + ext/spice/src/cspice/spkr13.c | 205 + ext/spice/src/cspice/spkr14.c | 238 + ext/spice/src/cspice/spkr15.c | 266 + ext/spice/src/cspice/spkr17.c | 279 + ext/spice/src/cspice/spkr18.c | 617 + ext/spice/src/cspice/spks01.c | 266 + ext/spice/src/cspice/spks02.c | 240 + ext/spice/src/cspice/spks03.c | 244 + ext/spice/src/cspice/spks05.c | 294 + ext/spice/src/cspice/spks08.c | 327 + ext/spice/src/cspice/spks09.c | 351 + ext/spice/src/cspice/spks10.c | 664 + ext/spice/src/cspice/spks12.c | 183 + ext/spice/src/cspice/spks13.c | 183 + ext/spice/src/cspice/spks14.c | 285 + ext/spice/src/cspice/spks15.c | 205 + ext/spice/src/cspice/spks17.c | 205 + ext/spice/src/cspice/spks18.c | 438 + ext/spice/src/cspice/spkssb.c | 220 + ext/spice/src/cspice/spkssb_c.c | 213 + ext/spice/src/cspice/spksub.c | 408 + ext/spice/src/cspice/spksub_c.c | 236 + ext/spice/src/cspice/spkuds.c | 212 + ext/spice/src/cspice/spkuds_c.c | 215 + ext/spice/src/cspice/spkuef_c.c | 149 + ext/spice/src/cspice/spkw01.c | 451 + ext/spice/src/cspice/spkw02.c | 490 + ext/spice/src/cspice/spkw02_c.c | 301 + ext/spice/src/cspice/spkw03.c | 494 + ext/spice/src/cspice/spkw03_c.c | 312 + ext/spice/src/cspice/spkw05.c | 442 + ext/spice/src/cspice/spkw05_c.c | 267 + ext/spice/src/cspice/spkw08.c | 507 + ext/spice/src/cspice/spkw08_c.c | 309 + ext/spice/src/cspice/spkw09.c | 522 + ext/spice/src/cspice/spkw09_c.c | 286 + ext/spice/src/cspice/spkw10.c | 710 + ext/spice/src/cspice/spkw10_c.c | 287 + ext/spice/src/cspice/spkw12.c | 472 + ext/spice/src/cspice/spkw12_c.c | 296 + ext/spice/src/cspice/spkw13.c | 476 + ext/spice/src/cspice/spkw13_c.c | 284 + ext/spice/src/cspice/spkw15.c | 501 + ext/spice/src/cspice/spkw15_c.c | 373 + ext/spice/src/cspice/spkw17.c | 416 + ext/spice/src/cspice/spkw17_c.c | 328 + ext/spice/src/cspice/spkw18.c | 640 + ext/spice/src/cspice/spkw18_c.c | 338 + ext/spice/src/cspice/srfrec.c | 335 + ext/spice/src/cspice/srfrec_c.c | 288 + ext/spice/src/cspice/srfxpt.c | 1757 ++ ext/spice/src/cspice/srfxpt_c.c | 996 ++ ext/spice/src/cspice/ssize_c.c | 218 + ext/spice/src/cspice/ssizec.c | 222 + ext/spice/src/cspice/ssized.c | 218 + ext/spice/src/cspice/ssizei.c | 218 + ext/spice/src/cspice/stcc01.c | 452 + ext/spice/src/cspice/stcf01.c | 338 + ext/spice/src/cspice/stcg01.c | 321 + ext/spice/src/cspice/stcl01.c | 245 + ext/spice/src/cspice/stdio.c | 163 + ext/spice/src/cspice/stelab.c | 316 + ext/spice/src/cspice/stelab_c.c | 215 + ext/spice/src/cspice/stlabx.c | 240 + ext/spice/src/cspice/stmp03.c | 698 + ext/spice/src/cspice/stpool.c | 450 + ext/spice/src/cspice/stpool_c.c | 474 + ext/spice/src/cspice/str2et.c | 1335 ++ ext/spice/src/cspice/str2et_c.c | 643 + ext/spice/src/cspice/subpnt.c | 1881 +++ ext/spice/src/cspice/subpnt_c.c | 1100 ++ ext/spice/src/cspice/subpt.c | 649 + ext/spice/src/cspice/subpt_c.c | 514 + ext/spice/src/cspice/subslr.c | 1586 ++ ext/spice/src/cspice/subslr_c.c | 792 + ext/spice/src/cspice/subsol.c | 617 + ext/spice/src/cspice/subsol_c.c | 489 + ext/spice/src/cspice/sue.c | 83 + ext/spice/src/cspice/suffix.c | 181 + ext/spice/src/cspice/sumad.c | 165 + ext/spice/src/cspice/sumad_c.c | 160 + ext/spice/src/cspice/sumai.c | 163 + ext/spice/src/cspice/sumai_c.c | 160 + ext/spice/src/cspice/surfnm.c | 294 + ext/spice/src/cspice/surfnm_c.c | 190 + ext/spice/src/cspice/surfpt.c | 487 + ext/spice/src/cspice/surfpt_c.c | 270 + ext/spice/src/cspice/surfpv.c | 682 + ext/spice/src/cspice/surfpv_c.c | 516 + ext/spice/src/cspice/swapac.c | 442 + ext/spice/src/cspice/swapad.c | 440 + ext/spice/src/cspice/swapai.c | 438 + ext/spice/src/cspice/swapc.c | 173 + ext/spice/src/cspice/swapd.c | 139 + ext/spice/src/cspice/swapi.c | 139 + ext/spice/src/cspice/swpool_c.c | 290 + ext/spice/src/cspice/sxform.c | 233 + ext/spice/src/cspice/sxform_c.c | 236 + ext/spice/src/cspice/sydelc.c | 217 + ext/spice/src/cspice/sydeld.c | 220 + ext/spice/src/cspice/sydeli.c | 217 + ext/spice/src/cspice/sydimc.c | 210 + ext/spice/src/cspice/sydimd.c | 211 + ext/spice/src/cspice/sydimi.c | 216 + ext/spice/src/cspice/sydupc.c | 342 + ext/spice/src/cspice/sydupd.c | 339 + ext/spice/src/cspice/sydupi.c | 339 + ext/spice/src/cspice/syenqc.c | 260 + ext/spice/src/cspice/syenqd.c | 262 + ext/spice/src/cspice/syenqi.c | 259 + ext/spice/src/cspice/syfetc.c | 205 + ext/spice/src/cspice/syfetd.c | 204 + ext/spice/src/cspice/syfeti.c | 206 + ext/spice/src/cspice/sygetc.c | 244 + ext/spice/src/cspice/sygetd.c | 247 + ext/spice/src/cspice/sygeti.c | 245 + ext/spice/src/cspice/synthc.c | 235 + ext/spice/src/cspice/synthd.c | 231 + ext/spice/src/cspice/synthi.c | 230 + ext/spice/src/cspice/syordc.c | 207 + ext/spice/src/cspice/syordd.c | 210 + ext/spice/src/cspice/syordi.c | 212 + ext/spice/src/cspice/sypopc.c | 268 + ext/spice/src/cspice/sypopd.c | 275 + ext/spice/src/cspice/sypopi.c | 273 + ext/spice/src/cspice/sypshc.c | 261 + ext/spice/src/cspice/sypshd.c | 263 + ext/spice/src/cspice/sypshi.c | 260 + ext/spice/src/cspice/syputc.c | 345 + ext/spice/src/cspice/syputd.c | 361 + ext/spice/src/cspice/syputi.c | 352 + ext/spice/src/cspice/syrenc.c | 303 + ext/spice/src/cspice/syrend.c | 300 + ext/spice/src/cspice/syreni.c | 299 + ext/spice/src/cspice/syselc.c | 275 + ext/spice/src/cspice/syseld.c | 271 + ext/spice/src/cspice/syseli.c | 273 + ext/spice/src/cspice/sysetc.c | 312 + ext/spice/src/cspice/sysetd.c | 307 + ext/spice/src/cspice/syseti.c | 305 + ext/spice/src/cspice/system_.c | 122 + ext/spice/src/cspice/sytrnc.c | 260 + ext/spice/src/cspice/sytrnd.c | 265 + ext/spice/src/cspice/sytrni.c | 263 + ext/spice/src/cspice/szpool_c.c | 238 + ext/spice/src/cspice/tcheck.c | 905 ++ ext/spice/src/cspice/texpyr.c | 318 + ext/spice/src/cspice/timdef.c | 438 + ext/spice/src/cspice/timdef_c.c | 352 + ext/spice/src/cspice/timout.c | 2099 +++ ext/spice/src/cspice/timout_c.c | 526 + ext/spice/src/cspice/tipbod.c | 393 + ext/spice/src/cspice/tipbod_c.c | 350 + ext/spice/src/cspice/tisbod.c | 1229 ++ ext/spice/src/cspice/tisbod_c.c | 505 + ext/spice/src/cspice/tkfram.c | 881 + ext/spice/src/cspice/tkvrsn.c | 279 + ext/spice/src/cspice/tkvrsn_c.c | 243 + ext/spice/src/cspice/tostdo.c | 134 + ext/spice/src/cspice/touchc.c | 149 + ext/spice/src/cspice/touchd.c | 151 + ext/spice/src/cspice/touchi.c | 151 + ext/spice/src/cspice/touchl.c | 151 + ext/spice/src/cspice/tparse.c | 599 + ext/spice/src/cspice/tparse_c.c | 383 + ext/spice/src/cspice/tpartv.c | 1291 ++ ext/spice/src/cspice/tpictr.c | 209 + ext/spice/src/cspice/tpictr_c.c | 254 + ext/spice/src/cspice/trace.c | 131 + ext/spice/src/cspice/trace_c.c | 140 + ext/spice/src/cspice/traceg.c | 154 + ext/spice/src/cspice/trcoff_c.c | 145 + ext/spice/src/cspice/trcpkg.c | 2640 +++ ext/spice/src/cspice/tsetyr_c.c | 177 + ext/spice/src/cspice/ttrans.c | 1556 ++ ext/spice/src/cspice/twopi.c | 160 + ext/spice/src/cspice/twopi_c.c | 143 + ext/spice/src/cspice/twovec.c | 319 + ext/spice/src/cspice/twovec_c.c | 208 + ext/spice/src/cspice/twovxf.c | 332 + ext/spice/src/cspice/txtopn.c | 349 + ext/spice/src/cspice/txtopr.c | 374 + ext/spice/src/cspice/tyear.c | 129 + ext/spice/src/cspice/tyear_c.c | 127 + ext/spice/src/cspice/typesize.c | 12 + ext/spice/src/cspice/ucase.c | 185 + ext/spice/src/cspice/ucase_c.c | 226 + ext/spice/src/cspice/ucrss.c | 191 + ext/spice/src/cspice/ucrss_c.c | 216 + ext/spice/src/cspice/uddc.c | 201 + ext/spice/src/cspice/uddc_c.c | 206 + ext/spice/src/cspice/uddf.c | 311 + ext/spice/src/cspice/uddf_c.c | 274 + ext/spice/src/cspice/uio.c | 68 + ext/spice/src/cspice/union_c.c | 377 + ext/spice/src/cspice/unionc.c | 324 + ext/spice/src/cspice/uniond.c | 272 + ext/spice/src/cspice/unioni.c | 273 + ext/spice/src/cspice/unitim.c | 652 + ext/spice/src/cspice/unitim_c.c | 231 + ext/spice/src/cspice/unload_c.c | 207 + ext/spice/src/cspice/unorm.c | 170 + ext/spice/src/cspice/unorm_c.c | 166 + ext/spice/src/cspice/unormg.c | 189 + ext/spice/src/cspice/unormg_c.c | 205 + ext/spice/src/cspice/utc2et.c | 420 + ext/spice/src/cspice/utc2et_c.c | 296 + ext/spice/src/cspice/util.c | 53 + ext/spice/src/cspice/vadd.c | 134 + ext/spice/src/cspice/vadd_c.c | 139 + ext/spice/src/cspice/vaddg.c | 166 + ext/spice/src/cspice/vaddg_c.c | 155 + ext/spice/src/cspice/valid_c.c | 322 + ext/spice/src/cspice/validc.c | 225 + ext/spice/src/cspice/validd.c | 228 + ext/spice/src/cspice/validi.c | 224 + ext/spice/src/cspice/vcrss.c | 155 + ext/spice/src/cspice/vcrss_c.c | 174 + ext/spice/src/cspice/vdist.c | 192 + ext/spice/src/cspice/vdist_c.c | 194 + ext/spice/src/cspice/vdistg.c | 212 + ext/spice/src/cspice/vdistg_c.c | 224 + ext/spice/src/cspice/vdot.c | 137 + ext/spice/src/cspice/vdot_c.c | 151 + ext/spice/src/cspice/vdotg.c | 147 + ext/spice/src/cspice/vdotg_c.c | 191 + ext/spice/src/cspice/vequ.c | 129 + ext/spice/src/cspice/vequ_c.c | 133 + ext/spice/src/cspice/vequg.c | 150 + ext/spice/src/cspice/vequg_c.c | 155 + ext/spice/src/cspice/vhat.c | 165 + ext/spice/src/cspice/vhat_c.c | 177 + ext/spice/src/cspice/vhatg.c | 179 + ext/spice/src/cspice/vhatg_c.c | 174 + ext/spice/src/cspice/vhatip.c | 166 + ext/spice/src/cspice/vlcom.c | 164 + ext/spice/src/cspice/vlcom3.c | 143 + ext/spice/src/cspice/vlcom3_c.c | 157 + ext/spice/src/cspice/vlcom_c.c | 166 + ext/spice/src/cspice/vlcomg.c | 167 + ext/spice/src/cspice/vlcomg_c.c | 152 + ext/spice/src/cspice/vminug.c | 158 + ext/spice/src/cspice/vminug_c.c | 146 + ext/spice/src/cspice/vminus.c | 134 + ext/spice/src/cspice/vminus_c.c | 138 + ext/spice/src/cspice/vnorm.c | 168 + ext/spice/src/cspice/vnorm_c.c | 181 + ext/spice/src/cspice/vnormg.c | 187 + ext/spice/src/cspice/vnormg_c.c | 212 + ext/spice/src/cspice/vpack.c | 151 + ext/spice/src/cspice/vpack_c.c | 155 + ext/spice/src/cspice/vperp.c | 204 + ext/spice/src/cspice/vperp_c.c | 187 + ext/spice/src/cspice/vprjp.c | 199 + ext/spice/src/cspice/vprjp_c.c | 197 + ext/spice/src/cspice/vprjpi.c | 352 + ext/spice/src/cspice/vprjpi_c.c | 362 + ext/spice/src/cspice/vproj.c | 186 + ext/spice/src/cspice/vproj_c.c | 179 + ext/spice/src/cspice/vprojg.c | 186 + ext/spice/src/cspice/vrel.c | 220 + ext/spice/src/cspice/vrel_c.c | 227 + ext/spice/src/cspice/vrelg.c | 249 + ext/spice/src/cspice/vrelg_c.c | 249 + ext/spice/src/cspice/vrotv.c | 246 + ext/spice/src/cspice/vrotv_c.c | 183 + ext/spice/src/cspice/vscl.c | 137 + ext/spice/src/cspice/vscl_c.c | 140 + ext/spice/src/cspice/vsclg.c | 163 + ext/spice/src/cspice/vsclg_c.c | 157 + ext/spice/src/cspice/vsclip.c | 139 + ext/spice/src/cspice/vsep.c | 242 + ext/spice/src/cspice/vsep_c.c | 231 + ext/spice/src/cspice/vsepg.c | 268 + ext/spice/src/cspice/vsepg_c.c | 230 + ext/spice/src/cspice/vsub.c | 143 + ext/spice/src/cspice/vsub_c.c | 147 + ext/spice/src/cspice/vsubg.c | 173 + ext/spice/src/cspice/vsubg_c.c | 165 + ext/spice/src/cspice/vtmv.c | 172 + ext/spice/src/cspice/vtmv_c.c | 171 + ext/spice/src/cspice/vtmvg.c | 200 + ext/spice/src/cspice/vtmvg_c.c | 219 + ext/spice/src/cspice/vupack.c | 150 + ext/spice/src/cspice/vupack_c.c | 163 + ext/spice/src/cspice/vzero.c | 169 + ext/spice/src/cspice/vzero_c.c | 170 + ext/spice/src/cspice/vzerog.c | 193 + ext/spice/src/cspice/vzerog_c.c | 196 + ext/spice/src/cspice/wdcnt.c | 214 + ext/spice/src/cspice/wdindx.c | 239 + ext/spice/src/cspice/wncard.c | 201 + ext/spice/src/cspice/wncard_c.c | 173 + ext/spice/src/cspice/wncomd.c | 287 + ext/spice/src/cspice/wncomd_c.c | 225 + ext/spice/src/cspice/wncond.c | 191 + ext/spice/src/cspice/wncond_c.c | 188 + ext/spice/src/cspice/wndifd.c | 403 + ext/spice/src/cspice/wndifd_c.c | 195 + ext/spice/src/cspice/wnelmd.c | 199 + ext/spice/src/cspice/wnelmd_c.c | 172 + ext/spice/src/cspice/wnexpd.c | 246 + ext/spice/src/cspice/wnexpd_c.c | 191 + ext/spice/src/cspice/wnextd.c | 210 + ext/spice/src/cspice/wnextd_c.c | 189 + ext/spice/src/cspice/wnfetd.c | 186 + ext/spice/src/cspice/wnfetd_c.c | 200 + ext/spice/src/cspice/wnfild.c | 205 + ext/spice/src/cspice/wnfild_c.c | 180 + ext/spice/src/cspice/wnfltd.c | 185 + ext/spice/src/cspice/wnfltd_c.c | 166 + ext/spice/src/cspice/wnincd.c | 202 + ext/spice/src/cspice/wnincd_c.c | 173 + ext/spice/src/cspice/wninsd.c | 371 + ext/spice/src/cspice/wninsd_c.c | 200 + ext/spice/src/cspice/wnintd.c | 260 + ext/spice/src/cspice/wnintd_c.c | 185 + ext/spice/src/cspice/wnreld.c | 364 + ext/spice/src/cspice/wnreld_c.c | 312 + ext/spice/src/cspice/wnsumd.c | 292 + ext/spice/src/cspice/wnsumd_c.c | 233 + ext/spice/src/cspice/wnunid.c | 298 + ext/spice/src/cspice/wnunid_c.c | 188 + ext/spice/src/cspice/wnvald.c | 283 + ext/spice/src/cspice/wnvald_c.c | 264 + ext/spice/src/cspice/wref.c | 276 + ext/spice/src/cspice/wrencc.c | 775 + ext/spice/src/cspice/wrencd.c | 391 + ext/spice/src/cspice/wrenci.c | 386 + ext/spice/src/cspice/writla.c | 212 + ext/spice/src/cspice/writln.c | 397 + ext/spice/src/cspice/wrkvar.c | 346 + ext/spice/src/cspice/wrline.c | 965 ++ ext/spice/src/cspice/wrtfmt.c | 365 + ext/spice/src/cspice/wsfe.c | 73 + ext/spice/src/cspice/wsle.c | 36 + ext/spice/src/cspice/wsne.c | 26 + ext/spice/src/cspice/xf2eul.c | 1234 ++ ext/spice/src/cspice/xf2eul_c.c | 407 + ext/spice/src/cspice/xf2rav.c | 244 + ext/spice/src/cspice/xf2rav_c.c | 255 + ext/spice/src/cspice/xposbl.c | 404 + ext/spice/src/cspice/xpose.c | 151 + ext/spice/src/cspice/xpose6_c.c | 171 + ext/spice/src/cspice/xpose_c.c | 181 + ext/spice/src/cspice/xposeg.c | 306 + ext/spice/src/cspice/xposeg_c.c | 222 + ext/spice/src/cspice/xpsgip.c | 252 + ext/spice/src/cspice/xwsne.c | 72 + ext/spice/src/cspice/z_abs.c | 12 + ext/spice/src/cspice/z_cos.c | 15 + ext/spice/src/cspice/z_div.c | 36 + ext/spice/src/cspice/z_exp.c | 17 + ext/spice/src/cspice/z_log.c | 16 + ext/spice/src/cspice/z_sin.c | 15 + ext/spice/src/cspice/z_sqrt.c | 29 + ext/spice/src/cspice/zzadbail_c.c | 181 + ext/spice/src/cspice/zzadfunc_c.c | 170 + ext/spice/src/cspice/zzadqdec_c.c | 196 + ext/spice/src/cspice/zzadrefn_c.c | 202 + ext/spice/src/cspice/zzadrepf_c.c | 174 + ext/spice/src/cspice/zzadrepi_c.c | 305 + ext/spice/src/cspice/zzadrepu_c.c | 197 + ext/spice/src/cspice/zzadsave_c.c | 412 + ext/spice/src/cspice/zzadstep_c.c | 183 + ext/spice/src/cspice/zzalloc.c | 1743 ++ ext/spice/src/cspice/zzalloc.h | 125 + ext/spice/src/cspice/zzascii.c | 517 + ext/spice/src/cspice/zzasryel.c | 857 + ext/spice/src/cspice/zzbodblt.c | 943 ++ ext/spice/src/cspice/zzbodbry.c | 226 + ext/spice/src/cspice/zzbodini.c | 305 + ext/spice/src/cspice/zzbodker.c | 514 + ext/spice/src/cspice/zzbodtrn.c | 2344 +++ ext/spice/src/cspice/zzbodvcd.c | 282 + ext/spice/src/cspice/zzck4d2i.c | 163 + ext/spice/src/cspice/zzck4i2d.c | 167 + ext/spice/src/cspice/zzckcv01.c | 361 + ext/spice/src/cspice/zzckcv02.c | 308 + ext/spice/src/cspice/zzckcv03.c | 427 + ext/spice/src/cspice/zzckcv04.c | 462 + ext/spice/src/cspice/zzckcv05.c | 549 + ext/spice/src/cspice/zzckspk.c | 383 + ext/spice/src/cspice/zzcln.c | 202 + ext/spice/src/cspice/zzcorepc.c | 335 + ext/spice/src/cspice/zzcorsxf.c | 456 + ext/spice/src/cspice/zzcputim.c | 241 + ext/spice/src/cspice/zzdafgdr.c | 605 + ext/spice/src/cspice/zzdafgfr.c | 684 + ext/spice/src/cspice/zzdafgsr.c | 736 + ext/spice/src/cspice/zzdafnfr.c | 438 + ext/spice/src/cspice/zzdasnfr.c | 424 + ext/spice/src/cspice/zzddhclu.c | 134 + ext/spice/src/cspice/zzddhf2h.c | 773 + ext/spice/src/cspice/zzddhgsd.c | 448 + ext/spice/src/cspice/zzddhgtu.c | 539 + ext/spice/src/cspice/zzddhini.c | 500 + ext/spice/src/cspice/zzddhivf.c | 642 + ext/spice/src/cspice/zzddhman.c | 3351 ++++ ext/spice/src/cspice/zzddhppf.c | 1084 ++ ext/spice/src/cspice/zzddhrcm.c | 169 + ext/spice/src/cspice/zzddhrmu.c | 478 + ext/spice/src/cspice/zzdynbid.c | 952 ++ ext/spice/src/cspice/zzdynfid.c | 911 ++ ext/spice/src/cspice/zzdynfr0.c | 2631 +++ ext/spice/src/cspice/zzdynfrm.c | 2631 +++ ext/spice/src/cspice/zzdynoac.c | 758 + ext/spice/src/cspice/zzdynoad.c | 817 + ext/spice/src/cspice/zzdynrot.c | 2443 +++ ext/spice/src/cspice/zzdynrt0.c | 2363 +++ ext/spice/src/cspice/zzdynvac.c | 813 + ext/spice/src/cspice/zzdynvad.c | 815 + ext/spice/src/cspice/zzdynvai.c | 818 + ext/spice/src/cspice/zzedterm.c | 598 + ext/spice/src/cspice/zzekac01.c | 1110 ++ ext/spice/src/cspice/zzekac02.c | 1112 ++ ext/spice/src/cspice/zzekac03.c | 1193 ++ ext/spice/src/cspice/zzekac04.c | 1179 ++ ext/spice/src/cspice/zzekac05.c | 1182 ++ ext/spice/src/cspice/zzekac06.c | 1290 ++ ext/spice/src/cspice/zzekac07.c | 959 ++ ext/spice/src/cspice/zzekac08.c | 959 ++ ext/spice/src/cspice/zzekac09.c | 989 ++ ext/spice/src/cspice/zzekacps.c | 392 + ext/spice/src/cspice/zzekad01.c | 890 ++ ext/spice/src/cspice/zzekad02.c | 887 ++ ext/spice/src/cspice/zzekad03.c | 947 ++ ext/spice/src/cspice/zzekad04.c | 927 ++ ext/spice/src/cspice/zzekad05.c | 934 ++ ext/spice/src/cspice/zzekad06.c | 1047 ++ ext/spice/src/cspice/zzekaps.c | 374 + ext/spice/src/cspice/zzekbs01.c | 1285 ++ ext/spice/src/cspice/zzekbs02.c | 1273 ++ ext/spice/src/cspice/zzekcchk.c | 994 ++ ext/spice/src/cspice/zzekcdsc.c | 457 + ext/spice/src/cspice/zzekcix1.c | 267 + ext/spice/src/cspice/zzekcnam.c | 392 + ext/spice/src/cspice/zzekde01.c | 835 + ext/spice/src/cspice/zzekde02.c | 835 + ext/spice/src/cspice/zzekde03.c | 880 + ext/spice/src/cspice/zzekde04.c | 804 + ext/spice/src/cspice/zzekde05.c | 865 + ext/spice/src/cspice/zzekde06.c | 863 + ext/spice/src/cspice/zzekdps.c | 512 + ext/spice/src/cspice/zzekecmp.c | 980 ++ ext/spice/src/cspice/zzekencd.c | 820 + ext/spice/src/cspice/zzekerc1.c | 705 + ext/spice/src/cspice/zzekerd1.c | 705 + ext/spice/src/cspice/zzekeri1.c | 704 + ext/spice/src/cspice/zzekesiz.c | 453 + ext/spice/src/cspice/zzekff01.c | 886 ++ ext/spice/src/cspice/zzekfrx.c | 661 + ext/spice/src/cspice/zzekgcdp.c | 570 + ext/spice/src/cspice/zzekgei.c | 274 + ext/spice/src/cspice/zzekgfwd.c | 459 + ext/spice/src/cspice/zzekglnk.c | 455 + ext/spice/src/cspice/zzekgrcp.c | 375 + ext/spice/src/cspice/zzekgrs.c | 250 + ext/spice/src/cspice/zzekif01.c | 630 + ext/spice/src/cspice/zzekif02.c | 737 + ext/spice/src/cspice/zzekiic1.c | 672 + ext/spice/src/cspice/zzekiid1.c | 672 + ext/spice/src/cspice/zzekiii1.c | 668 + ext/spice/src/cspice/zzekille.c | 589 + ext/spice/src/cspice/zzekillt.c | 586 + ext/spice/src/cspice/zzekinqc.c | 682 + ext/spice/src/cspice/zzekinqn.c | 657 + ext/spice/src/cspice/zzekixdl.c | 525 + ext/spice/src/cspice/zzekixlk.c | 503 + ext/spice/src/cspice/zzekjoin.c | 1010 ++ ext/spice/src/cspice/zzekjsqz.c | 616 + ext/spice/src/cspice/zzekjsrt.c | 1877 +++ ext/spice/src/cspice/zzekjtst.c | 2316 +++ ext/spice/src/cspice/zzekkey.c | 1145 ++ ext/spice/src/cspice/zzeklerc.c | 603 + ext/spice/src/cspice/zzeklerd.c | 602 + ext/spice/src/cspice/zzekleri.c | 603 + ext/spice/src/cspice/zzekllec.c | 721 + ext/spice/src/cspice/zzeklled.c | 720 + ext/spice/src/cspice/zzekllei.c | 719 + ext/spice/src/cspice/zzeklltc.c | 718 + ext/spice/src/cspice/zzeklltd.c | 715 + ext/spice/src/cspice/zzekllti.c | 717 + ext/spice/src/cspice/zzekmloc.c | 279 + ext/spice/src/cspice/zzeknres.c | 974 ++ ext/spice/src/cspice/zzeknrml.c | 3444 ++++ ext/spice/src/cspice/zzekordc.c | 263 + ext/spice/src/cspice/zzekordd.c | 250 + ext/spice/src/cspice/zzekordi.c | 252 + ext/spice/src/cspice/zzekpage.c | 2764 ++++ ext/spice/src/cspice/zzekpars.c | 2153 +++ ext/spice/src/cspice/zzekpcol.c | 1173 ++ ext/spice/src/cspice/zzekpdec.c | 1061 ++ ext/spice/src/cspice/zzekpgch.c | 446 + ext/spice/src/cspice/zzekqcnj.c | 565 + ext/spice/src/cspice/zzekqcon.c | 889 ++ ext/spice/src/cspice/zzekqini.c | 768 + ext/spice/src/cspice/zzekqord.c | 680 + ext/spice/src/cspice/zzekqsel.c | 694 + ext/spice/src/cspice/zzekqtab.c | 623 + ext/spice/src/cspice/zzekrbck.c | 834 + ext/spice/src/cspice/zzekrcmp.c | 798 + ext/spice/src/cspice/zzekrd01.c | 777 + ext/spice/src/cspice/zzekrd02.c | 772 + ext/spice/src/cspice/zzekrd03.c | 952 ++ ext/spice/src/cspice/zzekrd04.c | 910 ++ ext/spice/src/cspice/zzekrd05.c | 866 + ext/spice/src/cspice/zzekrd06.c | 1057 ++ ext/spice/src/cspice/zzekrd07.c | 818 + ext/spice/src/cspice/zzekrd08.c | 815 + ext/spice/src/cspice/zzekrd09.c | 938 ++ ext/spice/src/cspice/zzekreqi.c | 521 + ext/spice/src/cspice/zzekrmch.c | 714 + ext/spice/src/cspice/zzekrp2n.c | 299 + ext/spice/src/cspice/zzekrplk.c | 495 + ext/spice/src/cspice/zzekrsc.c | 573 + ext/spice/src/cspice/zzekrsd.c | 563 + ext/spice/src/cspice/zzekrsi.c | 568 + ext/spice/src/cspice/zzeksca.c | 1607 ++ ext/spice/src/cspice/zzekscan.c | 1096 ++ ext/spice/src/cspice/zzekscdp.c | 529 + ext/spice/src/cspice/zzekscmp.c | 1025 ++ ext/spice/src/cspice/zzeksdsc.c | 250 + ext/spice/src/cspice/zzeksei.c | 274 + ext/spice/src/cspice/zzeksemc.c | 1163 ++ ext/spice/src/cspice/zzeksfwd.c | 457 + ext/spice/src/cspice/zzeksinf.c | 653 + ext/spice/src/cspice/zzekslnk.c | 459 + ext/spice/src/cspice/zzeksrcp.c | 277 + ext/spice/src/cspice/zzeksrs.c | 267 + ext/spice/src/cspice/zzekstyp.c | 324 + ext/spice/src/cspice/zzeksz04.c | 747 + ext/spice/src/cspice/zzeksz05.c | 753 + ext/spice/src/cspice/zzeksz06.c | 747 + ext/spice/src/cspice/zzektcnv.c | 412 + ext/spice/src/cspice/zzektloc.c | 281 + ext/spice/src/cspice/zzektr13.c | 683 + ext/spice/src/cspice/zzektr1s.c | 1204 ++ ext/spice/src/cspice/zzektr23.c | 1043 ++ ext/spice/src/cspice/zzektr31.c | 712 + ext/spice/src/cspice/zzektr32.c | 1116 ++ ext/spice/src/cspice/zzektrap.c | 150 + ext/spice/src/cspice/zzektrbn.c | 467 + ext/spice/src/cspice/zzektrbs.c | 186 + ext/spice/src/cspice/zzektrdl.c | 855 + ext/spice/src/cspice/zzektrdp.c | 150 + ext/spice/src/cspice/zzektres.c | 1094 ++ ext/spice/src/cspice/zzektrfr.c | 693 + ext/spice/src/cspice/zzektrin.c | 694 + ext/spice/src/cspice/zzektrit.c | 550 + ext/spice/src/cspice/zzektrki.c | 393 + ext/spice/src/cspice/zzektrlk.c | 814 + ext/spice/src/cspice/zzektrls.c | 362 + ext/spice/src/cspice/zzektrnk.c | 353 + ext/spice/src/cspice/zzektrpi.c | 769 + ext/spice/src/cspice/zzektrrk.c | 931 ++ ext/spice/src/cspice/zzektrsb.c | 464 + ext/spice/src/cspice/zzektrsz.c | 345 + ext/spice/src/cspice/zzektrud.c | 932 ++ ext/spice/src/cspice/zzektrui.c | 943 ++ ext/spice/src/cspice/zzekue01.c | 873 + ext/spice/src/cspice/zzekue02.c | 873 + ext/spice/src/cspice/zzekue03.c | 730 + ext/spice/src/cspice/zzekue04.c | 449 + ext/spice/src/cspice/zzekue05.c | 449 + ext/spice/src/cspice/zzekue06.c | 728 + ext/spice/src/cspice/zzekvadr.c | 783 + ext/spice/src/cspice/zzekvcmp.c | 1219 ++ ext/spice/src/cspice/zzekvmch.c | 1058 ++ ext/spice/src/cspice/zzekweed.c | 625 + ext/spice/src/cspice/zzekweqi.c | 544 + ext/spice/src/cspice/zzekwpac.c | 649 + ext/spice/src/cspice/zzekwpai.c | 609 + ext/spice/src/cspice/zzekwpal.c | 668 + ext/spice/src/cspice/zzelvupy.c | 959 ++ ext/spice/src/cspice/zzenut80.c | 210 + ext/spice/src/cspice/zzeprc76.c | 225 + ext/spice/src/cspice/zzeprcss.c | 211 + ext/spice/src/cspice/zzerror.c | 362 + ext/spice/src/cspice/zzerror.h | 80 + ext/spice/src/cspice/zzerrorinit.c | 153 + ext/spice/src/cspice/zzfcstring.c | 1504 ++ ext/spice/src/cspice/zzfdat.c | 1061 ++ ext/spice/src/cspice/zzfovaxi.c | 397 + ext/spice/src/cspice/zzfrmch0.c | 878 + ext/spice/src/cspice/zzfrmch1.c | 878 + ext/spice/src/cspice/zzfrmgt0.c | 356 + ext/spice/src/cspice/zzfrmgt1.c | 354 + ext/spice/src/cspice/zzftpchk.c | 406 + ext/spice/src/cspice/zzftpstr.c | 468 + ext/spice/src/cspice/zzgapool.c | 221 + ext/spice/src/cspice/zzgetbff.c | 454 + ext/spice/src/cspice/zzgetcml_c.c | 363 + ext/spice/src/cspice/zzgetelm.c | 792 + ext/spice/src/cspice/zzgfcoq.c | 963 ++ ext/spice/src/cspice/zzgfcost.c | 740 + ext/spice/src/cspice/zzgfcou.c | 3497 ++++ ext/spice/src/cspice/zzgfcprx.c | 839 + ext/spice/src/cspice/zzgfcslv.c | 1400 ++ ext/spice/src/cspice/zzgfdiq.c | 202 + ext/spice/src/cspice/zzgfdiu.c | 1167 ++ ext/spice/src/cspice/zzgfdsps.c | 296 + ext/spice/src/cspice/zzgffvu.c | 2270 +++ ext/spice/src/cspice/zzgflong.c | 3014 ++++ ext/spice/src/cspice/zzgfocu.c | 1912 +++ ext/spice/src/cspice/zzgfref.c | 119 + ext/spice/src/cspice/zzgfrel.c | 1358 ++ ext/spice/src/cspice/zzgfrelx.c | 1354 ++ ext/spice/src/cspice/zzgfrpwk.c | 1280 ++ ext/spice/src/cspice/zzgfrrq.c | 224 + ext/spice/src/cspice/zzgfrru.c | 1201 ++ ext/spice/src/cspice/zzgfsavh_c.c | 281 + ext/spice/src/cspice/zzgfsolv.c | 795 + ext/spice/src/cspice/zzgfsolvx.c | 808 + ext/spice/src/cspice/zzgfspq.c | 306 + ext/spice/src/cspice/zzgfspu.c | 1437 ++ ext/spice/src/cspice/zzgfssin.c | 1286 ++ ext/spice/src/cspice/zzgfssob.c | 1187 ++ ext/spice/src/cspice/zzgftreb.c | 208 + ext/spice/src/cspice/zzgfudlt.c | 174 + ext/spice/src/cspice/zzgfwsts.c | 330 + ext/spice/src/cspice/zzgpnm.c | 262 + ext/spice/src/cspice/zzholdd.c | 242 + ext/spice/src/cspice/zzhullax.c | 772 + ext/spice/src/cspice/zzidmap.c | 1637 ++ ext/spice/src/cspice/zzinssub.c | 291 + ext/spice/src/cspice/zzldker.c | 358 + ext/spice/src/cspice/zzmkpc.c | 188 + ext/spice/src/cspice/zzmobliq.c | 185 + ext/spice/src/cspice/zzmsxf.c | 449 + ext/spice/src/cspice/zznofcon.c | 685 + ext/spice/src/cspice/zznrddp.c | 1503 ++ ext/spice/src/cspice/zznwpool.c | 201 + ext/spice/src/cspice/zzocced.c | 1547 ++ ext/spice/src/cspice/zzphsh.c | 816 + ext/spice/src/cspice/zzpini.c | 299 + ext/spice/src/cspice/zzplatfm.c | 366 + ext/spice/src/cspice/zzpltchk.c | 428 + ext/spice/src/cspice/zzprscor.c | 420 + ext/spice/src/cspice/zzrbrkst.c | 249 + ext/spice/src/cspice/zzrefch0.c | 680 + ext/spice/src/cspice/zzrefch1.c | 680 + ext/spice/src/cspice/zzrepsub.c | 298 + ext/spice/src/cspice/zzrept.c | 137 + ext/spice/src/cspice/zzrotgt0.c | 347 + ext/spice/src/cspice/zzrotgt1.c | 340 + ext/spice/src/cspice/zzrtnmat.c | 274 + ext/spice/src/cspice/zzrvar.c | 1158 ++ ext/spice/src/cspice/zzrvbf.c | 1087 ++ ext/spice/src/cspice/zzrxr.c | 264 + ext/spice/src/cspice/zzsclk.c | 321 + ext/spice/src/cspice/zzsecprt.c | 211 + ext/spice/src/cspice/zzsizeok.c | 218 + ext/spice/src/cspice/zzspkac0.c | 734 + ext/spice/src/cspice/zzspkac1.c | 734 + ext/spice/src/cspice/zzspkap0.c | 867 + ext/spice/src/cspice/zzspkap1.c | 867 + ext/spice/src/cspice/zzspkas0.c | 827 + ext/spice/src/cspice/zzspkas1.c | 828 + ext/spice/src/cspice/zzspkez0.c | 1416 ++ ext/spice/src/cspice/zzspkez1.c | 1432 ++ ext/spice/src/cspice/zzspkgo0.c | 1040 ++ ext/spice/src/cspice/zzspkgo1.c | 1042 ++ ext/spice/src/cspice/zzspkgp0.c | 1022 ++ ext/spice/src/cspice/zzspkgp1.c | 1019 ++ ext/spice/src/cspice/zzspklt0.c | 920 ++ ext/spice/src/cspice/zzspklt1.c | 920 ++ ext/spice/src/cspice/zzspkpa0.c | 814 + ext/spice/src/cspice/zzspkpa1.c | 815 + ext/spice/src/cspice/zzspksb0.c | 200 + ext/spice/src/cspice/zzspksb1.c | 200 + ext/spice/src/cspice/zzspkzp0.c | 1004 ++ ext/spice/src/cspice/zzspkzp1.c | 1019 ++ ext/spice/src/cspice/zzstelab.c | 552 + ext/spice/src/cspice/zzsynccl_c.c | 263 + ext/spice/src/cspice/zztime.c | 3737 +++++ ext/spice/src/cspice/zztpats.c | 597 + ext/spice/src/cspice/zztwovxf.c | 459 + ext/spice/src/cspice/zzutcpm.c | 237 + ext/spice/src/cspice/zzvalcor.c | 343 + ext/spice/src/cspice/zzvstrng.c | 748 + ext/spice/src/cspice/zzwahr.c | 470 + ext/spice/src/cspice/zzwind.c | 394 + ext/spice/src/cspice/zzwind2d.c | 343 + ext/spice/src/cspice/zzwninsd.c | 402 + ext/spice/src/cspice/zzxlated.c | 1085 ++ ext/spice/src/cspice/zzxlatei.c | 887 ++ ext/spice/src/csupport/SpiceCK.h | 155 + ext/spice/src/csupport/SpiceCel.h | 441 + ext/spice/src/csupport/SpiceEK.h | 448 + ext/spice/src/csupport/SpiceEll.h | 115 + ext/spice/src/csupport/SpiceGF.h | 319 + ext/spice/src/csupport/SpicePln.h | 106 + ext/spice/src/csupport/SpiceSPK.h | 128 + ext/spice/src/csupport/SpiceUsr.h | 217 + ext/spice/src/csupport/SpiceZad.h | 205 + ext/spice/src/csupport/SpiceZdf.h | 246 + ext/spice/src/csupport/SpiceZfc.h | 13228 ++++++++++++++++ ext/spice/src/csupport/SpiceZim.h | 1358 ++ ext/spice/src/csupport/SpiceZmc.h | 975 ++ ext/spice/src/csupport/SpiceZpl.h | 109 + ext/spice/src/csupport/SpiceZpr.h | 3853 +++++ ext/spice/src/csupport/SpiceZst.h | 199 + ext/spice/src/csupport/batch.c | 120 + ext/spice/src/csupport/bboard_1.c | 3130 ++++ ext/spice/src/csupport/bestwd.c | 730 + ext/spice/src/csupport/builtn.c | 423 + ext/spice/src/csupport/cbget_1.c | 214 + ext/spice/src/csupport/cbinit_1.c | 184 + ext/spice/src/csupport/cbput_1.c | 210 + ext/spice/src/csupport/cbrem_1.c | 215 + ext/spice/src/csupport/changu.c | 512 + ext/spice/src/csupport/chbfit.c | 545 + ext/spice/src/csupport/ck3sdn.c | 599 + ext/spice/src/csupport/cmloop.c | 563 + ext/spice/src/csupport/cmmore.c | 214 + ext/spice/src/csupport/cmredo.c | 226 + ext/spice/src/csupport/cmstup.c | 187 + ext/spice/src/csupport/cnfirm.c | 192 + ext/spice/src/csupport/cnfirm_1.c | 204 + ext/spice/src/csupport/convbt.c | 477 + ext/spice/src/csupport/convrt_2.c | 722 + ext/spice/src/csupport/convrt_3.c | 723 + ext/spice/src/csupport/convtb.c | 727 + ext/spice/src/csupport/cputim.c | 279 + ext/spice/src/csupport/crtptr.c | 211 + ext/spice/src/csupport/curtim.c | 190 + ext/spice/src/csupport/cutstr.c | 491 + ext/spice/src/csupport/dafacu.c | 860 + ext/spice/src/csupport/dafecu.c | 316 + ext/spice/src/csupport/dcyphr.c | 1019 ++ ext/spice/src/csupport/dimcb_1.c | 163 + ext/spice/src/csupport/dspvrs.c | 151 + ext/spice/src/csupport/echo.c | 335 + ext/spice/src/csupport/edtcmd.c | 352 + ext/spice/src/csupport/edtcom.c | 1022 ++ ext/spice/src/csupport/exesys.c | 323 + ext/spice/src/csupport/expfnm_1.c | 399 + ext/spice/src/csupport/expfnm_2.c | 407 + ext/spice/src/csupport/f2c.h | 654 + ext/spice/src/csupport/f2cMang.h | 390 + ext/spice/src/csupport/flgrpt.c | 175 + ext/spice/src/csupport/fndntk.c | 482 + ext/spice/src/csupport/fndptk.c | 480 + ext/spice/src/csupport/fnducv.c | 957 ++ ext/spice/src/csupport/getcml.c | 332 + ext/spice/src/csupport/getdel.c | 67 + ext/spice/src/csupport/geteq.c | 68 + ext/spice/src/csupport/getfnm.c | 441 + ext/spice/src/csupport/getfnm_1.c | 562 + ext/spice/src/csupport/getopt.c | 376 + ext/spice/src/csupport/getopt_1.c | 361 + ext/spice/src/csupport/getopt_2.c | 348 + ext/spice/src/csupport/have.c | 190 + ext/spice/src/csupport/header.c | 273 + ext/spice/src/csupport/langua.c | 98 + ext/spice/src/csupport/lbdes_1.c | 163 + ext/spice/src/csupport/lbget_1.c | 187 + ext/spice/src/csupport/lbinit_1.c | 212 + ext/spice/src/csupport/lbins_1.c | 261 + ext/spice/src/csupport/lbpack_1.c | 190 + ext/spice/src/csupport/lbrem_1.c | 254 + ext/spice/src/csupport/lbupd_1.c | 156 + ext/spice/src/csupport/logchk.c | 160 + ext/spice/src/csupport/m2alph.c | 159 + ext/spice/src/csupport/m2begr.c | 336 + ext/spice/src/csupport/m2bodini.c | 198 + ext/spice/src/csupport/m2bodtrn.c | 1486 ++ ext/spice/src/csupport/m2body.c | 165 + ext/spice/src/csupport/m2cal.c | 262 + ext/spice/src/csupport/m2chck.c | 288 + ext/spice/src/csupport/m2clss.c | 376 + ext/spice/src/csupport/m2core.c | 2017 +++ ext/spice/src/csupport/m2day.c | 230 + ext/spice/src/csupport/m2diag.c | 570 + ext/spice/src/csupport/m2engl.c | 169 + ext/spice/src/csupport/m2epoc.c | 165 + ext/spice/src/csupport/m2geta.c | 392 + ext/spice/src/csupport/m2getb.c | 374 + ext/spice/src/csupport/m2getc.c | 352 + ext/spice/src/csupport/m2getd.c | 362 + ext/spice/src/csupport/m2geti.c | 363 + ext/spice/src/csupport/m2gmch.c | 1080 ++ ext/spice/src/csupport/m2have.c | 174 + ext/spice/src/csupport/m2int.c | 284 + ext/spice/src/csupport/m2ints.c | 268 + ext/spice/src/csupport/m2keyw.c | 263 + ext/spice/src/csupport/m2mon.c | 207 + ext/spice/src/csupport/m2name.c | 178 + ext/spice/src/csupport/m2ntem.c | 224 + ext/spice/src/csupport/m2numb.c | 222 + ext/spice/src/csupport/m2pars.c | 1254 ++ ext/spice/src/csupport/m2selb.c | 359 + ext/spice/src/csupport/m2selc.c | 355 + ext/spice/src/csupport/m2seld.c | 364 + ext/spice/src/csupport/m2seli.c | 363 + ext/spice/src/csupport/m2shll.c | 211 + ext/spice/src/csupport/m2term.c | 423 + ext/spice/src/csupport/m2thnq.c | 170 + ext/spice/src/csupport/m2time.c | 319 + ext/spice/src/csupport/m2tran.c | 323 + ext/spice/src/csupport/m2trim.c | 200 + ext/spice/src/csupport/m2unit.c | 142 + ext/spice/src/csupport/m2wmch.c | 375 + ext/spice/src/csupport/m2xist.c | 190 + ext/spice/src/csupport/m2year.c | 237 + ext/spice/src/csupport/makstr.c | 860 + ext/spice/src/csupport/match.c | 239 + ext/spice/src/csupport/matchc.c | 389 + ext/spice/src/csupport/matche.c | 320 + ext/spice/src/csupport/matchm.c | 636 + ext/spice/src/csupport/matcho.c | 459 + ext/spice/src/csupport/meta_2.c | 504 + ext/spice/src/csupport/mkprodct.csh | 314 + ext/spice/src/csupport/mspeld.c | 266 + ext/spice/src/csupport/ncodec.c | 285 + ext/spice/src/csupport/ncoded.c | 283 + ext/spice/src/csupport/ncodei.c | 283 + ext/spice/src/csupport/newfil.c | 351 + ext/spice/src/csupport/newfil_1.c | 255 + ext/spice/src/csupport/nicebt_1.c | 1107 ++ ext/spice/src/csupport/niceio_3.c | 1136 ++ ext/spice/src/csupport/nicepr_1.c | 1121 ++ ext/spice/src/csupport/no.c | 51 + ext/spice/src/csupport/nspio.c | 2331 +++ ext/spice/src/csupport/nsplgr.c | 247 + ext/spice/src/csupport/nspopl.c | 219 + ext/spice/src/csupport/nsppwd.c | 242 + ext/spice/src/csupport/nspsav.c | 61 + ext/spice/src/csupport/nspxcp.c | 220 + ext/spice/src/csupport/nthuqt.c | 267 + ext/spice/src/csupport/nthuqw.c | 267 + ext/spice/src/csupport/nxtcom.c | 719 + ext/spice/src/csupport/occurs.c | 155 + ext/spice/src/csupport/pagman.c | 1348 ++ ext/spice/src/csupport/pltfrm.c | 202 + ext/spice/src/csupport/podaec.c | 204 + ext/spice/src/csupport/podaed.c | 204 + ext/spice/src/csupport/podaei.c | 204 + ext/spice/src/csupport/podbec.c | 169 + ext/spice/src/csupport/podbed.c | 168 + ext/spice/src/csupport/podbei.c | 168 + ext/spice/src/csupport/podbgc.c | 203 + ext/spice/src/csupport/podbgd.c | 199 + ext/spice/src/csupport/podbgi.c | 199 + ext/spice/src/csupport/podcgc.c | 243 + ext/spice/src/csupport/podcgd.c | 238 + ext/spice/src/csupport/podcgi.c | 239 + ext/spice/src/csupport/poddgc.c | 198 + ext/spice/src/csupport/poddgd.c | 198 + ext/spice/src/csupport/poddgi.c | 197 + ext/spice/src/csupport/podegc.c | 241 + ext/spice/src/csupport/podegd.c | 237 + ext/spice/src/csupport/podegi.c | 238 + ext/spice/src/csupport/podiec.c | 220 + ext/spice/src/csupport/podied.c | 220 + ext/spice/src/csupport/podiei.c | 219 + ext/spice/src/csupport/podonc.c | 177 + ext/spice/src/csupport/podond.c | 177 + ext/spice/src/csupport/podoni.c | 176 + ext/spice/src/csupport/podrec.c | 213 + ext/spice/src/csupport/podred.c | 212 + ext/spice/src/csupport/podrei.c | 211 + ext/spice/src/csupport/podrgc.c | 244 + ext/spice/src/csupport/podrgd.c | 240 + ext/spice/src/csupport/podrgi.c | 239 + ext/spice/src/csupport/prcomf.c | 868 + ext/spice/src/csupport/prepsn.c | 316 + ext/spice/src/csupport/prtrap.c | 208 + ext/spice/src/csupport/pstack.c | 1092 ++ ext/spice/src/csupport/qlstnb.c | 247 + ext/spice/src/csupport/qmini.c | 343 + ext/spice/src/csupport/qrtrim.c | 272 + ext/spice/src/csupport/qtran.c | 203 + ext/spice/src/csupport/rdstmn.c | 151 + ext/spice/src/csupport/rdstmt.c | 153 + ext/spice/src/csupport/ressym.c | 150 + ext/spice/src/csupport/rptsym.c | 132 + ext/spice/src/csupport/sbget_1.c | 184 + ext/spice/src/csupport/sbinit_1.c | 212 + ext/spice/src/csupport/sbrem_1.c | 187 + ext/spice/src/csupport/sbset_1.c | 226 + ext/spice/src/csupport/scansl.c | 193 + ext/spice/src/csupport/shosym.c | 186 + ext/spice/src/csupport/signal1.h | 118 + ext/spice/src/csupport/sizecb_1.c | 162 + ext/spice/src/csupport/spcacb.c | 446 + ext/spice/src/csupport/stran.c | 714 + ext/spice/src/csupport/syptrc.c | 216 + ext/spice/src/csupport/syptri.c | 202 + ext/spice/src/csupport/tabrpt.c | 882 ++ ext/spice/src/csupport/trnlat.c | 374 + ext/spice/src/csupport/txtops.c | 274 + ext/spice/src/csupport/unitp.c | 394 + ext/spice/src/csupport/upto.c | 211 + ext/spice/src/csupport/utrans_2.c | 356 + ext/spice/src/csupport/zzalloc.h | 125 + ext/spice/src/csupport/zzckcvr2.c | 219 + ext/spice/src/csupport/zzckcvr3.c | 325 + ext/spice/src/csupport/zzckcvr4.c | 349 + ext/spice/src/csupport/zzckcvr5.c | 403 + ext/spice/src/csupport/zzerror.h | 80 + ext/spice/src/csupport/zzgetenv.c | 332 + ext/spice/src/csupport/zzgetfat.c | 752 + ext/spice/src/csupport/zznsppok.c | 159 + ext/spice/src/csupport/zztxtopn.c | 290 + modules/common/common.xml | 24 + modules/common/shaders/powerscale_fs.glsl | 107 + modules/common/shaders/powerscale_vs.glsl | 100 + modules/common/shaders/pscstandard_fs.glsl | 106 + modules/common/shaders/pscstandard_vs.glsl | 95 + src/CMakeLists.txt | 58 + src/camera.cpp | 97 + src/camera.h | 59 + src/deviceidentifier.cpp | 157 + src/deviceidentifier.h | 58 + .../externalconnectioncontroller.cpp | 12 + .../externalconnectioncontroller.h | 24 + src/externalcontrol/externalcontrol.cpp | 32 + src/externalcontrol/externalcontrol.h | 30 + .../joystickexternalcontrol.cpp | 63 + .../joystickexternalcontrol.cpp.orig | 63 + src/externalcontrol/joystickexternalcontrol.h | 28 + .../keyboardexternalcontrol.cpp | 62 + .../keyboardexternalcontrol.cpp.orig | 62 + src/externalcontrol/keyboardexternalcontrol.h | 25 + src/externalcontrol/mouseexternalcontrol.cpp | 79 + .../mouseexternalcontrol.cpp.orig | 79 + src/externalcontrol/mouseexternalcontrol.h | 28 + src/externalcontrol/pythonexternalcontrol.cpp | 147 + src/externalcontrol/pythonexternalcontrol.h | 35 + src/externalcontrol/randomexternalcontrol.cpp | 59 + src/externalcontrol/randomexternalcontrol.h | 26 + src/interactionhandler.cpp | 228 + src/interactionhandler.h | 86 + src/main.cpp | 148 + src/object.cpp | 27 + src/object.h | 21 + src/renderable.cpp | 32 + src/renderable.h | 33 + src/renderablebody.cpp | 74 + src/renderablebody.h | 37 + src/renderableplanet.cpp | 71 + src/renderableplanet.h | 37 + src/renderengine.cpp | 389 + src/renderengine.h | 52 + src/scenegraph/scenegraph.cpp | 63 + src/scenegraph/scenegraph.h | 40 + src/scenegraph/scenegraphloader.cpp | 431 + src/scenegraph/scenegraphloader.h | 51 + src/scenegraph/scenegraphnode.cpp | 257 + src/scenegraph/scenegraphnode.h | 75 + src/util/geometry.cpp | 59 + src/util/geometry.h | 38 + src/util/planet.cpp | 169 + src/util/planet.h | 49 + src/util/psc.cpp | 279 + src/util/psc.h | 98 + src/util/pss.cpp | 270 + src/util/pss.h | 92 + src/util/sphere.cpp | 169 + src/util/sphere.h | 29 + src/util/spice.cpp | 196 + src/util/spice.h | 45 + src/util/time.cpp | 62 + src/util/time.h | 35 + src/util/vbo.cpp | 179 + src/util/vbo.h | 63 + src/util/vbo_template.h | 110 + 2276 files changed, 996697 insertions(+) create mode 100644 .gitignore create mode 100644 .gitmodules create mode 100644 CMakeLists.txt create mode 100644 CREDITS create mode 100644 config/single.xml create mode 160000 ext/ghoul create mode 100644 ext/lua/CMakeLists.txt create mode 100644 ext/lua/include/lapi.h create mode 100644 ext/lua/include/lauxlib.h create mode 100644 ext/lua/include/lcode.h create mode 100644 ext/lua/include/lctype.h create mode 100644 ext/lua/include/ldebug.h create mode 100644 ext/lua/include/ldo.h create mode 100644 ext/lua/include/lfunc.h create mode 100644 ext/lua/include/lgc.h create mode 100644 ext/lua/include/llex.h create mode 100644 ext/lua/include/llimits.h create mode 100644 ext/lua/include/lmem.h create mode 100644 ext/lua/include/lobject.h create mode 100644 ext/lua/include/lopcodes.h create mode 100644 ext/lua/include/lparser.h create mode 100644 ext/lua/include/lstate.h create mode 100644 ext/lua/include/lstring.h create mode 100644 ext/lua/include/ltable.h create mode 100644 ext/lua/include/ltm.h create mode 100644 ext/lua/include/lua.h create mode 100644 ext/lua/include/lua.hpp create mode 100644 ext/lua/include/luaconf.h create mode 100644 ext/lua/include/lualib.h create mode 100644 ext/lua/include/lundump.h create mode 100644 ext/lua/include/lvm.h create mode 100644 ext/lua/include/lzio.h create mode 100644 ext/lua/src/lapi.c create mode 100644 ext/lua/src/lauxlib.c create mode 100644 ext/lua/src/lbaselib.c create mode 100644 ext/lua/src/lbitlib.c create mode 100644 ext/lua/src/lcode.c create mode 100644 ext/lua/src/lcorolib.c create mode 100644 ext/lua/src/lctype.c create mode 100644 ext/lua/src/ldblib.c create mode 100644 ext/lua/src/ldebug.c create mode 100644 ext/lua/src/ldo.c create mode 100644 ext/lua/src/ldump.c create mode 100644 ext/lua/src/lfunc.c create mode 100644 ext/lua/src/lgc.c create mode 100644 ext/lua/src/linit.c create mode 100644 ext/lua/src/liolib.c create mode 100644 ext/lua/src/llex.c create mode 100644 ext/lua/src/lmathlib.c create mode 100644 ext/lua/src/lmem.c create mode 100644 ext/lua/src/loadlib.c create mode 100644 ext/lua/src/lobject.c create mode 100644 ext/lua/src/lopcodes.c create mode 100644 ext/lua/src/loslib.c create mode 100644 ext/lua/src/lparser.c create mode 100644 ext/lua/src/lstate.c create mode 100644 ext/lua/src/lstring.c create mode 100644 ext/lua/src/lstrlib.c create mode 100644 ext/lua/src/ltable.c create mode 100644 ext/lua/src/ltablib.c create mode 100644 ext/lua/src/ltm.c create mode 100644 ext/lua/src/lundump.c create mode 100644 ext/lua/src/lvm.c create mode 100644 ext/lua/src/lzio.c create mode 100644 ext/spice/CMakeLists.txt create mode 100644 ext/spice/include/SpiceCK.h create mode 100644 ext/spice/include/SpiceCel.h create mode 100644 ext/spice/include/SpiceEK.h create mode 100644 ext/spice/include/SpiceEll.h create mode 100644 ext/spice/include/SpiceGF.h create mode 100644 ext/spice/include/SpicePln.h create mode 100644 ext/spice/include/SpiceSPK.h create mode 100644 ext/spice/include/SpiceUsr.h create mode 100644 ext/spice/include/SpiceZad.h create mode 100644 ext/spice/include/SpiceZdf.h create mode 100644 ext/spice/include/SpiceZfc.h create mode 100644 ext/spice/include/SpiceZim.h create mode 100644 ext/spice/include/SpiceZmc.h create mode 100644 ext/spice/include/SpiceZpl.h create mode 100644 ext/spice/include/SpiceZpr.h create mode 100644 ext/spice/include/SpiceZst.h create mode 100644 ext/spice/include/f2c.h create mode 100644 ext/spice/include/f2cMang.h create mode 100644 ext/spice/include/fio.h create mode 100644 ext/spice/include/fmt.h create mode 100644 ext/spice/include/fp.h create mode 100644 ext/spice/include/lio.h create mode 100644 ext/spice/include/rawio.h create mode 100644 ext/spice/include/signal1.h create mode 100644 ext/spice/include/zzalloc.h create mode 100644 ext/spice/include/zzerror.h create mode 100644 ext/spice/src/cspice/F77_aloc.c create mode 100644 ext/spice/src/cspice/SpiceCK.h create mode 100644 ext/spice/src/cspice/SpiceCel.h create mode 100644 ext/spice/src/cspice/SpiceEK.h create mode 100644 ext/spice/src/cspice/SpiceEll.h create mode 100644 ext/spice/src/cspice/SpiceGF.h create mode 100644 ext/spice/src/cspice/SpicePln.h create mode 100644 ext/spice/src/cspice/SpiceSPK.h create mode 100644 ext/spice/src/cspice/SpiceUsr.h create mode 100644 ext/spice/src/cspice/SpiceZad.h create mode 100644 ext/spice/src/cspice/SpiceZdf.h create mode 100644 ext/spice/src/cspice/SpiceZfc.h create mode 100644 ext/spice/src/cspice/SpiceZim.h create mode 100644 ext/spice/src/cspice/SpiceZmc.h create mode 100644 ext/spice/src/cspice/SpiceZpl.h create mode 100644 ext/spice/src/cspice/SpiceZpr.h create mode 100644 ext/spice/src/cspice/SpiceZst.h create mode 100644 ext/spice/src/cspice/abort_.c create mode 100644 ext/spice/src/cspice/accept.c create mode 100644 ext/spice/src/cspice/alltru.c create mode 100644 ext/spice/src/cspice/ana.c create mode 100644 ext/spice/src/cspice/appndc.c create mode 100644 ext/spice/src/cspice/appndc_c.c create mode 100644 ext/spice/src/cspice/appndd.c create mode 100644 ext/spice/src/cspice/appndd_c.c create mode 100644 ext/spice/src/cspice/appndi.c create mode 100644 ext/spice/src/cspice/appndi_c.c create mode 100644 ext/spice/src/cspice/approx.c create mode 100644 ext/spice/src/cspice/astrip.c create mode 100644 ext/spice/src/cspice/axisar.c create mode 100644 ext/spice/src/cspice/axisar_c.c create mode 100644 ext/spice/src/cspice/b1900.c create mode 100644 ext/spice/src/cspice/b1900_c.c create mode 100644 ext/spice/src/cspice/b1950.c create mode 100644 ext/spice/src/cspice/b1950_c.c create mode 100644 ext/spice/src/cspice/backspace.c create mode 100644 ext/spice/src/cspice/badkpv.c create mode 100644 ext/spice/src/cspice/badkpv_c.c create mode 100644 ext/spice/src/cspice/bedec.c create mode 100644 ext/spice/src/cspice/beint.c create mode 100644 ext/spice/src/cspice/benum.c create mode 100644 ext/spice/src/cspice/beuns.c create mode 100644 ext/spice/src/cspice/bodc2n.c create mode 100644 ext/spice/src/cspice/bodc2n_c.c create mode 100644 ext/spice/src/cspice/bodc2s.c create mode 100644 ext/spice/src/cspice/bodc2s_c.c create mode 100644 ext/spice/src/cspice/boddef.c create mode 100644 ext/spice/src/cspice/boddef_c.c create mode 100644 ext/spice/src/cspice/bodeul.c create mode 100644 ext/spice/src/cspice/bodfnd.c create mode 100644 ext/spice/src/cspice/bodfnd_c.c create mode 100644 ext/spice/src/cspice/bodmat.c create mode 100644 ext/spice/src/cspice/bodn2c.c create mode 100644 ext/spice/src/cspice/bodn2c_c.c create mode 100644 ext/spice/src/cspice/bods2c.c create mode 100644 ext/spice/src/cspice/bods2c_c.c create mode 100644 ext/spice/src/cspice/bodvar.c create mode 100644 ext/spice/src/cspice/bodvar_c.c create mode 100644 ext/spice/src/cspice/bodvcd.c create mode 100644 ext/spice/src/cspice/bodvcd_c.c create mode 100644 ext/spice/src/cspice/bodvrd.c create mode 100644 ext/spice/src/cspice/bodvrd_c.c create mode 100644 ext/spice/src/cspice/brcktd.c create mode 100644 ext/spice/src/cspice/brcktd_c.c create mode 100644 ext/spice/src/cspice/brckti.c create mode 100644 ext/spice/src/cspice/brckti_c.c create mode 100644 ext/spice/src/cspice/bschoc.c create mode 100644 ext/spice/src/cspice/bschoc_c.c create mode 100644 ext/spice/src/cspice/bschoi.c create mode 100644 ext/spice/src/cspice/bschoi_c.c create mode 100644 ext/spice/src/cspice/bsrchc.c create mode 100644 ext/spice/src/cspice/bsrchc_c.c create mode 100644 ext/spice/src/cspice/bsrchd.c create mode 100644 ext/spice/src/cspice/bsrchd_c.c create mode 100644 ext/spice/src/cspice/bsrchi.c create mode 100644 ext/spice/src/cspice/bsrchi_c.c create mode 100644 ext/spice/src/cspice/byebye.c create mode 100644 ext/spice/src/cspice/c_abs.c create mode 100644 ext/spice/src/cspice/c_cos.c create mode 100644 ext/spice/src/cspice/c_div.c create mode 100644 ext/spice/src/cspice/c_exp.c create mode 100644 ext/spice/src/cspice/c_log.c create mode 100644 ext/spice/src/cspice/c_sin.c create mode 100644 ext/spice/src/cspice/c_sqrt.c create mode 100644 ext/spice/src/cspice/cabs.c create mode 100644 ext/spice/src/cspice/card_c.c create mode 100644 ext/spice/src/cspice/cardc.c create mode 100644 ext/spice/src/cspice/cardd.c create mode 100644 ext/spice/src/cspice/cardi.c create mode 100644 ext/spice/src/cspice/cgv2el.c create mode 100644 ext/spice/src/cspice/cgv2el_c.c create mode 100644 ext/spice/src/cspice/chbase.c create mode 100644 ext/spice/src/cspice/chbder.c create mode 100644 ext/spice/src/cspice/chbint.c create mode 100644 ext/spice/src/cspice/chbval.c create mode 100644 ext/spice/src/cspice/chckid.c create mode 100644 ext/spice/src/cspice/chgirf.c create mode 100644 ext/spice/src/cspice/chkin_c.c create mode 100644 ext/spice/src/cspice/chkout_c.c create mode 100644 ext/spice/src/cspice/cidfrm_c.c create mode 100644 ext/spice/src/cspice/ckbsr.c create mode 100644 ext/spice/src/cspice/ckcls.c create mode 100644 ext/spice/src/cspice/ckcls_c.c create mode 100644 ext/spice/src/cspice/ckcov.c create mode 100644 ext/spice/src/cspice/ckcov_c.c create mode 100644 ext/spice/src/cspice/cke01.c create mode 100644 ext/spice/src/cspice/cke02.c create mode 100644 ext/spice/src/cspice/cke03.c create mode 100644 ext/spice/src/cspice/cke04.c create mode 100644 ext/spice/src/cspice/cke05.c create mode 100644 ext/spice/src/cspice/ckfrot.c create mode 100644 ext/spice/src/cspice/ckfxfm.c create mode 100644 ext/spice/src/cspice/ckgp.c create mode 100644 ext/spice/src/cspice/ckgp_c.c create mode 100644 ext/spice/src/cspice/ckgpav.c create mode 100644 ext/spice/src/cspice/ckgpav_c.c create mode 100644 ext/spice/src/cspice/ckgr01.c create mode 100644 ext/spice/src/cspice/ckgr02.c create mode 100644 ext/spice/src/cspice/ckgr03.c create mode 100644 ext/spice/src/cspice/ckgr04.c create mode 100644 ext/spice/src/cspice/ckgr05.c create mode 100644 ext/spice/src/cspice/cklpf_c.c create mode 100644 ext/spice/src/cspice/ckmeta.c create mode 100644 ext/spice/src/cspice/cknr01.c create mode 100644 ext/spice/src/cspice/cknr02.c create mode 100644 ext/spice/src/cspice/cknr03.c create mode 100644 ext/spice/src/cspice/cknr04.c create mode 100644 ext/spice/src/cspice/cknr05.c create mode 100644 ext/spice/src/cspice/ckobj.c create mode 100644 ext/spice/src/cspice/ckobj_c.c create mode 100644 ext/spice/src/cspice/ckopn.c create mode 100644 ext/spice/src/cspice/ckopn_c.c create mode 100644 ext/spice/src/cspice/ckpfs.c create mode 100644 ext/spice/src/cspice/ckr01.c create mode 100644 ext/spice/src/cspice/ckr02.c create mode 100644 ext/spice/src/cspice/ckr03.c create mode 100644 ext/spice/src/cspice/ckr04.c create mode 100644 ext/spice/src/cspice/ckr05.c create mode 100644 ext/spice/src/cspice/ckupf_c.c create mode 100644 ext/spice/src/cspice/ckw01.c create mode 100644 ext/spice/src/cspice/ckw01_c.c create mode 100644 ext/spice/src/cspice/ckw02.c create mode 100644 ext/spice/src/cspice/ckw02_c.c create mode 100644 ext/spice/src/cspice/ckw03.c create mode 100644 ext/spice/src/cspice/ckw03_c.c create mode 100644 ext/spice/src/cspice/ckw04a.c create mode 100644 ext/spice/src/cspice/ckw04b.c create mode 100644 ext/spice/src/cspice/ckw04e.c create mode 100644 ext/spice/src/cspice/ckw05.c create mode 100644 ext/spice/src/cspice/ckw05_c.c create mode 100644 ext/spice/src/cspice/clearc.c create mode 100644 ext/spice/src/cspice/cleard.c create mode 100644 ext/spice/src/cspice/cleari.c create mode 100644 ext/spice/src/cspice/clight.c create mode 100644 ext/spice/src/cspice/clight_c.c create mode 100644 ext/spice/src/cspice/close.c create mode 100644 ext/spice/src/cspice/clpool_c.c create mode 100644 ext/spice/src/cspice/cmprss.c create mode 100644 ext/spice/src/cspice/cmprss_c.c create mode 100644 ext/spice/src/cspice/cnmfrm_c.c create mode 100644 ext/spice/src/cspice/conics.c create mode 100644 ext/spice/src/cspice/conics_c.c create mode 100644 ext/spice/src/cspice/convrt.c create mode 100644 ext/spice/src/cspice/convrt_c.c create mode 100644 ext/spice/src/cspice/copy_c.c create mode 100644 ext/spice/src/cspice/copyc.c create mode 100644 ext/spice/src/cspice/copyd.c create mode 100644 ext/spice/src/cspice/copyi.c create mode 100644 ext/spice/src/cspice/countc.c create mode 100644 ext/spice/src/cspice/cpos.c create mode 100644 ext/spice/src/cspice/cpos_c.c create mode 100644 ext/spice/src/cspice/cposr.c create mode 100644 ext/spice/src/cspice/cposr_c.c create mode 100644 ext/spice/src/cspice/cvpool_c.c create mode 100644 ext/spice/src/cspice/cyacip.c create mode 100644 ext/spice/src/cspice/cyadip.c create mode 100644 ext/spice/src/cspice/cyaiip.c create mode 100644 ext/spice/src/cspice/cyclac.c create mode 100644 ext/spice/src/cspice/cyclad.c create mode 100644 ext/spice/src/cspice/cyclai.c create mode 100644 ext/spice/src/cspice/cyclec.c create mode 100644 ext/spice/src/cspice/cyllat.c create mode 100644 ext/spice/src/cspice/cyllat_c.c create mode 100644 ext/spice/src/cspice/cylrec.c create mode 100644 ext/spice/src/cspice/cylrec_c.c create mode 100644 ext/spice/src/cspice/cylsph.c create mode 100644 ext/spice/src/cspice/cylsph_c.c create mode 100644 ext/spice/src/cspice/d_abs.c create mode 100644 ext/spice/src/cspice/d_acos.c create mode 100644 ext/spice/src/cspice/d_asin.c create mode 100644 ext/spice/src/cspice/d_atan.c create mode 100644 ext/spice/src/cspice/d_atn2.c create mode 100644 ext/spice/src/cspice/d_cnjg.c create mode 100644 ext/spice/src/cspice/d_cos.c create mode 100644 ext/spice/src/cspice/d_cosh.c create mode 100644 ext/spice/src/cspice/d_dim.c create mode 100644 ext/spice/src/cspice/d_exp.c create mode 100644 ext/spice/src/cspice/d_imag.c create mode 100644 ext/spice/src/cspice/d_int.c create mode 100644 ext/spice/src/cspice/d_lg10.c create mode 100644 ext/spice/src/cspice/d_log.c create mode 100644 ext/spice/src/cspice/d_mod.c create mode 100644 ext/spice/src/cspice/d_nint.c create mode 100644 ext/spice/src/cspice/d_prod.c create mode 100644 ext/spice/src/cspice/d_sign.c create mode 100644 ext/spice/src/cspice/d_sin.c create mode 100644 ext/spice/src/cspice/d_sinh.c create mode 100644 ext/spice/src/cspice/d_sqrt.c create mode 100644 ext/spice/src/cspice/d_tan.c create mode 100644 ext/spice/src/cspice/d_tanh.c create mode 100644 ext/spice/src/cspice/dacosh.c create mode 100644 ext/spice/src/cspice/dacosn.c create mode 100644 ext/spice/src/cspice/dafa2b.c create mode 100644 ext/spice/src/cspice/dafac.c create mode 100644 ext/spice/src/cspice/dafac_c.c create mode 100644 ext/spice/src/cspice/dafah.c create mode 100644 ext/spice/src/cspice/dafana.c create mode 100644 ext/spice/src/cspice/dafarr.c create mode 100644 ext/spice/src/cspice/dafb2a.c create mode 100644 ext/spice/src/cspice/dafb2t.c create mode 100644 ext/spice/src/cspice/dafbbs_c.c create mode 100644 ext/spice/src/cspice/dafbfs_c.c create mode 100644 ext/spice/src/cspice/dafbt.c create mode 100644 ext/spice/src/cspice/dafcls_c.c create mode 100644 ext/spice/src/cspice/dafcs_c.c create mode 100644 ext/spice/src/cspice/dafdc.c create mode 100644 ext/spice/src/cspice/dafdc_c.c create mode 100644 ext/spice/src/cspice/dafec.c create mode 100644 ext/spice/src/cspice/dafec_c.c create mode 100644 ext/spice/src/cspice/daffa.c create mode 100644 ext/spice/src/cspice/daffna_c.c create mode 100644 ext/spice/src/cspice/daffpa_c.c create mode 100644 ext/spice/src/cspice/dafgda.c create mode 100644 ext/spice/src/cspice/dafgda_c.c create mode 100644 ext/spice/src/cspice/dafgn_c.c create mode 100644 ext/spice/src/cspice/dafgs_c.c create mode 100644 ext/spice/src/cspice/dafgsr_c.c create mode 100644 ext/spice/src/cspice/dafopr_c.c create mode 100644 ext/spice/src/cspice/dafopw_c.c create mode 100644 ext/spice/src/cspice/dafps.c create mode 100644 ext/spice/src/cspice/dafps_c.c create mode 100644 ext/spice/src/cspice/dafra.c create mode 100644 ext/spice/src/cspice/dafrcr.c create mode 100644 ext/spice/src/cspice/dafrda.c create mode 100644 ext/spice/src/cspice/dafrda_c.c create mode 100644 ext/spice/src/cspice/dafrfr.c create mode 100644 ext/spice/src/cspice/dafrfr_c.c create mode 100644 ext/spice/src/cspice/dafrrr.c create mode 100644 ext/spice/src/cspice/dafrs_c.c create mode 100644 ext/spice/src/cspice/dafrwa.c create mode 100644 ext/spice/src/cspice/dafrwd.c create mode 100644 ext/spice/src/cspice/daft2b.c create mode 100644 ext/spice/src/cspice/daftb.c create mode 100644 ext/spice/src/cspice/dafus_c.c create mode 100644 ext/spice/src/cspice/dafwcr.c create mode 100644 ext/spice/src/cspice/dafwda.c create mode 100644 ext/spice/src/cspice/dafwfr.c create mode 100644 ext/spice/src/cspice/dasa2l.c create mode 100644 ext/spice/src/cspice/dasac.c create mode 100644 ext/spice/src/cspice/dasac_c.c create mode 100644 ext/spice/src/cspice/dasacr.c create mode 100644 ext/spice/src/cspice/dasacu.c create mode 100644 ext/spice/src/cspice/dasadc.c create mode 100644 ext/spice/src/cspice/dasadd.c create mode 100644 ext/spice/src/cspice/dasadi.c create mode 100644 ext/spice/src/cspice/dasbt.c create mode 100644 ext/spice/src/cspice/dascls.c create mode 100644 ext/spice/src/cspice/dascls_c.c create mode 100644 ext/spice/src/cspice/dascud.c create mode 100644 ext/spice/src/cspice/dasdc.c create mode 100644 ext/spice/src/cspice/dasec.c create mode 100644 ext/spice/src/cspice/dasec_c.c create mode 100644 ext/spice/src/cspice/dasecu.c create mode 100644 ext/spice/src/cspice/dasfm.c create mode 100644 ext/spice/src/cspice/dasine.c create mode 100644 ext/spice/src/cspice/dasioc.c create mode 100644 ext/spice/src/cspice/dasiod.c create mode 100644 ext/spice/src/cspice/dasioi.c create mode 100644 ext/spice/src/cspice/daslla.c create mode 100644 ext/spice/src/cspice/dasopr_c.c create mode 100644 ext/spice/src/cspice/dasrcr.c create mode 100644 ext/spice/src/cspice/dasrdc.c create mode 100644 ext/spice/src/cspice/dasrdd.c create mode 100644 ext/spice/src/cspice/dasrdi.c create mode 100644 ext/spice/src/cspice/dasrfr.c create mode 100644 ext/spice/src/cspice/dasrwr.c create mode 100644 ext/spice/src/cspice/dassdr.c create mode 100644 ext/spice/src/cspice/dastb.c create mode 100644 ext/spice/src/cspice/dasudc.c create mode 100644 ext/spice/src/cspice/dasudd.c create mode 100644 ext/spice/src/cspice/dasudi.c create mode 100644 ext/spice/src/cspice/daswfr.c create mode 100644 ext/spice/src/cspice/datanh.c create mode 100644 ext/spice/src/cspice/dcbrt.c create mode 100644 ext/spice/src/cspice/dcyldr.c create mode 100644 ext/spice/src/cspice/dcyldr_c.c create mode 100644 ext/spice/src/cspice/delfil.c create mode 100644 ext/spice/src/cspice/deltet.c create mode 100644 ext/spice/src/cspice/deltet_c.c create mode 100644 ext/spice/src/cspice/derf_.c create mode 100644 ext/spice/src/cspice/derfc_.c create mode 100644 ext/spice/src/cspice/det.c create mode 100644 ext/spice/src/cspice/det_c.c create mode 100644 ext/spice/src/cspice/dfe.c create mode 100644 ext/spice/src/cspice/dgeodr.c create mode 100644 ext/spice/src/cspice/dgeodr_c.c create mode 100644 ext/spice/src/cspice/dhfa.c create mode 100644 ext/spice/src/cspice/diags2.c create mode 100644 ext/spice/src/cspice/diags2_c.c create mode 100644 ext/spice/src/cspice/diff_c.c create mode 100644 ext/spice/src/cspice/diffc.c create mode 100644 ext/spice/src/cspice/diffd.c create mode 100644 ext/spice/src/cspice/diffi.c create mode 100644 ext/spice/src/cspice/dlatdr.c create mode 100644 ext/spice/src/cspice/dlatdr_c.c create mode 100644 ext/spice/src/cspice/dnearp.c create mode 100644 ext/spice/src/cspice/dolio.c create mode 100644 ext/spice/src/cspice/dp2hx.c create mode 100644 ext/spice/src/cspice/dp2hx_c.c create mode 100644 ext/spice/src/cspice/dpfmt.c create mode 100644 ext/spice/src/cspice/dpgrdr.c create mode 100644 ext/spice/src/cspice/dpgrdr_c.c create mode 100644 ext/spice/src/cspice/dpmax.c create mode 100644 ext/spice/src/cspice/dpmax_c.c create mode 100644 ext/spice/src/cspice/dpmin.c create mode 100644 ext/spice/src/cspice/dpmin_c.c create mode 100644 ext/spice/src/cspice/dpr.c create mode 100644 ext/spice/src/cspice/dpr_c.c create mode 100644 ext/spice/src/cspice/dpspce.c create mode 100644 ext/spice/src/cspice/dpstr.c create mode 100644 ext/spice/src/cspice/dpstrf.c create mode 100644 ext/spice/src/cspice/drdcyl.c create mode 100644 ext/spice/src/cspice/drdcyl_c.c create mode 100644 ext/spice/src/cspice/drdgeo.c create mode 100644 ext/spice/src/cspice/drdgeo_c.c create mode 100644 ext/spice/src/cspice/drdlat.c create mode 100644 ext/spice/src/cspice/drdlat_c.c create mode 100644 ext/spice/src/cspice/drdpgr.c create mode 100644 ext/spice/src/cspice/drdpgr_c.c create mode 100644 ext/spice/src/cspice/drdsph.c create mode 100644 ext/spice/src/cspice/drdsph_c.c create mode 100644 ext/spice/src/cspice/drotat.c create mode 100644 ext/spice/src/cspice/dsphdr.c create mode 100644 ext/spice/src/cspice/dsphdr_c.c create mode 100644 ext/spice/src/cspice/dtime_.c create mode 100644 ext/spice/src/cspice/dtpool_c.c create mode 100644 ext/spice/src/cspice/ducrss.c create mode 100644 ext/spice/src/cspice/ducrss_c.c create mode 100644 ext/spice/src/cspice/due.c create mode 100644 ext/spice/src/cspice/dvcrss.c create mode 100644 ext/spice/src/cspice/dvcrss_c.c create mode 100644 ext/spice/src/cspice/dvdot.c create mode 100644 ext/spice/src/cspice/dvdot_c.c create mode 100644 ext/spice/src/cspice/dvhat.c create mode 100644 ext/spice/src/cspice/dvhat_c.c create mode 100644 ext/spice/src/cspice/dvnorm.c create mode 100644 ext/spice/src/cspice/dvnorm_c.c create mode 100644 ext/spice/src/cspice/dvpool_c.c create mode 100644 ext/spice/src/cspice/dvsep.c create mode 100644 ext/spice/src/cspice/dvsep_c.c create mode 100644 ext/spice/src/cspice/dxtrct.c create mode 100644 ext/spice/src/cspice/edlimb.c create mode 100644 ext/spice/src/cspice/edlimb_c.c create mode 100644 ext/spice/src/cspice/edterm.c create mode 100644 ext/spice/src/cspice/ef1asc_.c create mode 100644 ext/spice/src/cspice/ef1cmc_.c create mode 100644 ext/spice/src/cspice/ekacec.c create mode 100644 ext/spice/src/cspice/ekacec_c.c create mode 100644 ext/spice/src/cspice/ekaced.c create mode 100644 ext/spice/src/cspice/ekaced_c.c create mode 100644 ext/spice/src/cspice/ekacei.c create mode 100644 ext/spice/src/cspice/ekacei_c.c create mode 100644 ext/spice/src/cspice/ekaclc.c create mode 100644 ext/spice/src/cspice/ekaclc_c.c create mode 100644 ext/spice/src/cspice/ekacld.c create mode 100644 ext/spice/src/cspice/ekacld_c.c create mode 100644 ext/spice/src/cspice/ekacli.c create mode 100644 ext/spice/src/cspice/ekacli_c.c create mode 100644 ext/spice/src/cspice/ekappr.c create mode 100644 ext/spice/src/cspice/ekappr_c.c create mode 100644 ext/spice/src/cspice/ekbseg.c create mode 100644 ext/spice/src/cspice/ekbseg_c.c create mode 100644 ext/spice/src/cspice/ekccnt_c.c create mode 100644 ext/spice/src/cspice/ekcii_c.c create mode 100644 ext/spice/src/cspice/ekcls.c create mode 100644 ext/spice/src/cspice/ekcls_c.c create mode 100644 ext/spice/src/cspice/ekdelr.c create mode 100644 ext/spice/src/cspice/ekdelr_c.c create mode 100644 ext/spice/src/cspice/ekffld.c create mode 100644 ext/spice/src/cspice/ekffld_c.c create mode 100644 ext/spice/src/cspice/ekfind.c create mode 100644 ext/spice/src/cspice/ekfind_c.c create mode 100644 ext/spice/src/cspice/ekgc_c.c create mode 100644 ext/spice/src/cspice/ekgd_c.c create mode 100644 ext/spice/src/cspice/ekgi_c.c create mode 100644 ext/spice/src/cspice/ekifld.c create mode 100644 ext/spice/src/cspice/ekifld_c.c create mode 100644 ext/spice/src/cspice/ekinsr.c create mode 100644 ext/spice/src/cspice/ekinsr_c.c create mode 100644 ext/spice/src/cspice/eklef_c.c create mode 100644 ext/spice/src/cspice/eknelt_c.c create mode 100644 ext/spice/src/cspice/eknseg.c create mode 100644 ext/spice/src/cspice/eknseg_c.c create mode 100644 ext/spice/src/cspice/ekntab_c.c create mode 100644 ext/spice/src/cspice/ekopn.c create mode 100644 ext/spice/src/cspice/ekopn_c.c create mode 100644 ext/spice/src/cspice/ekopr.c create mode 100644 ext/spice/src/cspice/ekopr_c.c create mode 100644 ext/spice/src/cspice/ekops.c create mode 100644 ext/spice/src/cspice/ekops_c.c create mode 100644 ext/spice/src/cspice/ekopw.c create mode 100644 ext/spice/src/cspice/ekopw_c.c create mode 100644 ext/spice/src/cspice/ekpsel.c create mode 100644 ext/spice/src/cspice/ekpsel_c.c create mode 100644 ext/spice/src/cspice/ekqmgr.c create mode 100644 ext/spice/src/cspice/ekrcec.c create mode 100644 ext/spice/src/cspice/ekrcec_c.c create mode 100644 ext/spice/src/cspice/ekrced.c create mode 100644 ext/spice/src/cspice/ekrced_c.c create mode 100644 ext/spice/src/cspice/ekrcei.c create mode 100644 ext/spice/src/cspice/ekrcei_c.c create mode 100644 ext/spice/src/cspice/ekshdw.c create mode 100644 ext/spice/src/cspice/ekssum.c create mode 100644 ext/spice/src/cspice/ekssum_c.c create mode 100644 ext/spice/src/cspice/ektnam_c.c create mode 100644 ext/spice/src/cspice/ekucec.c create mode 100644 ext/spice/src/cspice/ekucec_c.c create mode 100644 ext/spice/src/cspice/ekuced.c create mode 100644 ext/spice/src/cspice/ekuced_c.c create mode 100644 ext/spice/src/cspice/ekucei.c create mode 100644 ext/spice/src/cspice/ekucei_c.c create mode 100644 ext/spice/src/cspice/ekuef_c.c create mode 100644 ext/spice/src/cspice/el2cgv.c create mode 100644 ext/spice/src/cspice/el2cgv_c.c create mode 100644 ext/spice/src/cspice/elemc.c create mode 100644 ext/spice/src/cspice/elemc_c.c create mode 100644 ext/spice/src/cspice/elemd.c create mode 100644 ext/spice/src/cspice/elemd_c.c create mode 100644 ext/spice/src/cspice/elemi.c create mode 100644 ext/spice/src/cspice/elemi_c.c create mode 100644 ext/spice/src/cspice/elltof.c create mode 100644 ext/spice/src/cspice/enchar.c create mode 100644 ext/spice/src/cspice/endfile.c create mode 100644 ext/spice/src/cspice/eqchr.c create mode 100644 ext/spice/src/cspice/eqncpv.c create mode 100644 ext/spice/src/cspice/eqstr.c create mode 100644 ext/spice/src/cspice/eqstr_c.c create mode 100644 ext/spice/src/cspice/erf_.c create mode 100644 ext/spice/src/cspice/erfc_.c create mode 100644 ext/spice/src/cspice/err.c create mode 100644 ext/spice/src/cspice/erract.c create mode 100644 ext/spice/src/cspice/erract_c.c create mode 100644 ext/spice/src/cspice/errch.c create mode 100644 ext/spice/src/cspice/errch_c.c create mode 100644 ext/spice/src/cspice/errdev.c create mode 100644 ext/spice/src/cspice/errdev_c.c create mode 100644 ext/spice/src/cspice/errdp.c create mode 100644 ext/spice/src/cspice/errdp_c.c create mode 100644 ext/spice/src/cspice/errfnm.c create mode 100644 ext/spice/src/cspice/errhan.c create mode 100644 ext/spice/src/cspice/errint.c create mode 100644 ext/spice/src/cspice/errint_c.c create mode 100644 ext/spice/src/cspice/errprt.c create mode 100644 ext/spice/src/cspice/errprt_c.c create mode 100644 ext/spice/src/cspice/esrchc.c create mode 100644 ext/spice/src/cspice/esrchc_c.c create mode 100644 ext/spice/src/cspice/et2lst.c create mode 100644 ext/spice/src/cspice/et2lst_c.c create mode 100644 ext/spice/src/cspice/et2utc.c create mode 100644 ext/spice/src/cspice/et2utc_c.c create mode 100644 ext/spice/src/cspice/etcal.c create mode 100644 ext/spice/src/cspice/etcal_c.c create mode 100644 ext/spice/src/cspice/etime_.c create mode 100644 ext/spice/src/cspice/eul2m.c create mode 100644 ext/spice/src/cspice/eul2m_c.c create mode 100644 ext/spice/src/cspice/eul2xf_c.c create mode 100644 ext/spice/src/cspice/ev2lin.c create mode 100644 ext/spice/src/cspice/even.c create mode 100644 ext/spice/src/cspice/exact.c create mode 100644 ext/spice/src/cspice/excess.c create mode 100644 ext/spice/src/cspice/exists.c create mode 100644 ext/spice/src/cspice/exists_c.c create mode 100644 ext/spice/src/cspice/exit_.c create mode 100644 ext/spice/src/cspice/expln.c create mode 100644 ext/spice/src/cspice/expool_c.c create mode 100644 ext/spice/src/cspice/f2c.h create mode 100644 ext/spice/src/cspice/f2cMang.h create mode 100644 ext/spice/src/cspice/failed_c.c create mode 100644 ext/spice/src/cspice/fetchc.c create mode 100644 ext/spice/src/cspice/fetchd.c create mode 100644 ext/spice/src/cspice/fetchi.c create mode 100644 ext/spice/src/cspice/fillc.c create mode 100644 ext/spice/src/cspice/filld.c create mode 100644 ext/spice/src/cspice/filli.c create mode 100644 ext/spice/src/cspice/fio.h create mode 100644 ext/spice/src/cspice/fmt.c create mode 100644 ext/spice/src/cspice/fmt.h create mode 100644 ext/spice/src/cspice/fmtlib.c create mode 100644 ext/spice/src/cspice/fn2lun.c create mode 100644 ext/spice/src/cspice/fndlun.c create mode 100644 ext/spice/src/cspice/fndnwd.c create mode 100644 ext/spice/src/cspice/fp.h create mode 100644 ext/spice/src/cspice/frame.c create mode 100644 ext/spice/src/cspice/frame_c.c create mode 100644 ext/spice/src/cspice/framex.c create mode 100644 ext/spice/src/cspice/frinfo_c.c create mode 100644 ext/spice/src/cspice/frmchg.c create mode 100644 ext/spice/src/cspice/frmget.c create mode 100644 ext/spice/src/cspice/frmnam_c.c create mode 100644 ext/spice/src/cspice/frstnb.c create mode 100644 ext/spice/src/cspice/frstnp.c create mode 100644 ext/spice/src/cspice/frstpc.c create mode 100644 ext/spice/src/cspice/ftell_.c create mode 100644 ext/spice/src/cspice/ftncls_c.c create mode 100644 ext/spice/src/cspice/furnsh_c.c create mode 100644 ext/spice/src/cspice/gcd.c create mode 100644 ext/spice/src/cspice/gcpool_c.c create mode 100644 ext/spice/src/cspice/gdpool_c.c create mode 100644 ext/spice/src/cspice/georec.c create mode 100644 ext/spice/src/cspice/georec_c.c create mode 100644 ext/spice/src/cspice/getcml_c.c create mode 100644 ext/spice/src/cspice/getelm.c create mode 100644 ext/spice/src/cspice/getelm_c.c create mode 100644 ext/spice/src/cspice/getenv_.c create mode 100644 ext/spice/src/cspice/getfat.c create mode 100644 ext/spice/src/cspice/getfat_c.c create mode 100644 ext/spice/src/cspice/getfov.c create mode 100644 ext/spice/src/cspice/getfov_c.c create mode 100644 ext/spice/src/cspice/getlun.c create mode 100644 ext/spice/src/cspice/getmsg.c create mode 100644 ext/spice/src/cspice/getmsg_c.c create mode 100644 ext/spice/src/cspice/gfbail.c create mode 100644 ext/spice/src/cspice/gfbail_c.c create mode 100644 ext/spice/src/cspice/gfclrh_c.c create mode 100644 ext/spice/src/cspice/gfdist.c create mode 100644 ext/spice/src/cspice/gfdist_c.c create mode 100644 ext/spice/src/cspice/gfevnt.c create mode 100644 ext/spice/src/cspice/gfevnt_c.c create mode 100644 ext/spice/src/cspice/gffove.c create mode 100644 ext/spice/src/cspice/gffove_c.c create mode 100644 ext/spice/src/cspice/gfinth_c.c create mode 100644 ext/spice/src/cspice/gfocce.c create mode 100644 ext/spice/src/cspice/gfocce_c.c create mode 100644 ext/spice/src/cspice/gfoclt.c create mode 100644 ext/spice/src/cspice/gfoclt_c.c create mode 100644 ext/spice/src/cspice/gfposc.c create mode 100644 ext/spice/src/cspice/gfposc_c.c create mode 100644 ext/spice/src/cspice/gfrefn.c create mode 100644 ext/spice/src/cspice/gfrefn_c.c create mode 100644 ext/spice/src/cspice/gfrepf_c.c create mode 100644 ext/spice/src/cspice/gfrepi_c.c create mode 100644 ext/spice/src/cspice/gfrepu_c.c create mode 100644 ext/spice/src/cspice/gfrfov.c create mode 100644 ext/spice/src/cspice/gfrfov_c.c create mode 100644 ext/spice/src/cspice/gfrprt.c create mode 100644 ext/spice/src/cspice/gfrr.c create mode 100644 ext/spice/src/cspice/gfrr_c.c create mode 100644 ext/spice/src/cspice/gfsep.c create mode 100644 ext/spice/src/cspice/gfsep_c.c create mode 100644 ext/spice/src/cspice/gfsntc.c create mode 100644 ext/spice/src/cspice/gfsntc_c.c create mode 100644 ext/spice/src/cspice/gfsstp_c.c create mode 100644 ext/spice/src/cspice/gfstep.c create mode 100644 ext/spice/src/cspice/gfstep_c.c create mode 100644 ext/spice/src/cspice/gfsubc.c create mode 100644 ext/spice/src/cspice/gfsubc_c.c create mode 100644 ext/spice/src/cspice/gftfov.c create mode 100644 ext/spice/src/cspice/gftfov_c.c create mode 100644 ext/spice/src/cspice/gfuds.c create mode 100644 ext/spice/src/cspice/gfuds_c.c create mode 100644 ext/spice/src/cspice/gipool_c.c create mode 100644 ext/spice/src/cspice/gnpool_c.c create mode 100644 ext/spice/src/cspice/h_abs.c create mode 100644 ext/spice/src/cspice/h_dim.c create mode 100644 ext/spice/src/cspice/h_dnnt.c create mode 100644 ext/spice/src/cspice/h_indx.c create mode 100644 ext/spice/src/cspice/h_len.c create mode 100644 ext/spice/src/cspice/h_mod.c create mode 100644 ext/spice/src/cspice/h_nint.c create mode 100644 ext/spice/src/cspice/h_sign.c create mode 100644 ext/spice/src/cspice/halfpi.c create mode 100644 ext/spice/src/cspice/halfpi_c.c create mode 100644 ext/spice/src/cspice/hl_ge.c create mode 100644 ext/spice/src/cspice/hl_gt.c create mode 100644 ext/spice/src/cspice/hl_le.c create mode 100644 ext/spice/src/cspice/hl_lt.c create mode 100644 ext/spice/src/cspice/hrmesp.c create mode 100644 ext/spice/src/cspice/hrmint.c create mode 100644 ext/spice/src/cspice/hx2dp.c create mode 100644 ext/spice/src/cspice/hx2dp_c.c create mode 100644 ext/spice/src/cspice/hx2int.c create mode 100644 ext/spice/src/cspice/hyptof.c create mode 100644 ext/spice/src/cspice/i_abs.c create mode 100644 ext/spice/src/cspice/i_dim.c create mode 100644 ext/spice/src/cspice/i_dnnt.c create mode 100644 ext/spice/src/cspice/i_indx.c create mode 100644 ext/spice/src/cspice/i_len.c create mode 100644 ext/spice/src/cspice/i_mod.c create mode 100644 ext/spice/src/cspice/i_nint.c create mode 100644 ext/spice/src/cspice/i_sign.c create mode 100644 ext/spice/src/cspice/ident.c create mode 100644 ext/spice/src/cspice/ident_c.c create mode 100644 ext/spice/src/cspice/idw2at.c create mode 100644 ext/spice/src/cspice/iio.c create mode 100644 ext/spice/src/cspice/illum.c create mode 100644 ext/spice/src/cspice/illum_c.c create mode 100644 ext/spice/src/cspice/ilnw.c create mode 100644 ext/spice/src/cspice/ilumin.c create mode 100644 ext/spice/src/cspice/ilumin_c.c create mode 100644 ext/spice/src/cspice/inedpl.c create mode 100644 ext/spice/src/cspice/inedpl_c.c create mode 100644 ext/spice/src/cspice/inelpl.c create mode 100644 ext/spice/src/cspice/inelpl_c.c create mode 100644 ext/spice/src/cspice/inquire.c create mode 100644 ext/spice/src/cspice/inrypl.c create mode 100644 ext/spice/src/cspice/inrypl_c.c create mode 100644 ext/spice/src/cspice/inslac.c create mode 100644 ext/spice/src/cspice/inslad.c create mode 100644 ext/spice/src/cspice/inslai.c create mode 100644 ext/spice/src/cspice/insrtc.c create mode 100644 ext/spice/src/cspice/insrtc_c.c create mode 100644 ext/spice/src/cspice/insrtd.c create mode 100644 ext/spice/src/cspice/insrtd_c.c create mode 100644 ext/spice/src/cspice/insrti.c create mode 100644 ext/spice/src/cspice/insrti_c.c create mode 100644 ext/spice/src/cspice/inssub.c create mode 100644 ext/spice/src/cspice/int2hx.c create mode 100644 ext/spice/src/cspice/inter_c.c create mode 100644 ext/spice/src/cspice/interc.c create mode 100644 ext/spice/src/cspice/interd.c create mode 100644 ext/spice/src/cspice/interi.c create mode 100644 ext/spice/src/cspice/intmax.c create mode 100644 ext/spice/src/cspice/intmax_c.c create mode 100644 ext/spice/src/cspice/intmin.c create mode 100644 ext/spice/src/cspice/intmin_c.c create mode 100644 ext/spice/src/cspice/intord.c create mode 100644 ext/spice/src/cspice/intstr.c create mode 100644 ext/spice/src/cspice/inttxt.c create mode 100644 ext/spice/src/cspice/invert.c create mode 100644 ext/spice/src/cspice/invert_c.c create mode 100644 ext/spice/src/cspice/invort.c create mode 100644 ext/spice/src/cspice/invort_c.c create mode 100644 ext/spice/src/cspice/invstm.c create mode 100644 ext/spice/src/cspice/ioerr.c create mode 100644 ext/spice/src/cspice/irftrn.c create mode 100644 ext/spice/src/cspice/iso2utc.c create mode 100644 ext/spice/src/cspice/isopen.c create mode 100644 ext/spice/src/cspice/isordv.c create mode 100644 ext/spice/src/cspice/isordv_c.c create mode 100644 ext/spice/src/cspice/isrchc.c create mode 100644 ext/spice/src/cspice/isrchc_c.c create mode 100644 ext/spice/src/cspice/isrchd.c create mode 100644 ext/spice/src/cspice/isrchd_c.c create mode 100644 ext/spice/src/cspice/isrchi.c create mode 100644 ext/spice/src/cspice/isrchi_c.c create mode 100644 ext/spice/src/cspice/isrot.c create mode 100644 ext/spice/src/cspice/isrot_c.c create mode 100644 ext/spice/src/cspice/iswhsp_c.c create mode 100644 ext/spice/src/cspice/j1900.c create mode 100644 ext/spice/src/cspice/j1900_c.c create mode 100644 ext/spice/src/cspice/j1950.c create mode 100644 ext/spice/src/cspice/j1950_c.c create mode 100644 ext/spice/src/cspice/j2000.c create mode 100644 ext/spice/src/cspice/j2000_c.c create mode 100644 ext/spice/src/cspice/j2100.c create mode 100644 ext/spice/src/cspice/j2100_c.c create mode 100644 ext/spice/src/cspice/jul2gr.c create mode 100644 ext/spice/src/cspice/jyear.c create mode 100644 ext/spice/src/cspice/jyear_c.c create mode 100644 ext/spice/src/cspice/kclear_c.c create mode 100644 ext/spice/src/cspice/kdata_c.c create mode 100644 ext/spice/src/cspice/keeper.c create mode 100644 ext/spice/src/cspice/kepleq.c create mode 100644 ext/spice/src/cspice/kinfo_c.c create mode 100644 ext/spice/src/cspice/kpsolv.c create mode 100644 ext/spice/src/cspice/ktotal_c.c create mode 100644 ext/spice/src/cspice/kxtrct.c create mode 100644 ext/spice/src/cspice/kxtrct_c.c create mode 100644 ext/spice/src/cspice/l_ge.c create mode 100644 ext/spice/src/cspice/l_gt.c create mode 100644 ext/spice/src/cspice/l_le.c create mode 100644 ext/spice/src/cspice/l_lt.c create mode 100644 ext/spice/src/cspice/lastnb.c create mode 100644 ext/spice/src/cspice/lastnb_c.c create mode 100644 ext/spice/src/cspice/lastpc.c create mode 100644 ext/spice/src/cspice/latcyl.c create mode 100644 ext/spice/src/cspice/latcyl_c.c create mode 100644 ext/spice/src/cspice/latrec.c create mode 100644 ext/spice/src/cspice/latrec_c.c create mode 100644 ext/spice/src/cspice/latsph.c create mode 100644 ext/spice/src/cspice/latsph_c.c create mode 100644 ext/spice/src/cspice/lbitbits.c create mode 100644 ext/spice/src/cspice/lbitshft.c create mode 100644 ext/spice/src/cspice/lbuild.c create mode 100644 ext/spice/src/cspice/lcase.c create mode 100644 ext/spice/src/cspice/lcase_c.c create mode 100644 ext/spice/src/cspice/ldpool_c.c create mode 100644 ext/spice/src/cspice/lgresp.c create mode 100644 ext/spice/src/cspice/lgrind.c create mode 100644 ext/spice/src/cspice/lgrint.c create mode 100644 ext/spice/src/cspice/lio.h create mode 100644 ext/spice/src/cspice/ljust.c create mode 100644 ext/spice/src/cspice/lmpool_c.c create mode 100644 ext/spice/src/cspice/lnkan.c create mode 100644 ext/spice/src/cspice/lnkfsl.c create mode 100644 ext/spice/src/cspice/lnkhl.c create mode 100644 ext/spice/src/cspice/lnkila.c create mode 100644 ext/spice/src/cspice/lnkilb.c create mode 100644 ext/spice/src/cspice/lnkini.c create mode 100644 ext/spice/src/cspice/lnknfn.c create mode 100644 ext/spice/src/cspice/lnknxt.c create mode 100644 ext/spice/src/cspice/lnkprv.c create mode 100644 ext/spice/src/cspice/lnksiz.c create mode 100644 ext/spice/src/cspice/lnktl.c create mode 100644 ext/spice/src/cspice/lnkxsl.c create mode 100644 ext/spice/src/cspice/locati.c create mode 100644 ext/spice/src/cspice/locln.c create mode 100644 ext/spice/src/cspice/lparse.c create mode 100644 ext/spice/src/cspice/lparse_c.c create mode 100644 ext/spice/src/cspice/lparsm.c create mode 100644 ext/spice/src/cspice/lparsm_c.c create mode 100644 ext/spice/src/cspice/lparss.c create mode 100644 ext/spice/src/cspice/lparss_c.c create mode 100644 ext/spice/src/cspice/lread.c create mode 100644 ext/spice/src/cspice/lspcn.c create mode 100644 ext/spice/src/cspice/lspcn_c.c create mode 100644 ext/spice/src/cspice/lstcld.c create mode 100644 ext/spice/src/cspice/lstcli.c create mode 100644 ext/spice/src/cspice/lstlec.c create mode 100644 ext/spice/src/cspice/lstlec_c.c create mode 100644 ext/spice/src/cspice/lstled.c create mode 100644 ext/spice/src/cspice/lstled_c.c create mode 100644 ext/spice/src/cspice/lstlei.c create mode 100644 ext/spice/src/cspice/lstlei_c.c create mode 100644 ext/spice/src/cspice/lstltc.c create mode 100644 ext/spice/src/cspice/lstltc_c.c create mode 100644 ext/spice/src/cspice/lstltd.c create mode 100644 ext/spice/src/cspice/lstltd_c.c create mode 100644 ext/spice/src/cspice/lstlti.c create mode 100644 ext/spice/src/cspice/lstlti_c.c create mode 100644 ext/spice/src/cspice/ltime.c create mode 100644 ext/spice/src/cspice/ltime_c.c create mode 100644 ext/spice/src/cspice/ltrim.c create mode 100644 ext/spice/src/cspice/lun2fn.c create mode 100644 ext/spice/src/cspice/lwrite.c create mode 100644 ext/spice/src/cspice/lx4dec.c create mode 100644 ext/spice/src/cspice/lx4dec_c.c create mode 100644 ext/spice/src/cspice/lx4num.c create mode 100644 ext/spice/src/cspice/lx4num_c.c create mode 100644 ext/spice/src/cspice/lx4sgn.c create mode 100644 ext/spice/src/cspice/lx4sgn_c.c create mode 100644 ext/spice/src/cspice/lx4uns.c create mode 100644 ext/spice/src/cspice/lx4uns_c.c create mode 100644 ext/spice/src/cspice/lxname.c create mode 100644 ext/spice/src/cspice/lxqstr.c create mode 100644 ext/spice/src/cspice/lxqstr_c.c create mode 100644 ext/spice/src/cspice/m2eul.c create mode 100644 ext/spice/src/cspice/m2eul_c.c create mode 100644 ext/spice/src/cspice/m2q.c create mode 100644 ext/spice/src/cspice/m2q_c.c create mode 100644 ext/spice/src/cspice/matchi.c create mode 100644 ext/spice/src/cspice/matchi_c.c create mode 100644 ext/spice/src/cspice/matchw.c create mode 100644 ext/spice/src/cspice/matchw_c.c create mode 100644 ext/spice/src/cspice/maxac.c create mode 100644 ext/spice/src/cspice/maxad.c create mode 100644 ext/spice/src/cspice/maxai.c create mode 100644 ext/spice/src/cspice/maxd_c.c create mode 100644 ext/spice/src/cspice/maxi_c.c create mode 100644 ext/spice/src/cspice/mequ.c create mode 100644 ext/spice/src/cspice/mequ_c.c create mode 100644 ext/spice/src/cspice/mequg.c create mode 100644 ext/spice/src/cspice/mequg_c.c create mode 100644 ext/spice/src/cspice/minac.c create mode 100644 ext/spice/src/cspice/minad.c create mode 100644 ext/spice/src/cspice/minai.c create mode 100644 ext/spice/src/cspice/mind_c.c create mode 100644 ext/spice/src/cspice/mini_c.c create mode 100644 ext/spice/src/cspice/mkprodct.csh create mode 100644 ext/spice/src/cspice/movec.c create mode 100644 ext/spice/src/cspice/moved.c create mode 100644 ext/spice/src/cspice/movei.c create mode 100644 ext/spice/src/cspice/mtxm.c create mode 100644 ext/spice/src/cspice/mtxm_c.c create mode 100644 ext/spice/src/cspice/mtxmg.c create mode 100644 ext/spice/src/cspice/mtxmg_c.c create mode 100644 ext/spice/src/cspice/mtxv.c create mode 100644 ext/spice/src/cspice/mtxv_c.c create mode 100644 ext/spice/src/cspice/mtxvg.c create mode 100644 ext/spice/src/cspice/mtxvg_c.c create mode 100644 ext/spice/src/cspice/mxm.c create mode 100644 ext/spice/src/cspice/mxm_c.c create mode 100644 ext/spice/src/cspice/mxmg.c create mode 100644 ext/spice/src/cspice/mxmg_c.c create mode 100644 ext/spice/src/cspice/mxmt.c create mode 100644 ext/spice/src/cspice/mxmt_c.c create mode 100644 ext/spice/src/cspice/mxmtg.c create mode 100644 ext/spice/src/cspice/mxmtg_c.c create mode 100644 ext/spice/src/cspice/mxv.c create mode 100644 ext/spice/src/cspice/mxv_c.c create mode 100644 ext/spice/src/cspice/mxvg.c create mode 100644 ext/spice/src/cspice/mxvg_c.c create mode 100644 ext/spice/src/cspice/namfrm_c.c create mode 100644 ext/spice/src/cspice/nblen.c create mode 100644 ext/spice/src/cspice/nbwid.c create mode 100644 ext/spice/src/cspice/ncpos.c create mode 100644 ext/spice/src/cspice/ncpos_c.c create mode 100644 ext/spice/src/cspice/ncposr.c create mode 100644 ext/spice/src/cspice/ncposr_c.c create mode 100644 ext/spice/src/cspice/nearpt.c create mode 100644 ext/spice/src/cspice/nearpt_c.c create mode 100644 ext/spice/src/cspice/nextwd.c create mode 100644 ext/spice/src/cspice/notru.c create mode 100644 ext/spice/src/cspice/nparsd.c create mode 100644 ext/spice/src/cspice/nparsi.c create mode 100644 ext/spice/src/cspice/npedln.c create mode 100644 ext/spice/src/cspice/npedln_c.c create mode 100644 ext/spice/src/cspice/npelpt.c create mode 100644 ext/spice/src/cspice/npelpt_c.c create mode 100644 ext/spice/src/cspice/nplnpt.c create mode 100644 ext/spice/src/cspice/nplnpt_c.c create mode 100644 ext/spice/src/cspice/nthwd.c create mode 100644 ext/spice/src/cspice/nvc2pl.c create mode 100644 ext/spice/src/cspice/nvc2pl_c.c create mode 100644 ext/spice/src/cspice/nvp2pl.c create mode 100644 ext/spice/src/cspice/nvp2pl_c.c create mode 100644 ext/spice/src/cspice/odd.c create mode 100644 ext/spice/src/cspice/open.c create mode 100644 ext/spice/src/cspice/opsgnd.c create mode 100644 ext/spice/src/cspice/opsgni.c create mode 100644 ext/spice/src/cspice/ordc.c create mode 100644 ext/spice/src/cspice/ordc_c.c create mode 100644 ext/spice/src/cspice/ordd.c create mode 100644 ext/spice/src/cspice/ordd_c.c create mode 100644 ext/spice/src/cspice/orderc.c create mode 100644 ext/spice/src/cspice/orderc_c.c create mode 100644 ext/spice/src/cspice/orderd.c create mode 100644 ext/spice/src/cspice/orderd_c.c create mode 100644 ext/spice/src/cspice/orderi.c create mode 100644 ext/spice/src/cspice/orderi_c.c create mode 100644 ext/spice/src/cspice/ordi.c create mode 100644 ext/spice/src/cspice/ordi_c.c create mode 100644 ext/spice/src/cspice/oscelt.c create mode 100644 ext/spice/src/cspice/oscelt_c.c create mode 100644 ext/spice/src/cspice/outmsg.c create mode 100644 ext/spice/src/cspice/packac.c create mode 100644 ext/spice/src/cspice/packad.c create mode 100644 ext/spice/src/cspice/packai.c create mode 100644 ext/spice/src/cspice/parsqs.c create mode 100644 ext/spice/src/cspice/partof.c create mode 100644 ext/spice/src/cspice/pck03a.c create mode 100644 ext/spice/src/cspice/pck03b.c create mode 100644 ext/spice/src/cspice/pck03e.c create mode 100644 ext/spice/src/cspice/pckbsr.c create mode 100644 ext/spice/src/cspice/pckcls.c create mode 100644 ext/spice/src/cspice/pckcov.c create mode 100644 ext/spice/src/cspice/pckcov_c.c create mode 100644 ext/spice/src/cspice/pcke02.c create mode 100644 ext/spice/src/cspice/pcke03.c create mode 100644 ext/spice/src/cspice/pckeul.c create mode 100644 ext/spice/src/cspice/pckfrm.c create mode 100644 ext/spice/src/cspice/pckfrm_c.c create mode 100644 ext/spice/src/cspice/pcklof_c.c create mode 100644 ext/spice/src/cspice/pckmat.c create mode 100644 ext/spice/src/cspice/pckopn.c create mode 100644 ext/spice/src/cspice/pckpds.c create mode 100644 ext/spice/src/cspice/pckr02.c create mode 100644 ext/spice/src/cspice/pckr03.c create mode 100644 ext/spice/src/cspice/pckuds.c create mode 100644 ext/spice/src/cspice/pckuof_c.c create mode 100644 ext/spice/src/cspice/pckw02.c create mode 100644 ext/spice/src/cspice/pcpool_c.c create mode 100644 ext/spice/src/cspice/pcwid.c create mode 100644 ext/spice/src/cspice/pdpool_c.c create mode 100644 ext/spice/src/cspice/pgrrec.c create mode 100644 ext/spice/src/cspice/pgrrec_c.c create mode 100644 ext/spice/src/cspice/pi.c create mode 100644 ext/spice/src/cspice/pi_c.c create mode 100644 ext/spice/src/cspice/pipool_c.c create mode 100644 ext/spice/src/cspice/pjelpl.c create mode 100644 ext/spice/src/cspice/pjelpl_c.c create mode 100644 ext/spice/src/cspice/pl2nvc.c create mode 100644 ext/spice/src/cspice/pl2nvc_c.c create mode 100644 ext/spice/src/cspice/pl2nvp.c create mode 100644 ext/spice/src/cspice/pl2nvp_c.c create mode 100644 ext/spice/src/cspice/pl2psv.c create mode 100644 ext/spice/src/cspice/pl2psv_c.c create mode 100644 ext/spice/src/cspice/plnsns.c create mode 100644 ext/spice/src/cspice/polyds.c create mode 100644 ext/spice/src/cspice/pool.c create mode 100644 ext/spice/src/cspice/pos.c create mode 100644 ext/spice/src/cspice/pos_c.c create mode 100644 ext/spice/src/cspice/posr.c create mode 100644 ext/spice/src/cspice/posr_c.c create mode 100644 ext/spice/src/cspice/pow_ci.c create mode 100644 ext/spice/src/cspice/pow_dd.c create mode 100644 ext/spice/src/cspice/pow_di.c create mode 100644 ext/spice/src/cspice/pow_hh.c create mode 100644 ext/spice/src/cspice/pow_ii.c create mode 100644 ext/spice/src/cspice/pow_ri.c create mode 100644 ext/spice/src/cspice/pow_zi.c create mode 100644 ext/spice/src/cspice/pow_zz.c create mode 100644 ext/spice/src/cspice/prefix.c create mode 100644 ext/spice/src/cspice/prodad.c create mode 100644 ext/spice/src/cspice/prodai.c create mode 100644 ext/spice/src/cspice/prompt.c create mode 100644 ext/spice/src/cspice/prompt_c.c create mode 100644 ext/spice/src/cspice/prop2b.c create mode 100644 ext/spice/src/cspice/prop2b_c.c create mode 100644 ext/spice/src/cspice/prsdp.c create mode 100644 ext/spice/src/cspice/prsdp_c.c create mode 100644 ext/spice/src/cspice/prsint.c create mode 100644 ext/spice/src/cspice/prsint_c.c create mode 100644 ext/spice/src/cspice/prtenc.c create mode 100644 ext/spice/src/cspice/prtpkg.c create mode 100644 ext/spice/src/cspice/psv2pl.c create mode 100644 ext/spice/src/cspice/psv2pl_c.c create mode 100644 ext/spice/src/cspice/putact.c create mode 100644 ext/spice/src/cspice/putcml_c.c create mode 100644 ext/spice/src/cspice/putdev.c create mode 100644 ext/spice/src/cspice/putlms.c create mode 100644 ext/spice/src/cspice/putsms.c create mode 100644 ext/spice/src/cspice/pxform.c create mode 100644 ext/spice/src/cspice/pxform_c.c create mode 100644 ext/spice/src/cspice/q2m.c create mode 100644 ext/spice/src/cspice/q2m_c.c create mode 100644 ext/spice/src/cspice/qderiv.c create mode 100644 ext/spice/src/cspice/qdq2av.c create mode 100644 ext/spice/src/cspice/qdq2av_c.c create mode 100644 ext/spice/src/cspice/quote.c create mode 100644 ext/spice/src/cspice/qxq.c create mode 100644 ext/spice/src/cspice/qxq_c.c create mode 100644 ext/spice/src/cspice/r_abs.c create mode 100644 ext/spice/src/cspice/r_acos.c create mode 100644 ext/spice/src/cspice/r_asin.c create mode 100644 ext/spice/src/cspice/r_atan.c create mode 100644 ext/spice/src/cspice/r_atn2.c create mode 100644 ext/spice/src/cspice/r_cnjg.c create mode 100644 ext/spice/src/cspice/r_cos.c create mode 100644 ext/spice/src/cspice/r_cosh.c create mode 100644 ext/spice/src/cspice/r_dim.c create mode 100644 ext/spice/src/cspice/r_exp.c create mode 100644 ext/spice/src/cspice/r_imag.c create mode 100644 ext/spice/src/cspice/r_int.c create mode 100644 ext/spice/src/cspice/r_lg10.c create mode 100644 ext/spice/src/cspice/r_log.c create mode 100644 ext/spice/src/cspice/r_mod.c create mode 100644 ext/spice/src/cspice/r_nint.c create mode 100644 ext/spice/src/cspice/r_sign.c create mode 100644 ext/spice/src/cspice/r_sin.c create mode 100644 ext/spice/src/cspice/r_sinh.c create mode 100644 ext/spice/src/cspice/r_sqrt.c create mode 100644 ext/spice/src/cspice/r_tan.c create mode 100644 ext/spice/src/cspice/r_tanh.c create mode 100644 ext/spice/src/cspice/radrec.c create mode 100644 ext/spice/src/cspice/radrec_c.c create mode 100644 ext/spice/src/cspice/rav2xf.c create mode 100644 ext/spice/src/cspice/rav2xf_c.c create mode 100644 ext/spice/src/cspice/rawio.h create mode 100644 ext/spice/src/cspice/raxisa.c create mode 100644 ext/spice/src/cspice/raxisa_c.c create mode 100644 ext/spice/src/cspice/rdencc.c create mode 100644 ext/spice/src/cspice/rdencd.c create mode 100644 ext/spice/src/cspice/rdenci.c create mode 100644 ext/spice/src/cspice/rdfmt.c create mode 100644 ext/spice/src/cspice/rdker.c create mode 100644 ext/spice/src/cspice/rdkvar.c create mode 100644 ext/spice/src/cspice/rdnbl.c create mode 100644 ext/spice/src/cspice/rdtext.c create mode 100644 ext/spice/src/cspice/rdtext_c.c create mode 100644 ext/spice/src/cspice/readla.c create mode 100644 ext/spice/src/cspice/readln.c create mode 100644 ext/spice/src/cspice/reccyl.c create mode 100644 ext/spice/src/cspice/reccyl_c.c create mode 100644 ext/spice/src/cspice/recgeo.c create mode 100644 ext/spice/src/cspice/recgeo_c.c create mode 100644 ext/spice/src/cspice/reclat.c create mode 100644 ext/spice/src/cspice/reclat_c.c create mode 100644 ext/spice/src/cspice/recpgr.c create mode 100644 ext/spice/src/cspice/recpgr_c.c create mode 100644 ext/spice/src/cspice/recrad.c create mode 100644 ext/spice/src/cspice/recrad_c.c create mode 100644 ext/spice/src/cspice/recsph.c create mode 100644 ext/spice/src/cspice/recsph_c.c create mode 100644 ext/spice/src/cspice/refchg.c create mode 100644 ext/spice/src/cspice/remlac.c create mode 100644 ext/spice/src/cspice/remlad.c create mode 100644 ext/spice/src/cspice/remlai.c create mode 100644 ext/spice/src/cspice/removc.c create mode 100644 ext/spice/src/cspice/removc_c.c create mode 100644 ext/spice/src/cspice/removd.c create mode 100644 ext/spice/src/cspice/removd_c.c create mode 100644 ext/spice/src/cspice/removi.c create mode 100644 ext/spice/src/cspice/removi_c.c create mode 100644 ext/spice/src/cspice/remsub.c create mode 100644 ext/spice/src/cspice/reordc.c create mode 100644 ext/spice/src/cspice/reordc_c.c create mode 100644 ext/spice/src/cspice/reordd.c create mode 100644 ext/spice/src/cspice/reordd_c.c create mode 100644 ext/spice/src/cspice/reordi.c create mode 100644 ext/spice/src/cspice/reordi_c.c create mode 100644 ext/spice/src/cspice/reordl.c create mode 100644 ext/spice/src/cspice/reordl_c.c create mode 100644 ext/spice/src/cspice/replch.c create mode 100644 ext/spice/src/cspice/replwd.c create mode 100644 ext/spice/src/cspice/repmc.c create mode 100644 ext/spice/src/cspice/repmc_c.c create mode 100644 ext/spice/src/cspice/repmct.c create mode 100644 ext/spice/src/cspice/repmct_c.c create mode 100644 ext/spice/src/cspice/repmd.c create mode 100644 ext/spice/src/cspice/repmd_c.c create mode 100644 ext/spice/src/cspice/repmf.c create mode 100644 ext/spice/src/cspice/repmf_c.c create mode 100644 ext/spice/src/cspice/repmi.c create mode 100644 ext/spice/src/cspice/repmi_c.c create mode 100644 ext/spice/src/cspice/repmot.c create mode 100644 ext/spice/src/cspice/repmot_c.c create mode 100644 ext/spice/src/cspice/repsub.c create mode 100644 ext/spice/src/cspice/reset.c create mode 100644 ext/spice/src/cspice/reset_c.c create mode 100644 ext/spice/src/cspice/return.c create mode 100644 ext/spice/src/cspice/return_c.c create mode 100644 ext/spice/src/cspice/rewind.c create mode 100644 ext/spice/src/cspice/rjust.c create mode 100644 ext/spice/src/cspice/rmaind.c create mode 100644 ext/spice/src/cspice/rmaini.c create mode 100644 ext/spice/src/cspice/rmdupc.c create mode 100644 ext/spice/src/cspice/rmdupd.c create mode 100644 ext/spice/src/cspice/rmdupi.c create mode 100644 ext/spice/src/cspice/rotate.c create mode 100644 ext/spice/src/cspice/rotate_c.c create mode 100644 ext/spice/src/cspice/rotget.c create mode 100644 ext/spice/src/cspice/rotmat.c create mode 100644 ext/spice/src/cspice/rotmat_c.c create mode 100644 ext/spice/src/cspice/rotvec.c create mode 100644 ext/spice/src/cspice/rotvec_c.c create mode 100644 ext/spice/src/cspice/rpd.c create mode 100644 ext/spice/src/cspice/rpd_c.c create mode 100644 ext/spice/src/cspice/rquad.c create mode 100644 ext/spice/src/cspice/rquad_c.c create mode 100644 ext/spice/src/cspice/rsfe.c create mode 100644 ext/spice/src/cspice/rsli.c create mode 100644 ext/spice/src/cspice/rsne.c create mode 100644 ext/spice/src/cspice/rtrim.c create mode 100644 ext/spice/src/cspice/s_cat.c create mode 100644 ext/spice/src/cspice/s_cmp.c create mode 100644 ext/spice/src/cspice/s_copy.c create mode 100644 ext/spice/src/cspice/s_paus.c create mode 100644 ext/spice/src/cspice/s_rnge.c create mode 100644 ext/spice/src/cspice/s_stop.c create mode 100644 ext/spice/src/cspice/saelgv.c create mode 100644 ext/spice/src/cspice/saelgv_c.c create mode 100644 ext/spice/src/cspice/samch.c create mode 100644 ext/spice/src/cspice/samchi.c create mode 100644 ext/spice/src/cspice/sameai.c create mode 100644 ext/spice/src/cspice/samsbi.c create mode 100644 ext/spice/src/cspice/samsub.c create mode 100644 ext/spice/src/cspice/sc01.c create mode 100644 ext/spice/src/cspice/scanit.c create mode 100644 ext/spice/src/cspice/scanrj.c create mode 100644 ext/spice/src/cspice/scard_c.c create mode 100644 ext/spice/src/cspice/scardc.c create mode 100644 ext/spice/src/cspice/scardd.c create mode 100644 ext/spice/src/cspice/scardi.c create mode 100644 ext/spice/src/cspice/scdecd.c create mode 100644 ext/spice/src/cspice/scdecd_c.c create mode 100644 ext/spice/src/cspice/sce2c.c create mode 100644 ext/spice/src/cspice/sce2c_c.c create mode 100644 ext/spice/src/cspice/sce2s.c create mode 100644 ext/spice/src/cspice/sce2s_c.c create mode 100644 ext/spice/src/cspice/sce2t.c create mode 100644 ext/spice/src/cspice/sce2t_c.c create mode 100644 ext/spice/src/cspice/scencd.c create mode 100644 ext/spice/src/cspice/scencd_c.c create mode 100644 ext/spice/src/cspice/scfmt.c create mode 100644 ext/spice/src/cspice/scfmt_c.c create mode 100644 ext/spice/src/cspice/sclu01.c create mode 100644 ext/spice/src/cspice/scpars.c create mode 100644 ext/spice/src/cspice/scpart.c create mode 100644 ext/spice/src/cspice/scpart_c.c create mode 100644 ext/spice/src/cspice/scps01.c create mode 100644 ext/spice/src/cspice/scs2e.c create mode 100644 ext/spice/src/cspice/scs2e_c.c create mode 100644 ext/spice/src/cspice/sct2e.c create mode 100644 ext/spice/src/cspice/sct2e_c.c create mode 100644 ext/spice/src/cspice/sctiks.c create mode 100644 ext/spice/src/cspice/sctiks_c.c create mode 100644 ext/spice/src/cspice/sctran.c create mode 100644 ext/spice/src/cspice/sctype.c create mode 100644 ext/spice/src/cspice/sdiff_c.c create mode 100644 ext/spice/src/cspice/sdiffc.c create mode 100644 ext/spice/src/cspice/sdiffd.c create mode 100644 ext/spice/src/cspice/sdiffi.c create mode 100644 ext/spice/src/cspice/set_c.c create mode 100644 ext/spice/src/cspice/setc.c create mode 100644 ext/spice/src/cspice/setd.c create mode 100644 ext/spice/src/cspice/seterr.c create mode 100644 ext/spice/src/cspice/seti.c create mode 100644 ext/spice/src/cspice/setmsg.c create mode 100644 ext/spice/src/cspice/setmsg_c.c create mode 100644 ext/spice/src/cspice/sfe.c create mode 100644 ext/spice/src/cspice/sgfcon.c create mode 100644 ext/spice/src/cspice/sgfpkt.c create mode 100644 ext/spice/src/cspice/sgfref.c create mode 100644 ext/spice/src/cspice/sgfrvi.c create mode 100644 ext/spice/src/cspice/sgmeta.c create mode 100644 ext/spice/src/cspice/sgseqw.c create mode 100644 ext/spice/src/cspice/sharpr.c create mode 100644 ext/spice/src/cspice/shellc.c create mode 100644 ext/spice/src/cspice/shellc_c.c create mode 100644 ext/spice/src/cspice/shelld.c create mode 100644 ext/spice/src/cspice/shelld_c.c create mode 100644 ext/spice/src/cspice/shelli.c create mode 100644 ext/spice/src/cspice/shelli_c.c create mode 100644 ext/spice/src/cspice/shiftc.c create mode 100644 ext/spice/src/cspice/shiftl.c create mode 100644 ext/spice/src/cspice/shiftr.c create mode 100644 ext/spice/src/cspice/sig_die.c create mode 100644 ext/spice/src/cspice/sigdgt.c create mode 100644 ext/spice/src/cspice/sigerr.c create mode 100644 ext/spice/src/cspice/sigerr_c.c create mode 100644 ext/spice/src/cspice/signal1.h create mode 100644 ext/spice/src/cspice/signal_.c create mode 100644 ext/spice/src/cspice/sincpt.c create mode 100644 ext/spice/src/cspice/sincpt_c.c create mode 100644 ext/spice/src/cspice/size_c.c create mode 100644 ext/spice/src/cspice/sizec.c create mode 100644 ext/spice/src/cspice/sized.c create mode 100644 ext/spice/src/cspice/sizei.c create mode 100644 ext/spice/src/cspice/smsgnd.c create mode 100644 ext/spice/src/cspice/smsgni.c create mode 100644 ext/spice/src/cspice/somfls.c create mode 100644 ext/spice/src/cspice/somtru.c create mode 100644 ext/spice/src/cspice/spca2b.c create mode 100644 ext/spice/src/cspice/spcac.c create mode 100644 ext/spice/src/cspice/spcb2a.c create mode 100644 ext/spice/src/cspice/spcb2t.c create mode 100644 ext/spice/src/cspice/spcdc.c create mode 100644 ext/spice/src/cspice/spcec.c create mode 100644 ext/spice/src/cspice/spcopn.c create mode 100644 ext/spice/src/cspice/spcrfl.c create mode 100644 ext/spice/src/cspice/spct2b.c create mode 100644 ext/spice/src/cspice/spd.c create mode 100644 ext/spice/src/cspice/spd_c.c create mode 100644 ext/spice/src/cspice/sphcyl.c create mode 100644 ext/spice/src/cspice/sphcyl_c.c create mode 100644 ext/spice/src/cspice/sphlat.c create mode 100644 ext/spice/src/cspice/sphlat_c.c create mode 100644 ext/spice/src/cspice/sphrec.c create mode 100644 ext/spice/src/cspice/sphrec_c.c create mode 100644 ext/spice/src/cspice/sphsd.c create mode 100644 ext/spice/src/cspice/spk14a.c create mode 100644 ext/spice/src/cspice/spk14a_c.c create mode 100644 ext/spice/src/cspice/spk14b.c create mode 100644 ext/spice/src/cspice/spk14b_c.c create mode 100644 ext/spice/src/cspice/spk14e.c create mode 100644 ext/spice/src/cspice/spk14e_c.c create mode 100644 ext/spice/src/cspice/spkacs.c create mode 100644 ext/spice/src/cspice/spkacs_c.c create mode 100644 ext/spice/src/cspice/spkapo.c create mode 100644 ext/spice/src/cspice/spkapo_c.c create mode 100644 ext/spice/src/cspice/spkapp.c create mode 100644 ext/spice/src/cspice/spkapp_c.c create mode 100644 ext/spice/src/cspice/spkaps.c create mode 100644 ext/spice/src/cspice/spkaps_c.c create mode 100644 ext/spice/src/cspice/spkbsr.c create mode 100644 ext/spice/src/cspice/spkcls.c create mode 100644 ext/spice/src/cspice/spkcls_c.c create mode 100644 ext/spice/src/cspice/spkcov.c create mode 100644 ext/spice/src/cspice/spkcov_c.c create mode 100644 ext/spice/src/cspice/spke01.c create mode 100644 ext/spice/src/cspice/spke02.c create mode 100644 ext/spice/src/cspice/spke03.c create mode 100644 ext/spice/src/cspice/spke05.c create mode 100644 ext/spice/src/cspice/spke08.c create mode 100644 ext/spice/src/cspice/spke09.c create mode 100644 ext/spice/src/cspice/spke10.c create mode 100644 ext/spice/src/cspice/spke12.c create mode 100644 ext/spice/src/cspice/spke13.c create mode 100644 ext/spice/src/cspice/spke14.c create mode 100644 ext/spice/src/cspice/spke15.c create mode 100644 ext/spice/src/cspice/spke17.c create mode 100644 ext/spice/src/cspice/spke18.c create mode 100644 ext/spice/src/cspice/spkez.c create mode 100644 ext/spice/src/cspice/spkez_c.c create mode 100644 ext/spice/src/cspice/spkezp.c create mode 100644 ext/spice/src/cspice/spkezp_c.c create mode 100644 ext/spice/src/cspice/spkezr.c create mode 100644 ext/spice/src/cspice/spkezr_c.c create mode 100644 ext/spice/src/cspice/spkgeo.c create mode 100644 ext/spice/src/cspice/spkgeo_c.c create mode 100644 ext/spice/src/cspice/spkgps.c create mode 100644 ext/spice/src/cspice/spkgps_c.c create mode 100644 ext/spice/src/cspice/spklef_c.c create mode 100644 ext/spice/src/cspice/spkltc.c create mode 100644 ext/spice/src/cspice/spkltc_c.c create mode 100644 ext/spice/src/cspice/spkobj.c create mode 100644 ext/spice/src/cspice/spkobj_c.c create mode 100644 ext/spice/src/cspice/spkopa.c create mode 100644 ext/spice/src/cspice/spkopa_c.c create mode 100644 ext/spice/src/cspice/spkopn.c create mode 100644 ext/spice/src/cspice/spkopn_c.c create mode 100644 ext/spice/src/cspice/spkpds.c create mode 100644 ext/spice/src/cspice/spkpds_c.c create mode 100644 ext/spice/src/cspice/spkpos.c create mode 100644 ext/spice/src/cspice/spkpos_c.c create mode 100644 ext/spice/src/cspice/spkpv.c create mode 100644 ext/spice/src/cspice/spkpvn.c create mode 100644 ext/spice/src/cspice/spkr01.c create mode 100644 ext/spice/src/cspice/spkr02.c create mode 100644 ext/spice/src/cspice/spkr03.c create mode 100644 ext/spice/src/cspice/spkr05.c create mode 100644 ext/spice/src/cspice/spkr08.c create mode 100644 ext/spice/src/cspice/spkr09.c create mode 100644 ext/spice/src/cspice/spkr10.c create mode 100644 ext/spice/src/cspice/spkr12.c create mode 100644 ext/spice/src/cspice/spkr13.c create mode 100644 ext/spice/src/cspice/spkr14.c create mode 100644 ext/spice/src/cspice/spkr15.c create mode 100644 ext/spice/src/cspice/spkr17.c create mode 100644 ext/spice/src/cspice/spkr18.c create mode 100644 ext/spice/src/cspice/spks01.c create mode 100644 ext/spice/src/cspice/spks02.c create mode 100644 ext/spice/src/cspice/spks03.c create mode 100644 ext/spice/src/cspice/spks05.c create mode 100644 ext/spice/src/cspice/spks08.c create mode 100644 ext/spice/src/cspice/spks09.c create mode 100644 ext/spice/src/cspice/spks10.c create mode 100644 ext/spice/src/cspice/spks12.c create mode 100644 ext/spice/src/cspice/spks13.c create mode 100644 ext/spice/src/cspice/spks14.c create mode 100644 ext/spice/src/cspice/spks15.c create mode 100644 ext/spice/src/cspice/spks17.c create mode 100644 ext/spice/src/cspice/spks18.c create mode 100644 ext/spice/src/cspice/spkssb.c create mode 100644 ext/spice/src/cspice/spkssb_c.c create mode 100644 ext/spice/src/cspice/spksub.c create mode 100644 ext/spice/src/cspice/spksub_c.c create mode 100644 ext/spice/src/cspice/spkuds.c create mode 100644 ext/spice/src/cspice/spkuds_c.c create mode 100644 ext/spice/src/cspice/spkuef_c.c create mode 100644 ext/spice/src/cspice/spkw01.c create mode 100644 ext/spice/src/cspice/spkw02.c create mode 100644 ext/spice/src/cspice/spkw02_c.c create mode 100644 ext/spice/src/cspice/spkw03.c create mode 100644 ext/spice/src/cspice/spkw03_c.c create mode 100644 ext/spice/src/cspice/spkw05.c create mode 100644 ext/spice/src/cspice/spkw05_c.c create mode 100644 ext/spice/src/cspice/spkw08.c create mode 100644 ext/spice/src/cspice/spkw08_c.c create mode 100644 ext/spice/src/cspice/spkw09.c create mode 100644 ext/spice/src/cspice/spkw09_c.c create mode 100644 ext/spice/src/cspice/spkw10.c create mode 100644 ext/spice/src/cspice/spkw10_c.c create mode 100644 ext/spice/src/cspice/spkw12.c create mode 100644 ext/spice/src/cspice/spkw12_c.c create mode 100644 ext/spice/src/cspice/spkw13.c create mode 100644 ext/spice/src/cspice/spkw13_c.c create mode 100644 ext/spice/src/cspice/spkw15.c create mode 100644 ext/spice/src/cspice/spkw15_c.c create mode 100644 ext/spice/src/cspice/spkw17.c create mode 100644 ext/spice/src/cspice/spkw17_c.c create mode 100644 ext/spice/src/cspice/spkw18.c create mode 100644 ext/spice/src/cspice/spkw18_c.c create mode 100644 ext/spice/src/cspice/srfrec.c create mode 100644 ext/spice/src/cspice/srfrec_c.c create mode 100644 ext/spice/src/cspice/srfxpt.c create mode 100644 ext/spice/src/cspice/srfxpt_c.c create mode 100644 ext/spice/src/cspice/ssize_c.c create mode 100644 ext/spice/src/cspice/ssizec.c create mode 100644 ext/spice/src/cspice/ssized.c create mode 100644 ext/spice/src/cspice/ssizei.c create mode 100644 ext/spice/src/cspice/stcc01.c create mode 100644 ext/spice/src/cspice/stcf01.c create mode 100644 ext/spice/src/cspice/stcg01.c create mode 100644 ext/spice/src/cspice/stcl01.c create mode 100644 ext/spice/src/cspice/stdio.c create mode 100644 ext/spice/src/cspice/stelab.c create mode 100644 ext/spice/src/cspice/stelab_c.c create mode 100644 ext/spice/src/cspice/stlabx.c create mode 100644 ext/spice/src/cspice/stmp03.c create mode 100644 ext/spice/src/cspice/stpool.c create mode 100644 ext/spice/src/cspice/stpool_c.c create mode 100644 ext/spice/src/cspice/str2et.c create mode 100644 ext/spice/src/cspice/str2et_c.c create mode 100644 ext/spice/src/cspice/subpnt.c create mode 100644 ext/spice/src/cspice/subpnt_c.c create mode 100644 ext/spice/src/cspice/subpt.c create mode 100644 ext/spice/src/cspice/subpt_c.c create mode 100644 ext/spice/src/cspice/subslr.c create mode 100644 ext/spice/src/cspice/subslr_c.c create mode 100644 ext/spice/src/cspice/subsol.c create mode 100644 ext/spice/src/cspice/subsol_c.c create mode 100644 ext/spice/src/cspice/sue.c create mode 100644 ext/spice/src/cspice/suffix.c create mode 100644 ext/spice/src/cspice/sumad.c create mode 100644 ext/spice/src/cspice/sumad_c.c create mode 100644 ext/spice/src/cspice/sumai.c create mode 100644 ext/spice/src/cspice/sumai_c.c create mode 100644 ext/spice/src/cspice/surfnm.c create mode 100644 ext/spice/src/cspice/surfnm_c.c create mode 100644 ext/spice/src/cspice/surfpt.c create mode 100644 ext/spice/src/cspice/surfpt_c.c create mode 100644 ext/spice/src/cspice/surfpv.c create mode 100644 ext/spice/src/cspice/surfpv_c.c create mode 100644 ext/spice/src/cspice/swapac.c create mode 100644 ext/spice/src/cspice/swapad.c create mode 100644 ext/spice/src/cspice/swapai.c create mode 100644 ext/spice/src/cspice/swapc.c create mode 100644 ext/spice/src/cspice/swapd.c create mode 100644 ext/spice/src/cspice/swapi.c create mode 100644 ext/spice/src/cspice/swpool_c.c create mode 100644 ext/spice/src/cspice/sxform.c create mode 100644 ext/spice/src/cspice/sxform_c.c create mode 100644 ext/spice/src/cspice/sydelc.c create mode 100644 ext/spice/src/cspice/sydeld.c create mode 100644 ext/spice/src/cspice/sydeli.c create mode 100644 ext/spice/src/cspice/sydimc.c create mode 100644 ext/spice/src/cspice/sydimd.c create mode 100644 ext/spice/src/cspice/sydimi.c create mode 100644 ext/spice/src/cspice/sydupc.c create mode 100644 ext/spice/src/cspice/sydupd.c create mode 100644 ext/spice/src/cspice/sydupi.c create mode 100644 ext/spice/src/cspice/syenqc.c create mode 100644 ext/spice/src/cspice/syenqd.c create mode 100644 ext/spice/src/cspice/syenqi.c create mode 100644 ext/spice/src/cspice/syfetc.c create mode 100644 ext/spice/src/cspice/syfetd.c create mode 100644 ext/spice/src/cspice/syfeti.c create mode 100644 ext/spice/src/cspice/sygetc.c create mode 100644 ext/spice/src/cspice/sygetd.c create mode 100644 ext/spice/src/cspice/sygeti.c create mode 100644 ext/spice/src/cspice/synthc.c create mode 100644 ext/spice/src/cspice/synthd.c create mode 100644 ext/spice/src/cspice/synthi.c create mode 100644 ext/spice/src/cspice/syordc.c create mode 100644 ext/spice/src/cspice/syordd.c create mode 100644 ext/spice/src/cspice/syordi.c create mode 100644 ext/spice/src/cspice/sypopc.c create mode 100644 ext/spice/src/cspice/sypopd.c create mode 100644 ext/spice/src/cspice/sypopi.c create mode 100644 ext/spice/src/cspice/sypshc.c create mode 100644 ext/spice/src/cspice/sypshd.c create mode 100644 ext/spice/src/cspice/sypshi.c create mode 100644 ext/spice/src/cspice/syputc.c create mode 100644 ext/spice/src/cspice/syputd.c create mode 100644 ext/spice/src/cspice/syputi.c create mode 100644 ext/spice/src/cspice/syrenc.c create mode 100644 ext/spice/src/cspice/syrend.c create mode 100644 ext/spice/src/cspice/syreni.c create mode 100644 ext/spice/src/cspice/syselc.c create mode 100644 ext/spice/src/cspice/syseld.c create mode 100644 ext/spice/src/cspice/syseli.c create mode 100644 ext/spice/src/cspice/sysetc.c create mode 100644 ext/spice/src/cspice/sysetd.c create mode 100644 ext/spice/src/cspice/syseti.c create mode 100644 ext/spice/src/cspice/system_.c create mode 100644 ext/spice/src/cspice/sytrnc.c create mode 100644 ext/spice/src/cspice/sytrnd.c create mode 100644 ext/spice/src/cspice/sytrni.c create mode 100644 ext/spice/src/cspice/szpool_c.c create mode 100644 ext/spice/src/cspice/tcheck.c create mode 100644 ext/spice/src/cspice/texpyr.c create mode 100644 ext/spice/src/cspice/timdef.c create mode 100644 ext/spice/src/cspice/timdef_c.c create mode 100644 ext/spice/src/cspice/timout.c create mode 100644 ext/spice/src/cspice/timout_c.c create mode 100644 ext/spice/src/cspice/tipbod.c create mode 100644 ext/spice/src/cspice/tipbod_c.c create mode 100644 ext/spice/src/cspice/tisbod.c create mode 100644 ext/spice/src/cspice/tisbod_c.c create mode 100644 ext/spice/src/cspice/tkfram.c create mode 100644 ext/spice/src/cspice/tkvrsn.c create mode 100644 ext/spice/src/cspice/tkvrsn_c.c create mode 100644 ext/spice/src/cspice/tostdo.c create mode 100644 ext/spice/src/cspice/touchc.c create mode 100644 ext/spice/src/cspice/touchd.c create mode 100644 ext/spice/src/cspice/touchi.c create mode 100644 ext/spice/src/cspice/touchl.c create mode 100644 ext/spice/src/cspice/tparse.c create mode 100644 ext/spice/src/cspice/tparse_c.c create mode 100644 ext/spice/src/cspice/tpartv.c create mode 100644 ext/spice/src/cspice/tpictr.c create mode 100644 ext/spice/src/cspice/tpictr_c.c create mode 100644 ext/spice/src/cspice/trace.c create mode 100644 ext/spice/src/cspice/trace_c.c create mode 100644 ext/spice/src/cspice/traceg.c create mode 100644 ext/spice/src/cspice/trcoff_c.c create mode 100644 ext/spice/src/cspice/trcpkg.c create mode 100644 ext/spice/src/cspice/tsetyr_c.c create mode 100644 ext/spice/src/cspice/ttrans.c create mode 100644 ext/spice/src/cspice/twopi.c create mode 100644 ext/spice/src/cspice/twopi_c.c create mode 100644 ext/spice/src/cspice/twovec.c create mode 100644 ext/spice/src/cspice/twovec_c.c create mode 100644 ext/spice/src/cspice/twovxf.c create mode 100644 ext/spice/src/cspice/txtopn.c create mode 100644 ext/spice/src/cspice/txtopr.c create mode 100644 ext/spice/src/cspice/tyear.c create mode 100644 ext/spice/src/cspice/tyear_c.c create mode 100644 ext/spice/src/cspice/typesize.c create mode 100644 ext/spice/src/cspice/ucase.c create mode 100644 ext/spice/src/cspice/ucase_c.c create mode 100644 ext/spice/src/cspice/ucrss.c create mode 100644 ext/spice/src/cspice/ucrss_c.c create mode 100644 ext/spice/src/cspice/uddc.c create mode 100644 ext/spice/src/cspice/uddc_c.c create mode 100644 ext/spice/src/cspice/uddf.c create mode 100644 ext/spice/src/cspice/uddf_c.c create mode 100644 ext/spice/src/cspice/uio.c create mode 100644 ext/spice/src/cspice/union_c.c create mode 100644 ext/spice/src/cspice/unionc.c create mode 100644 ext/spice/src/cspice/uniond.c create mode 100644 ext/spice/src/cspice/unioni.c create mode 100644 ext/spice/src/cspice/unitim.c create mode 100644 ext/spice/src/cspice/unitim_c.c create mode 100644 ext/spice/src/cspice/unload_c.c create mode 100644 ext/spice/src/cspice/unorm.c create mode 100644 ext/spice/src/cspice/unorm_c.c create mode 100644 ext/spice/src/cspice/unormg.c create mode 100644 ext/spice/src/cspice/unormg_c.c create mode 100644 ext/spice/src/cspice/utc2et.c create mode 100644 ext/spice/src/cspice/utc2et_c.c create mode 100644 ext/spice/src/cspice/util.c create mode 100644 ext/spice/src/cspice/vadd.c create mode 100644 ext/spice/src/cspice/vadd_c.c create mode 100644 ext/spice/src/cspice/vaddg.c create mode 100644 ext/spice/src/cspice/vaddg_c.c create mode 100644 ext/spice/src/cspice/valid_c.c create mode 100644 ext/spice/src/cspice/validc.c create mode 100644 ext/spice/src/cspice/validd.c create mode 100644 ext/spice/src/cspice/validi.c create mode 100644 ext/spice/src/cspice/vcrss.c create mode 100644 ext/spice/src/cspice/vcrss_c.c create mode 100644 ext/spice/src/cspice/vdist.c create mode 100644 ext/spice/src/cspice/vdist_c.c create mode 100644 ext/spice/src/cspice/vdistg.c create mode 100644 ext/spice/src/cspice/vdistg_c.c create mode 100644 ext/spice/src/cspice/vdot.c create mode 100644 ext/spice/src/cspice/vdot_c.c create mode 100644 ext/spice/src/cspice/vdotg.c create mode 100644 ext/spice/src/cspice/vdotg_c.c create mode 100644 ext/spice/src/cspice/vequ.c create mode 100644 ext/spice/src/cspice/vequ_c.c create mode 100644 ext/spice/src/cspice/vequg.c create mode 100644 ext/spice/src/cspice/vequg_c.c create mode 100644 ext/spice/src/cspice/vhat.c create mode 100644 ext/spice/src/cspice/vhat_c.c create mode 100644 ext/spice/src/cspice/vhatg.c create mode 100644 ext/spice/src/cspice/vhatg_c.c create mode 100644 ext/spice/src/cspice/vhatip.c create mode 100644 ext/spice/src/cspice/vlcom.c create mode 100644 ext/spice/src/cspice/vlcom3.c create mode 100644 ext/spice/src/cspice/vlcom3_c.c create mode 100644 ext/spice/src/cspice/vlcom_c.c create mode 100644 ext/spice/src/cspice/vlcomg.c create mode 100644 ext/spice/src/cspice/vlcomg_c.c create mode 100644 ext/spice/src/cspice/vminug.c create mode 100644 ext/spice/src/cspice/vminug_c.c create mode 100644 ext/spice/src/cspice/vminus.c create mode 100644 ext/spice/src/cspice/vminus_c.c create mode 100644 ext/spice/src/cspice/vnorm.c create mode 100644 ext/spice/src/cspice/vnorm_c.c create mode 100644 ext/spice/src/cspice/vnormg.c create mode 100644 ext/spice/src/cspice/vnormg_c.c create mode 100644 ext/spice/src/cspice/vpack.c create mode 100644 ext/spice/src/cspice/vpack_c.c create mode 100644 ext/spice/src/cspice/vperp.c create mode 100644 ext/spice/src/cspice/vperp_c.c create mode 100644 ext/spice/src/cspice/vprjp.c create mode 100644 ext/spice/src/cspice/vprjp_c.c create mode 100644 ext/spice/src/cspice/vprjpi.c create mode 100644 ext/spice/src/cspice/vprjpi_c.c create mode 100644 ext/spice/src/cspice/vproj.c create mode 100644 ext/spice/src/cspice/vproj_c.c create mode 100644 ext/spice/src/cspice/vprojg.c create mode 100644 ext/spice/src/cspice/vrel.c create mode 100644 ext/spice/src/cspice/vrel_c.c create mode 100644 ext/spice/src/cspice/vrelg.c create mode 100644 ext/spice/src/cspice/vrelg_c.c create mode 100644 ext/spice/src/cspice/vrotv.c create mode 100644 ext/spice/src/cspice/vrotv_c.c create mode 100644 ext/spice/src/cspice/vscl.c create mode 100644 ext/spice/src/cspice/vscl_c.c create mode 100644 ext/spice/src/cspice/vsclg.c create mode 100644 ext/spice/src/cspice/vsclg_c.c create mode 100644 ext/spice/src/cspice/vsclip.c create mode 100644 ext/spice/src/cspice/vsep.c create mode 100644 ext/spice/src/cspice/vsep_c.c create mode 100644 ext/spice/src/cspice/vsepg.c create mode 100644 ext/spice/src/cspice/vsepg_c.c create mode 100644 ext/spice/src/cspice/vsub.c create mode 100644 ext/spice/src/cspice/vsub_c.c create mode 100644 ext/spice/src/cspice/vsubg.c create mode 100644 ext/spice/src/cspice/vsubg_c.c create mode 100644 ext/spice/src/cspice/vtmv.c create mode 100644 ext/spice/src/cspice/vtmv_c.c create mode 100644 ext/spice/src/cspice/vtmvg.c create mode 100644 ext/spice/src/cspice/vtmvg_c.c create mode 100644 ext/spice/src/cspice/vupack.c create mode 100644 ext/spice/src/cspice/vupack_c.c create mode 100644 ext/spice/src/cspice/vzero.c create mode 100644 ext/spice/src/cspice/vzero_c.c create mode 100644 ext/spice/src/cspice/vzerog.c create mode 100644 ext/spice/src/cspice/vzerog_c.c create mode 100644 ext/spice/src/cspice/wdcnt.c create mode 100644 ext/spice/src/cspice/wdindx.c create mode 100644 ext/spice/src/cspice/wncard.c create mode 100644 ext/spice/src/cspice/wncard_c.c create mode 100644 ext/spice/src/cspice/wncomd.c create mode 100644 ext/spice/src/cspice/wncomd_c.c create mode 100644 ext/spice/src/cspice/wncond.c create mode 100644 ext/spice/src/cspice/wncond_c.c create mode 100644 ext/spice/src/cspice/wndifd.c create mode 100644 ext/spice/src/cspice/wndifd_c.c create mode 100644 ext/spice/src/cspice/wnelmd.c create mode 100644 ext/spice/src/cspice/wnelmd_c.c create mode 100644 ext/spice/src/cspice/wnexpd.c create mode 100644 ext/spice/src/cspice/wnexpd_c.c create mode 100644 ext/spice/src/cspice/wnextd.c create mode 100644 ext/spice/src/cspice/wnextd_c.c create mode 100644 ext/spice/src/cspice/wnfetd.c create mode 100644 ext/spice/src/cspice/wnfetd_c.c create mode 100644 ext/spice/src/cspice/wnfild.c create mode 100644 ext/spice/src/cspice/wnfild_c.c create mode 100644 ext/spice/src/cspice/wnfltd.c create mode 100644 ext/spice/src/cspice/wnfltd_c.c create mode 100644 ext/spice/src/cspice/wnincd.c create mode 100644 ext/spice/src/cspice/wnincd_c.c create mode 100644 ext/spice/src/cspice/wninsd.c create mode 100644 ext/spice/src/cspice/wninsd_c.c create mode 100644 ext/spice/src/cspice/wnintd.c create mode 100644 ext/spice/src/cspice/wnintd_c.c create mode 100644 ext/spice/src/cspice/wnreld.c create mode 100644 ext/spice/src/cspice/wnreld_c.c create mode 100644 ext/spice/src/cspice/wnsumd.c create mode 100644 ext/spice/src/cspice/wnsumd_c.c create mode 100644 ext/spice/src/cspice/wnunid.c create mode 100644 ext/spice/src/cspice/wnunid_c.c create mode 100644 ext/spice/src/cspice/wnvald.c create mode 100644 ext/spice/src/cspice/wnvald_c.c create mode 100644 ext/spice/src/cspice/wref.c create mode 100644 ext/spice/src/cspice/wrencc.c create mode 100644 ext/spice/src/cspice/wrencd.c create mode 100644 ext/spice/src/cspice/wrenci.c create mode 100644 ext/spice/src/cspice/writla.c create mode 100644 ext/spice/src/cspice/writln.c create mode 100644 ext/spice/src/cspice/wrkvar.c create mode 100644 ext/spice/src/cspice/wrline.c create mode 100644 ext/spice/src/cspice/wrtfmt.c create mode 100644 ext/spice/src/cspice/wsfe.c create mode 100644 ext/spice/src/cspice/wsle.c create mode 100644 ext/spice/src/cspice/wsne.c create mode 100644 ext/spice/src/cspice/xf2eul.c create mode 100644 ext/spice/src/cspice/xf2eul_c.c create mode 100644 ext/spice/src/cspice/xf2rav.c create mode 100644 ext/spice/src/cspice/xf2rav_c.c create mode 100644 ext/spice/src/cspice/xposbl.c create mode 100644 ext/spice/src/cspice/xpose.c create mode 100644 ext/spice/src/cspice/xpose6_c.c create mode 100644 ext/spice/src/cspice/xpose_c.c create mode 100644 ext/spice/src/cspice/xposeg.c create mode 100644 ext/spice/src/cspice/xposeg_c.c create mode 100644 ext/spice/src/cspice/xpsgip.c create mode 100644 ext/spice/src/cspice/xwsne.c create mode 100644 ext/spice/src/cspice/z_abs.c create mode 100644 ext/spice/src/cspice/z_cos.c create mode 100644 ext/spice/src/cspice/z_div.c create mode 100644 ext/spice/src/cspice/z_exp.c create mode 100644 ext/spice/src/cspice/z_log.c create mode 100644 ext/spice/src/cspice/z_sin.c create mode 100644 ext/spice/src/cspice/z_sqrt.c create mode 100644 ext/spice/src/cspice/zzadbail_c.c create mode 100644 ext/spice/src/cspice/zzadfunc_c.c create mode 100644 ext/spice/src/cspice/zzadqdec_c.c create mode 100644 ext/spice/src/cspice/zzadrefn_c.c create mode 100644 ext/spice/src/cspice/zzadrepf_c.c create mode 100644 ext/spice/src/cspice/zzadrepi_c.c create mode 100644 ext/spice/src/cspice/zzadrepu_c.c create mode 100644 ext/spice/src/cspice/zzadsave_c.c create mode 100644 ext/spice/src/cspice/zzadstep_c.c create mode 100644 ext/spice/src/cspice/zzalloc.c create mode 100644 ext/spice/src/cspice/zzalloc.h create mode 100644 ext/spice/src/cspice/zzascii.c create mode 100644 ext/spice/src/cspice/zzasryel.c create mode 100644 ext/spice/src/cspice/zzbodblt.c create mode 100644 ext/spice/src/cspice/zzbodbry.c create mode 100644 ext/spice/src/cspice/zzbodini.c create mode 100644 ext/spice/src/cspice/zzbodker.c create mode 100644 ext/spice/src/cspice/zzbodtrn.c create mode 100644 ext/spice/src/cspice/zzbodvcd.c create mode 100644 ext/spice/src/cspice/zzck4d2i.c create mode 100644 ext/spice/src/cspice/zzck4i2d.c create mode 100644 ext/spice/src/cspice/zzckcv01.c create mode 100644 ext/spice/src/cspice/zzckcv02.c create mode 100644 ext/spice/src/cspice/zzckcv03.c create mode 100644 ext/spice/src/cspice/zzckcv04.c create mode 100644 ext/spice/src/cspice/zzckcv05.c create mode 100644 ext/spice/src/cspice/zzckspk.c create mode 100644 ext/spice/src/cspice/zzcln.c create mode 100644 ext/spice/src/cspice/zzcorepc.c create mode 100644 ext/spice/src/cspice/zzcorsxf.c create mode 100644 ext/spice/src/cspice/zzcputim.c create mode 100644 ext/spice/src/cspice/zzdafgdr.c create mode 100644 ext/spice/src/cspice/zzdafgfr.c create mode 100644 ext/spice/src/cspice/zzdafgsr.c create mode 100644 ext/spice/src/cspice/zzdafnfr.c create mode 100644 ext/spice/src/cspice/zzdasnfr.c create mode 100644 ext/spice/src/cspice/zzddhclu.c create mode 100644 ext/spice/src/cspice/zzddhf2h.c create mode 100644 ext/spice/src/cspice/zzddhgsd.c create mode 100644 ext/spice/src/cspice/zzddhgtu.c create mode 100644 ext/spice/src/cspice/zzddhini.c create mode 100644 ext/spice/src/cspice/zzddhivf.c create mode 100644 ext/spice/src/cspice/zzddhman.c create mode 100644 ext/spice/src/cspice/zzddhppf.c create mode 100644 ext/spice/src/cspice/zzddhrcm.c create mode 100644 ext/spice/src/cspice/zzddhrmu.c create mode 100644 ext/spice/src/cspice/zzdynbid.c create mode 100644 ext/spice/src/cspice/zzdynfid.c create mode 100644 ext/spice/src/cspice/zzdynfr0.c create mode 100644 ext/spice/src/cspice/zzdynfrm.c create mode 100644 ext/spice/src/cspice/zzdynoac.c create mode 100644 ext/spice/src/cspice/zzdynoad.c create mode 100644 ext/spice/src/cspice/zzdynrot.c create mode 100644 ext/spice/src/cspice/zzdynrt0.c create mode 100644 ext/spice/src/cspice/zzdynvac.c create mode 100644 ext/spice/src/cspice/zzdynvad.c create mode 100644 ext/spice/src/cspice/zzdynvai.c create mode 100644 ext/spice/src/cspice/zzedterm.c create mode 100644 ext/spice/src/cspice/zzekac01.c create mode 100644 ext/spice/src/cspice/zzekac02.c create mode 100644 ext/spice/src/cspice/zzekac03.c create mode 100644 ext/spice/src/cspice/zzekac04.c create mode 100644 ext/spice/src/cspice/zzekac05.c create mode 100644 ext/spice/src/cspice/zzekac06.c create mode 100644 ext/spice/src/cspice/zzekac07.c create mode 100644 ext/spice/src/cspice/zzekac08.c create mode 100644 ext/spice/src/cspice/zzekac09.c create mode 100644 ext/spice/src/cspice/zzekacps.c create mode 100644 ext/spice/src/cspice/zzekad01.c create mode 100644 ext/spice/src/cspice/zzekad02.c create mode 100644 ext/spice/src/cspice/zzekad03.c create mode 100644 ext/spice/src/cspice/zzekad04.c create mode 100644 ext/spice/src/cspice/zzekad05.c create mode 100644 ext/spice/src/cspice/zzekad06.c create mode 100644 ext/spice/src/cspice/zzekaps.c create mode 100644 ext/spice/src/cspice/zzekbs01.c create mode 100644 ext/spice/src/cspice/zzekbs02.c create mode 100644 ext/spice/src/cspice/zzekcchk.c create mode 100644 ext/spice/src/cspice/zzekcdsc.c create mode 100644 ext/spice/src/cspice/zzekcix1.c create mode 100644 ext/spice/src/cspice/zzekcnam.c create mode 100644 ext/spice/src/cspice/zzekde01.c create mode 100644 ext/spice/src/cspice/zzekde02.c create mode 100644 ext/spice/src/cspice/zzekde03.c create mode 100644 ext/spice/src/cspice/zzekde04.c create mode 100644 ext/spice/src/cspice/zzekde05.c create mode 100644 ext/spice/src/cspice/zzekde06.c create mode 100644 ext/spice/src/cspice/zzekdps.c create mode 100644 ext/spice/src/cspice/zzekecmp.c create mode 100644 ext/spice/src/cspice/zzekencd.c create mode 100644 ext/spice/src/cspice/zzekerc1.c create mode 100644 ext/spice/src/cspice/zzekerd1.c create mode 100644 ext/spice/src/cspice/zzekeri1.c create mode 100644 ext/spice/src/cspice/zzekesiz.c create mode 100644 ext/spice/src/cspice/zzekff01.c create mode 100644 ext/spice/src/cspice/zzekfrx.c create mode 100644 ext/spice/src/cspice/zzekgcdp.c create mode 100644 ext/spice/src/cspice/zzekgei.c create mode 100644 ext/spice/src/cspice/zzekgfwd.c create mode 100644 ext/spice/src/cspice/zzekglnk.c create mode 100644 ext/spice/src/cspice/zzekgrcp.c create mode 100644 ext/spice/src/cspice/zzekgrs.c create mode 100644 ext/spice/src/cspice/zzekif01.c create mode 100644 ext/spice/src/cspice/zzekif02.c create mode 100644 ext/spice/src/cspice/zzekiic1.c create mode 100644 ext/spice/src/cspice/zzekiid1.c create mode 100644 ext/spice/src/cspice/zzekiii1.c create mode 100644 ext/spice/src/cspice/zzekille.c create mode 100644 ext/spice/src/cspice/zzekillt.c create mode 100644 ext/spice/src/cspice/zzekinqc.c create mode 100644 ext/spice/src/cspice/zzekinqn.c create mode 100644 ext/spice/src/cspice/zzekixdl.c create mode 100644 ext/spice/src/cspice/zzekixlk.c create mode 100644 ext/spice/src/cspice/zzekjoin.c create mode 100644 ext/spice/src/cspice/zzekjsqz.c create mode 100644 ext/spice/src/cspice/zzekjsrt.c create mode 100644 ext/spice/src/cspice/zzekjtst.c create mode 100644 ext/spice/src/cspice/zzekkey.c create mode 100644 ext/spice/src/cspice/zzeklerc.c create mode 100644 ext/spice/src/cspice/zzeklerd.c create mode 100644 ext/spice/src/cspice/zzekleri.c create mode 100644 ext/spice/src/cspice/zzekllec.c create mode 100644 ext/spice/src/cspice/zzeklled.c create mode 100644 ext/spice/src/cspice/zzekllei.c create mode 100644 ext/spice/src/cspice/zzeklltc.c create mode 100644 ext/spice/src/cspice/zzeklltd.c create mode 100644 ext/spice/src/cspice/zzekllti.c create mode 100644 ext/spice/src/cspice/zzekmloc.c create mode 100644 ext/spice/src/cspice/zzeknres.c create mode 100644 ext/spice/src/cspice/zzeknrml.c create mode 100644 ext/spice/src/cspice/zzekordc.c create mode 100644 ext/spice/src/cspice/zzekordd.c create mode 100644 ext/spice/src/cspice/zzekordi.c create mode 100644 ext/spice/src/cspice/zzekpage.c create mode 100644 ext/spice/src/cspice/zzekpars.c create mode 100644 ext/spice/src/cspice/zzekpcol.c create mode 100644 ext/spice/src/cspice/zzekpdec.c create mode 100644 ext/spice/src/cspice/zzekpgch.c create mode 100644 ext/spice/src/cspice/zzekqcnj.c create mode 100644 ext/spice/src/cspice/zzekqcon.c create mode 100644 ext/spice/src/cspice/zzekqini.c create mode 100644 ext/spice/src/cspice/zzekqord.c create mode 100644 ext/spice/src/cspice/zzekqsel.c create mode 100644 ext/spice/src/cspice/zzekqtab.c create mode 100644 ext/spice/src/cspice/zzekrbck.c create mode 100644 ext/spice/src/cspice/zzekrcmp.c create mode 100644 ext/spice/src/cspice/zzekrd01.c create mode 100644 ext/spice/src/cspice/zzekrd02.c create mode 100644 ext/spice/src/cspice/zzekrd03.c create mode 100644 ext/spice/src/cspice/zzekrd04.c create mode 100644 ext/spice/src/cspice/zzekrd05.c create mode 100644 ext/spice/src/cspice/zzekrd06.c create mode 100644 ext/spice/src/cspice/zzekrd07.c create mode 100644 ext/spice/src/cspice/zzekrd08.c create mode 100644 ext/spice/src/cspice/zzekrd09.c create mode 100644 ext/spice/src/cspice/zzekreqi.c create mode 100644 ext/spice/src/cspice/zzekrmch.c create mode 100644 ext/spice/src/cspice/zzekrp2n.c create mode 100644 ext/spice/src/cspice/zzekrplk.c create mode 100644 ext/spice/src/cspice/zzekrsc.c create mode 100644 ext/spice/src/cspice/zzekrsd.c create mode 100644 ext/spice/src/cspice/zzekrsi.c create mode 100644 ext/spice/src/cspice/zzeksca.c create mode 100644 ext/spice/src/cspice/zzekscan.c create mode 100644 ext/spice/src/cspice/zzekscdp.c create mode 100644 ext/spice/src/cspice/zzekscmp.c create mode 100644 ext/spice/src/cspice/zzeksdsc.c create mode 100644 ext/spice/src/cspice/zzeksei.c create mode 100644 ext/spice/src/cspice/zzeksemc.c create mode 100644 ext/spice/src/cspice/zzeksfwd.c create mode 100644 ext/spice/src/cspice/zzeksinf.c create mode 100644 ext/spice/src/cspice/zzekslnk.c create mode 100644 ext/spice/src/cspice/zzeksrcp.c create mode 100644 ext/spice/src/cspice/zzeksrs.c create mode 100644 ext/spice/src/cspice/zzekstyp.c create mode 100644 ext/spice/src/cspice/zzeksz04.c create mode 100644 ext/spice/src/cspice/zzeksz05.c create mode 100644 ext/spice/src/cspice/zzeksz06.c create mode 100644 ext/spice/src/cspice/zzektcnv.c create mode 100644 ext/spice/src/cspice/zzektloc.c create mode 100644 ext/spice/src/cspice/zzektr13.c create mode 100644 ext/spice/src/cspice/zzektr1s.c create mode 100644 ext/spice/src/cspice/zzektr23.c create mode 100644 ext/spice/src/cspice/zzektr31.c create mode 100644 ext/spice/src/cspice/zzektr32.c create mode 100644 ext/spice/src/cspice/zzektrap.c create mode 100644 ext/spice/src/cspice/zzektrbn.c create mode 100644 ext/spice/src/cspice/zzektrbs.c create mode 100644 ext/spice/src/cspice/zzektrdl.c create mode 100644 ext/spice/src/cspice/zzektrdp.c create mode 100644 ext/spice/src/cspice/zzektres.c create mode 100644 ext/spice/src/cspice/zzektrfr.c create mode 100644 ext/spice/src/cspice/zzektrin.c create mode 100644 ext/spice/src/cspice/zzektrit.c create mode 100644 ext/spice/src/cspice/zzektrki.c create mode 100644 ext/spice/src/cspice/zzektrlk.c create mode 100644 ext/spice/src/cspice/zzektrls.c create mode 100644 ext/spice/src/cspice/zzektrnk.c create mode 100644 ext/spice/src/cspice/zzektrpi.c create mode 100644 ext/spice/src/cspice/zzektrrk.c create mode 100644 ext/spice/src/cspice/zzektrsb.c create mode 100644 ext/spice/src/cspice/zzektrsz.c create mode 100644 ext/spice/src/cspice/zzektrud.c create mode 100644 ext/spice/src/cspice/zzektrui.c create mode 100644 ext/spice/src/cspice/zzekue01.c create mode 100644 ext/spice/src/cspice/zzekue02.c create mode 100644 ext/spice/src/cspice/zzekue03.c create mode 100644 ext/spice/src/cspice/zzekue04.c create mode 100644 ext/spice/src/cspice/zzekue05.c create mode 100644 ext/spice/src/cspice/zzekue06.c create mode 100644 ext/spice/src/cspice/zzekvadr.c create mode 100644 ext/spice/src/cspice/zzekvcmp.c create mode 100644 ext/spice/src/cspice/zzekvmch.c create mode 100644 ext/spice/src/cspice/zzekweed.c create mode 100644 ext/spice/src/cspice/zzekweqi.c create mode 100644 ext/spice/src/cspice/zzekwpac.c create mode 100644 ext/spice/src/cspice/zzekwpai.c create mode 100644 ext/spice/src/cspice/zzekwpal.c create mode 100644 ext/spice/src/cspice/zzelvupy.c create mode 100644 ext/spice/src/cspice/zzenut80.c create mode 100644 ext/spice/src/cspice/zzeprc76.c create mode 100644 ext/spice/src/cspice/zzeprcss.c create mode 100644 ext/spice/src/cspice/zzerror.c create mode 100644 ext/spice/src/cspice/zzerror.h create mode 100644 ext/spice/src/cspice/zzerrorinit.c create mode 100644 ext/spice/src/cspice/zzfcstring.c create mode 100644 ext/spice/src/cspice/zzfdat.c create mode 100644 ext/spice/src/cspice/zzfovaxi.c create mode 100644 ext/spice/src/cspice/zzfrmch0.c create mode 100644 ext/spice/src/cspice/zzfrmch1.c create mode 100644 ext/spice/src/cspice/zzfrmgt0.c create mode 100644 ext/spice/src/cspice/zzfrmgt1.c create mode 100644 ext/spice/src/cspice/zzftpchk.c create mode 100644 ext/spice/src/cspice/zzftpstr.c create mode 100644 ext/spice/src/cspice/zzgapool.c create mode 100644 ext/spice/src/cspice/zzgetbff.c create mode 100644 ext/spice/src/cspice/zzgetcml_c.c create mode 100644 ext/spice/src/cspice/zzgetelm.c create mode 100644 ext/spice/src/cspice/zzgfcoq.c create mode 100644 ext/spice/src/cspice/zzgfcost.c create mode 100644 ext/spice/src/cspice/zzgfcou.c create mode 100644 ext/spice/src/cspice/zzgfcprx.c create mode 100644 ext/spice/src/cspice/zzgfcslv.c create mode 100644 ext/spice/src/cspice/zzgfdiq.c create mode 100644 ext/spice/src/cspice/zzgfdiu.c create mode 100644 ext/spice/src/cspice/zzgfdsps.c create mode 100644 ext/spice/src/cspice/zzgffvu.c create mode 100644 ext/spice/src/cspice/zzgflong.c create mode 100644 ext/spice/src/cspice/zzgfocu.c create mode 100644 ext/spice/src/cspice/zzgfref.c create mode 100644 ext/spice/src/cspice/zzgfrel.c create mode 100644 ext/spice/src/cspice/zzgfrelx.c create mode 100644 ext/spice/src/cspice/zzgfrpwk.c create mode 100644 ext/spice/src/cspice/zzgfrrq.c create mode 100644 ext/spice/src/cspice/zzgfrru.c create mode 100644 ext/spice/src/cspice/zzgfsavh_c.c create mode 100644 ext/spice/src/cspice/zzgfsolv.c create mode 100644 ext/spice/src/cspice/zzgfsolvx.c create mode 100644 ext/spice/src/cspice/zzgfspq.c create mode 100644 ext/spice/src/cspice/zzgfspu.c create mode 100644 ext/spice/src/cspice/zzgfssin.c create mode 100644 ext/spice/src/cspice/zzgfssob.c create mode 100644 ext/spice/src/cspice/zzgftreb.c create mode 100644 ext/spice/src/cspice/zzgfudlt.c create mode 100644 ext/spice/src/cspice/zzgfwsts.c create mode 100644 ext/spice/src/cspice/zzgpnm.c create mode 100644 ext/spice/src/cspice/zzholdd.c create mode 100644 ext/spice/src/cspice/zzhullax.c create mode 100644 ext/spice/src/cspice/zzidmap.c create mode 100644 ext/spice/src/cspice/zzinssub.c create mode 100644 ext/spice/src/cspice/zzldker.c create mode 100644 ext/spice/src/cspice/zzmkpc.c create mode 100644 ext/spice/src/cspice/zzmobliq.c create mode 100644 ext/spice/src/cspice/zzmsxf.c create mode 100644 ext/spice/src/cspice/zznofcon.c create mode 100644 ext/spice/src/cspice/zznrddp.c create mode 100644 ext/spice/src/cspice/zznwpool.c create mode 100644 ext/spice/src/cspice/zzocced.c create mode 100644 ext/spice/src/cspice/zzphsh.c create mode 100644 ext/spice/src/cspice/zzpini.c create mode 100644 ext/spice/src/cspice/zzplatfm.c create mode 100644 ext/spice/src/cspice/zzpltchk.c create mode 100644 ext/spice/src/cspice/zzprscor.c create mode 100644 ext/spice/src/cspice/zzrbrkst.c create mode 100644 ext/spice/src/cspice/zzrefch0.c create mode 100644 ext/spice/src/cspice/zzrefch1.c create mode 100644 ext/spice/src/cspice/zzrepsub.c create mode 100644 ext/spice/src/cspice/zzrept.c create mode 100644 ext/spice/src/cspice/zzrotgt0.c create mode 100644 ext/spice/src/cspice/zzrotgt1.c create mode 100644 ext/spice/src/cspice/zzrtnmat.c create mode 100644 ext/spice/src/cspice/zzrvar.c create mode 100644 ext/spice/src/cspice/zzrvbf.c create mode 100644 ext/spice/src/cspice/zzrxr.c create mode 100644 ext/spice/src/cspice/zzsclk.c create mode 100644 ext/spice/src/cspice/zzsecprt.c create mode 100644 ext/spice/src/cspice/zzsizeok.c create mode 100644 ext/spice/src/cspice/zzspkac0.c create mode 100644 ext/spice/src/cspice/zzspkac1.c create mode 100644 ext/spice/src/cspice/zzspkap0.c create mode 100644 ext/spice/src/cspice/zzspkap1.c create mode 100644 ext/spice/src/cspice/zzspkas0.c create mode 100644 ext/spice/src/cspice/zzspkas1.c create mode 100644 ext/spice/src/cspice/zzspkez0.c create mode 100644 ext/spice/src/cspice/zzspkez1.c create mode 100644 ext/spice/src/cspice/zzspkgo0.c create mode 100644 ext/spice/src/cspice/zzspkgo1.c create mode 100644 ext/spice/src/cspice/zzspkgp0.c create mode 100644 ext/spice/src/cspice/zzspkgp1.c create mode 100644 ext/spice/src/cspice/zzspklt0.c create mode 100644 ext/spice/src/cspice/zzspklt1.c create mode 100644 ext/spice/src/cspice/zzspkpa0.c create mode 100644 ext/spice/src/cspice/zzspkpa1.c create mode 100644 ext/spice/src/cspice/zzspksb0.c create mode 100644 ext/spice/src/cspice/zzspksb1.c create mode 100644 ext/spice/src/cspice/zzspkzp0.c create mode 100644 ext/spice/src/cspice/zzspkzp1.c create mode 100644 ext/spice/src/cspice/zzstelab.c create mode 100644 ext/spice/src/cspice/zzsynccl_c.c create mode 100644 ext/spice/src/cspice/zztime.c create mode 100644 ext/spice/src/cspice/zztpats.c create mode 100644 ext/spice/src/cspice/zztwovxf.c create mode 100644 ext/spice/src/cspice/zzutcpm.c create mode 100644 ext/spice/src/cspice/zzvalcor.c create mode 100644 ext/spice/src/cspice/zzvstrng.c create mode 100644 ext/spice/src/cspice/zzwahr.c create mode 100644 ext/spice/src/cspice/zzwind.c create mode 100644 ext/spice/src/cspice/zzwind2d.c create mode 100644 ext/spice/src/cspice/zzwninsd.c create mode 100644 ext/spice/src/cspice/zzxlated.c create mode 100644 ext/spice/src/cspice/zzxlatei.c create mode 100644 ext/spice/src/csupport/SpiceCK.h create mode 100644 ext/spice/src/csupport/SpiceCel.h create mode 100644 ext/spice/src/csupport/SpiceEK.h create mode 100644 ext/spice/src/csupport/SpiceEll.h create mode 100644 ext/spice/src/csupport/SpiceGF.h create mode 100644 ext/spice/src/csupport/SpicePln.h create mode 100644 ext/spice/src/csupport/SpiceSPK.h create mode 100644 ext/spice/src/csupport/SpiceUsr.h create mode 100644 ext/spice/src/csupport/SpiceZad.h create mode 100644 ext/spice/src/csupport/SpiceZdf.h create mode 100644 ext/spice/src/csupport/SpiceZfc.h create mode 100644 ext/spice/src/csupport/SpiceZim.h create mode 100644 ext/spice/src/csupport/SpiceZmc.h create mode 100644 ext/spice/src/csupport/SpiceZpl.h create mode 100644 ext/spice/src/csupport/SpiceZpr.h create mode 100644 ext/spice/src/csupport/SpiceZst.h create mode 100644 ext/spice/src/csupport/batch.c create mode 100644 ext/spice/src/csupport/bboard_1.c create mode 100644 ext/spice/src/csupport/bestwd.c create mode 100644 ext/spice/src/csupport/builtn.c create mode 100644 ext/spice/src/csupport/cbget_1.c create mode 100644 ext/spice/src/csupport/cbinit_1.c create mode 100644 ext/spice/src/csupport/cbput_1.c create mode 100644 ext/spice/src/csupport/cbrem_1.c create mode 100644 ext/spice/src/csupport/changu.c create mode 100644 ext/spice/src/csupport/chbfit.c create mode 100644 ext/spice/src/csupport/ck3sdn.c create mode 100644 ext/spice/src/csupport/cmloop.c create mode 100644 ext/spice/src/csupport/cmmore.c create mode 100644 ext/spice/src/csupport/cmredo.c create mode 100644 ext/spice/src/csupport/cmstup.c create mode 100644 ext/spice/src/csupport/cnfirm.c create mode 100644 ext/spice/src/csupport/cnfirm_1.c create mode 100644 ext/spice/src/csupport/convbt.c create mode 100644 ext/spice/src/csupport/convrt_2.c create mode 100644 ext/spice/src/csupport/convrt_3.c create mode 100644 ext/spice/src/csupport/convtb.c create mode 100644 ext/spice/src/csupport/cputim.c create mode 100644 ext/spice/src/csupport/crtptr.c create mode 100644 ext/spice/src/csupport/curtim.c create mode 100644 ext/spice/src/csupport/cutstr.c create mode 100644 ext/spice/src/csupport/dafacu.c create mode 100644 ext/spice/src/csupport/dafecu.c create mode 100644 ext/spice/src/csupport/dcyphr.c create mode 100644 ext/spice/src/csupport/dimcb_1.c create mode 100644 ext/spice/src/csupport/dspvrs.c create mode 100644 ext/spice/src/csupport/echo.c create mode 100644 ext/spice/src/csupport/edtcmd.c create mode 100644 ext/spice/src/csupport/edtcom.c create mode 100644 ext/spice/src/csupport/exesys.c create mode 100644 ext/spice/src/csupport/expfnm_1.c create mode 100644 ext/spice/src/csupport/expfnm_2.c create mode 100644 ext/spice/src/csupport/f2c.h create mode 100644 ext/spice/src/csupport/f2cMang.h create mode 100644 ext/spice/src/csupport/flgrpt.c create mode 100644 ext/spice/src/csupport/fndntk.c create mode 100644 ext/spice/src/csupport/fndptk.c create mode 100644 ext/spice/src/csupport/fnducv.c create mode 100644 ext/spice/src/csupport/getcml.c create mode 100644 ext/spice/src/csupport/getdel.c create mode 100644 ext/spice/src/csupport/geteq.c create mode 100644 ext/spice/src/csupport/getfnm.c create mode 100644 ext/spice/src/csupport/getfnm_1.c create mode 100644 ext/spice/src/csupport/getopt.c create mode 100644 ext/spice/src/csupport/getopt_1.c create mode 100644 ext/spice/src/csupport/getopt_2.c create mode 100644 ext/spice/src/csupport/have.c create mode 100644 ext/spice/src/csupport/header.c create mode 100644 ext/spice/src/csupport/langua.c create mode 100644 ext/spice/src/csupport/lbdes_1.c create mode 100644 ext/spice/src/csupport/lbget_1.c create mode 100644 ext/spice/src/csupport/lbinit_1.c create mode 100644 ext/spice/src/csupport/lbins_1.c create mode 100644 ext/spice/src/csupport/lbpack_1.c create mode 100644 ext/spice/src/csupport/lbrem_1.c create mode 100644 ext/spice/src/csupport/lbupd_1.c create mode 100644 ext/spice/src/csupport/logchk.c create mode 100644 ext/spice/src/csupport/m2alph.c create mode 100644 ext/spice/src/csupport/m2begr.c create mode 100644 ext/spice/src/csupport/m2bodini.c create mode 100644 ext/spice/src/csupport/m2bodtrn.c create mode 100644 ext/spice/src/csupport/m2body.c create mode 100644 ext/spice/src/csupport/m2cal.c create mode 100644 ext/spice/src/csupport/m2chck.c create mode 100644 ext/spice/src/csupport/m2clss.c create mode 100644 ext/spice/src/csupport/m2core.c create mode 100644 ext/spice/src/csupport/m2day.c create mode 100644 ext/spice/src/csupport/m2diag.c create mode 100644 ext/spice/src/csupport/m2engl.c create mode 100644 ext/spice/src/csupport/m2epoc.c create mode 100644 ext/spice/src/csupport/m2geta.c create mode 100644 ext/spice/src/csupport/m2getb.c create mode 100644 ext/spice/src/csupport/m2getc.c create mode 100644 ext/spice/src/csupport/m2getd.c create mode 100644 ext/spice/src/csupport/m2geti.c create mode 100644 ext/spice/src/csupport/m2gmch.c create mode 100644 ext/spice/src/csupport/m2have.c create mode 100644 ext/spice/src/csupport/m2int.c create mode 100644 ext/spice/src/csupport/m2ints.c create mode 100644 ext/spice/src/csupport/m2keyw.c create mode 100644 ext/spice/src/csupport/m2mon.c create mode 100644 ext/spice/src/csupport/m2name.c create mode 100644 ext/spice/src/csupport/m2ntem.c create mode 100644 ext/spice/src/csupport/m2numb.c create mode 100644 ext/spice/src/csupport/m2pars.c create mode 100644 ext/spice/src/csupport/m2selb.c create mode 100644 ext/spice/src/csupport/m2selc.c create mode 100644 ext/spice/src/csupport/m2seld.c create mode 100644 ext/spice/src/csupport/m2seli.c create mode 100644 ext/spice/src/csupport/m2shll.c create mode 100644 ext/spice/src/csupport/m2term.c create mode 100644 ext/spice/src/csupport/m2thnq.c create mode 100644 ext/spice/src/csupport/m2time.c create mode 100644 ext/spice/src/csupport/m2tran.c create mode 100644 ext/spice/src/csupport/m2trim.c create mode 100644 ext/spice/src/csupport/m2unit.c create mode 100644 ext/spice/src/csupport/m2wmch.c create mode 100644 ext/spice/src/csupport/m2xist.c create mode 100644 ext/spice/src/csupport/m2year.c create mode 100644 ext/spice/src/csupport/makstr.c create mode 100644 ext/spice/src/csupport/match.c create mode 100644 ext/spice/src/csupport/matchc.c create mode 100644 ext/spice/src/csupport/matche.c create mode 100644 ext/spice/src/csupport/matchm.c create mode 100644 ext/spice/src/csupport/matcho.c create mode 100644 ext/spice/src/csupport/meta_2.c create mode 100644 ext/spice/src/csupport/mkprodct.csh create mode 100644 ext/spice/src/csupport/mspeld.c create mode 100644 ext/spice/src/csupport/ncodec.c create mode 100644 ext/spice/src/csupport/ncoded.c create mode 100644 ext/spice/src/csupport/ncodei.c create mode 100644 ext/spice/src/csupport/newfil.c create mode 100644 ext/spice/src/csupport/newfil_1.c create mode 100644 ext/spice/src/csupport/nicebt_1.c create mode 100644 ext/spice/src/csupport/niceio_3.c create mode 100644 ext/spice/src/csupport/nicepr_1.c create mode 100644 ext/spice/src/csupport/no.c create mode 100644 ext/spice/src/csupport/nspio.c create mode 100644 ext/spice/src/csupport/nsplgr.c create mode 100644 ext/spice/src/csupport/nspopl.c create mode 100644 ext/spice/src/csupport/nsppwd.c create mode 100644 ext/spice/src/csupport/nspsav.c create mode 100644 ext/spice/src/csupport/nspxcp.c create mode 100644 ext/spice/src/csupport/nthuqt.c create mode 100644 ext/spice/src/csupport/nthuqw.c create mode 100644 ext/spice/src/csupport/nxtcom.c create mode 100644 ext/spice/src/csupport/occurs.c create mode 100644 ext/spice/src/csupport/pagman.c create mode 100644 ext/spice/src/csupport/pltfrm.c create mode 100644 ext/spice/src/csupport/podaec.c create mode 100644 ext/spice/src/csupport/podaed.c create mode 100644 ext/spice/src/csupport/podaei.c create mode 100644 ext/spice/src/csupport/podbec.c create mode 100644 ext/spice/src/csupport/podbed.c create mode 100644 ext/spice/src/csupport/podbei.c create mode 100644 ext/spice/src/csupport/podbgc.c create mode 100644 ext/spice/src/csupport/podbgd.c create mode 100644 ext/spice/src/csupport/podbgi.c create mode 100644 ext/spice/src/csupport/podcgc.c create mode 100644 ext/spice/src/csupport/podcgd.c create mode 100644 ext/spice/src/csupport/podcgi.c create mode 100644 ext/spice/src/csupport/poddgc.c create mode 100644 ext/spice/src/csupport/poddgd.c create mode 100644 ext/spice/src/csupport/poddgi.c create mode 100644 ext/spice/src/csupport/podegc.c create mode 100644 ext/spice/src/csupport/podegd.c create mode 100644 ext/spice/src/csupport/podegi.c create mode 100644 ext/spice/src/csupport/podiec.c create mode 100644 ext/spice/src/csupport/podied.c create mode 100644 ext/spice/src/csupport/podiei.c create mode 100644 ext/spice/src/csupport/podonc.c create mode 100644 ext/spice/src/csupport/podond.c create mode 100644 ext/spice/src/csupport/podoni.c create mode 100644 ext/spice/src/csupport/podrec.c create mode 100644 ext/spice/src/csupport/podred.c create mode 100644 ext/spice/src/csupport/podrei.c create mode 100644 ext/spice/src/csupport/podrgc.c create mode 100644 ext/spice/src/csupport/podrgd.c create mode 100644 ext/spice/src/csupport/podrgi.c create mode 100644 ext/spice/src/csupport/prcomf.c create mode 100644 ext/spice/src/csupport/prepsn.c create mode 100644 ext/spice/src/csupport/prtrap.c create mode 100644 ext/spice/src/csupport/pstack.c create mode 100644 ext/spice/src/csupport/qlstnb.c create mode 100644 ext/spice/src/csupport/qmini.c create mode 100644 ext/spice/src/csupport/qrtrim.c create mode 100644 ext/spice/src/csupport/qtran.c create mode 100644 ext/spice/src/csupport/rdstmn.c create mode 100644 ext/spice/src/csupport/rdstmt.c create mode 100644 ext/spice/src/csupport/ressym.c create mode 100644 ext/spice/src/csupport/rptsym.c create mode 100644 ext/spice/src/csupport/sbget_1.c create mode 100644 ext/spice/src/csupport/sbinit_1.c create mode 100644 ext/spice/src/csupport/sbrem_1.c create mode 100644 ext/spice/src/csupport/sbset_1.c create mode 100644 ext/spice/src/csupport/scansl.c create mode 100644 ext/spice/src/csupport/shosym.c create mode 100644 ext/spice/src/csupport/signal1.h create mode 100644 ext/spice/src/csupport/sizecb_1.c create mode 100644 ext/spice/src/csupport/spcacb.c create mode 100644 ext/spice/src/csupport/stran.c create mode 100644 ext/spice/src/csupport/syptrc.c create mode 100644 ext/spice/src/csupport/syptri.c create mode 100644 ext/spice/src/csupport/tabrpt.c create mode 100644 ext/spice/src/csupport/trnlat.c create mode 100644 ext/spice/src/csupport/txtops.c create mode 100644 ext/spice/src/csupport/unitp.c create mode 100644 ext/spice/src/csupport/upto.c create mode 100644 ext/spice/src/csupport/utrans_2.c create mode 100644 ext/spice/src/csupport/zzalloc.h create mode 100644 ext/spice/src/csupport/zzckcvr2.c create mode 100644 ext/spice/src/csupport/zzckcvr3.c create mode 100644 ext/spice/src/csupport/zzckcvr4.c create mode 100644 ext/spice/src/csupport/zzckcvr5.c create mode 100644 ext/spice/src/csupport/zzerror.h create mode 100644 ext/spice/src/csupport/zzgetenv.c create mode 100644 ext/spice/src/csupport/zzgetfat.c create mode 100644 ext/spice/src/csupport/zznsppok.c create mode 100644 ext/spice/src/csupport/zztxtopn.c create mode 100644 modules/common/common.xml create mode 100644 modules/common/shaders/powerscale_fs.glsl create mode 100644 modules/common/shaders/powerscale_vs.glsl create mode 100644 modules/common/shaders/pscstandard_fs.glsl create mode 100644 modules/common/shaders/pscstandard_vs.glsl create mode 100644 src/CMakeLists.txt create mode 100644 src/camera.cpp create mode 100644 src/camera.h create mode 100644 src/deviceidentifier.cpp create mode 100644 src/deviceidentifier.h create mode 100644 src/externalcontrol/externalconnectioncontroller.cpp create mode 100644 src/externalcontrol/externalconnectioncontroller.h create mode 100644 src/externalcontrol/externalcontrol.cpp create mode 100644 src/externalcontrol/externalcontrol.h create mode 100644 src/externalcontrol/joystickexternalcontrol.cpp create mode 100644 src/externalcontrol/joystickexternalcontrol.cpp.orig create mode 100644 src/externalcontrol/joystickexternalcontrol.h create mode 100644 src/externalcontrol/keyboardexternalcontrol.cpp create mode 100644 src/externalcontrol/keyboardexternalcontrol.cpp.orig create mode 100644 src/externalcontrol/keyboardexternalcontrol.h create mode 100644 src/externalcontrol/mouseexternalcontrol.cpp create mode 100644 src/externalcontrol/mouseexternalcontrol.cpp.orig create mode 100644 src/externalcontrol/mouseexternalcontrol.h create mode 100644 src/externalcontrol/pythonexternalcontrol.cpp create mode 100644 src/externalcontrol/pythonexternalcontrol.h create mode 100644 src/externalcontrol/randomexternalcontrol.cpp create mode 100644 src/externalcontrol/randomexternalcontrol.h create mode 100644 src/interactionhandler.cpp create mode 100644 src/interactionhandler.h create mode 100644 src/main.cpp create mode 100644 src/object.cpp create mode 100644 src/object.h create mode 100644 src/renderable.cpp create mode 100644 src/renderable.h create mode 100644 src/renderablebody.cpp create mode 100644 src/renderablebody.h create mode 100644 src/renderableplanet.cpp create mode 100644 src/renderableplanet.h create mode 100644 src/renderengine.cpp create mode 100644 src/renderengine.h create mode 100644 src/scenegraph/scenegraph.cpp create mode 100644 src/scenegraph/scenegraph.h create mode 100644 src/scenegraph/scenegraphloader.cpp create mode 100644 src/scenegraph/scenegraphloader.h create mode 100644 src/scenegraph/scenegraphnode.cpp create mode 100644 src/scenegraph/scenegraphnode.h create mode 100644 src/util/geometry.cpp create mode 100644 src/util/geometry.h create mode 100644 src/util/planet.cpp create mode 100644 src/util/planet.h create mode 100644 src/util/psc.cpp create mode 100644 src/util/psc.h create mode 100644 src/util/pss.cpp create mode 100644 src/util/pss.h create mode 100644 src/util/sphere.cpp create mode 100644 src/util/sphere.h create mode 100644 src/util/spice.cpp create mode 100644 src/util/spice.h create mode 100644 src/util/time.cpp create mode 100644 src/util/time.h create mode 100644 src/util/vbo.cpp create mode 100644 src/util/vbo.h create mode 100644 src/util/vbo_template.h diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000000..e660fd93d3 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +bin/ diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000000..934139011e --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "ext/ghoul"] + path = ext/ghoul + url = git@openspace.itn.liu.se:ghoul diff --git a/CMakeLists.txt b/CMakeLists.txt new file mode 100644 index 0000000000..bb8a6ea6e2 --- /dev/null +++ b/CMakeLists.txt @@ -0,0 +1,106 @@ +######################################################################################### +# # +# OpenSpace # +# # +# Copyright (c) 2014 # +# # +# 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. # +######################################################################################### + + + +######################################################################################### +# General Settings +######################################################################################### + +cmake_minimum_required (VERSION 2.8) +project (OpenSpace) + +set(OPENSPACE_BASE_DIR "${PROJECT_SOURCE_DIR}") +set(OPENSPACE_EXT_DIR "${OPENSPACE_BASE_DIR}/ext") + +set(CMAKE_MODULE_PATH ${CMAKE_MODULE_PATH} ${OPENSPACE_EXT_DIR}) + +if (APPLE ) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -std=c++11 -stdlib=libc++") +endif () + +######################################################################################### +# External Third-party software +######################################################################################### + +# Ghoul +add_definitions(-DGHL_DEBUG) +set(GHOUL_ROOT_DIR "${OPENSPACE_EXT_DIR}/ghoul") +include_directories("${GHOUL_ROOT_DIR}/include") +add_subdirectory(${GHOUL_ROOT_DIR}) +set(DEPENDENT_LIBS ${DEPENDENT_LIBS} Ghoul) + +# SGCT (TODO: write cmake script) +#set(SGCT_ROOT_DIR "$ENV{SGCT_ROOT_DIR}") +#set(SGCT_ROOT_DIR "C:/Program Files/SGCT/SGCT_2.0.7") +set(SGCT_ROOT_DIR "C:/Program Files (x86)/SGCT/SGCT_2.0.5_x86") +add_definitions(-D__WIN32__) +include_directories("${SGCT_ROOT_DIR}/include") +set(DEPENDENT_LIBS + ${DEPENDENT_LIBS} + optimized "${SGCT_ROOT_DIR}/lib/msvc11/sgct.lib" + debug "${SGCT_ROOT_DIR}/lib/msvc11/sgctd.lib" + ) + +# GLM +set(GLM_ROOT_DIR "${GHOUL_ROOT_DIR}/ext/glm") +find_package(GLM REQUIRED) +include_directories(${GLM_INCLUDE_DIRS}) + +# OpenGL +#find_package(OpenGL REQUIRED) +#include_directories(${OPENGL_INCLUDE_DIRS}) +#set(DEPENDENT_LIBS ${DEPENDENT_LIBS} ${OPENGL_LIBRARIES}) + +# GLEW +#find_package(GLEW REQUIRED) +#include_directories(${GLEW_INCLUDE_DIRECTORIES}) +#set(DEPENDENT_LIBS ${DEPENDENT_LIBS} ${GLEW_LIBRARIES}) + +# Lua +set(LUA_ROOT_DIR "${OPENSPACE_EXT_DIR}/lua") +include_directories("${LUA_ROOT_DIR}/include") +add_subdirectory(${LUA_ROOT_DIR}) +set(DEPENDENT_LIBS ${DEPENDENT_LIBS} Lua) + +# Spice +set(SPICE_ROOT_DIR "${OPENSPACE_EXT_DIR}/spice") +include_directories("${SPICE_ROOT_DIR}/include") +add_subdirectory(${SPICE_ROOT_DIR}) +set(DEPENDENT_LIBS ${DEPENDENT_LIBS} Spice) + +if (APPLE) + include_directories(/Developer/Headers/FlatCarbon) + find_library(CARBON_LIBRARY Carbon) + find_library(COCOA_LIBRARY Carbon) + find_library(APP_SERVICES_LIBRARY ApplicationServices) + mark_as_advanced(CARBON_LIBRARY COCOA_LIBRARY APP_SERVICES_LIBRARY) + set(DEPENDENT_LIBS ${CARBON_LIBRARY} ${COCOA_LIBRARY} ${APP_SERVICES_LIBRARY}) +endif () + +######################################################################################### +# Executable +######################################################################################### + +add_subdirectory(src) diff --git a/CREDITS b/CREDITS new file mode 100644 index 0000000000..2b5a1ab56a --- /dev/null +++ b/CREDITS @@ -0,0 +1,3 @@ +Alexander Bock +Patric Ljung +Jonas Strandstedt \ No newline at end of file diff --git a/config/single.xml b/config/single.xml new file mode 100644 index 0000000000..23dfdfce66 --- /dev/null +++ b/config/single.xml @@ -0,0 +1,24 @@ + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/ext/ghoul b/ext/ghoul new file mode 160000 index 0000000000..874a5178a8 --- /dev/null +++ b/ext/ghoul @@ -0,0 +1 @@ +Subproject commit 874a5178a88a4bab12054e8968df07259c7149a8 diff --git a/ext/lua/CMakeLists.txt b/ext/lua/CMakeLists.txt new file mode 100644 index 0000000000..f608a0b4a0 --- /dev/null +++ b/ext/lua/CMakeLists.txt @@ -0,0 +1,86 @@ +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 new file mode 100644 index 0000000000..c7d34ad848 --- /dev/null +++ b/ext/lua/include/lapi.h @@ -0,0 +1,24 @@ +/* +** $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 new file mode 100644 index 0000000000..0fb023b8e7 --- /dev/null +++ b/ext/lua/include/lauxlib.h @@ -0,0 +1,212 @@ +/* +** $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 new file mode 100644 index 0000000000..6a1424cf5a --- /dev/null +++ b/ext/lua/include/lcode.h @@ -0,0 +1,83 @@ +/* +** $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 new file mode 100644 index 0000000000..b09b21a337 --- /dev/null +++ b/ext/lua/include/lctype.h @@ -0,0 +1,95 @@ +/* +** $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 new file mode 100644 index 0000000000..6445c763ea --- /dev/null +++ b/ext/lua/include/ldebug.h @@ -0,0 +1,34 @@ +/* +** $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 new file mode 100644 index 0000000000..d3d3082c9b --- /dev/null +++ b/ext/lua/include/ldo.h @@ -0,0 +1,46 @@ +/* +** $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 new file mode 100644 index 0000000000..ca0d3a3e0b --- /dev/null +++ b/ext/lua/include/lfunc.h @@ -0,0 +1,33 @@ +/* +** $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 new file mode 100644 index 0000000000..84bb1cdf99 --- /dev/null +++ b/ext/lua/include/lgc.h @@ -0,0 +1,157 @@ +/* +** $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 new file mode 100644 index 0000000000..a4acdd3021 --- /dev/null +++ b/ext/lua/include/llex.h @@ -0,0 +1,78 @@ +/* +** $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 new file mode 100644 index 0000000000..152dd05515 --- /dev/null +++ b/ext/lua/include/llimits.h @@ -0,0 +1,309 @@ +/* +** $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 new file mode 100644 index 0000000000..bd4f4e0726 --- /dev/null +++ b/ext/lua/include/lmem.h @@ -0,0 +1,57 @@ +/* +** $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 new file mode 100644 index 0000000000..3a630b944c --- /dev/null +++ b/ext/lua/include/lobject.h @@ -0,0 +1,607 @@ +/* +** $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 new file mode 100644 index 0000000000..51f5791545 --- /dev/null +++ b/ext/lua/include/lopcodes.h @@ -0,0 +1,288 @@ +/* +** $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 new file mode 100644 index 0000000000..0346e3c41a --- /dev/null +++ b/ext/lua/include/lparser.h @@ -0,0 +1,119 @@ +/* +** $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 new file mode 100644 index 0000000000..daffd9aacf --- /dev/null +++ b/ext/lua/include/lstate.h @@ -0,0 +1,228 @@ +/* +** $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 new file mode 100644 index 0000000000..260e7f169b --- /dev/null +++ b/ext/lua/include/lstring.h @@ -0,0 +1,46 @@ +/* +** $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 new file mode 100644 index 0000000000..d69449b2b8 --- /dev/null +++ b/ext/lua/include/ltable.h @@ -0,0 +1,45 @@ +/* +** $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 new file mode 100644 index 0000000000..7f89c841f9 --- /dev/null +++ b/ext/lua/include/ltm.h @@ -0,0 +1,57 @@ +/* +** $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 new file mode 100644 index 0000000000..149a2c37bc --- /dev/null +++ b/ext/lua/include/lua.h @@ -0,0 +1,444 @@ +/* +** $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 new file mode 100644 index 0000000000..ec417f5946 --- /dev/null +++ b/ext/lua/include/lua.hpp @@ -0,0 +1,9 @@ +// 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 new file mode 100644 index 0000000000..18be9a9e43 --- /dev/null +++ b/ext/lua/include/luaconf.h @@ -0,0 +1,551 @@ +/* +** $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 new file mode 100644 index 0000000000..da82005c9d --- /dev/null +++ b/ext/lua/include/lualib.h @@ -0,0 +1,55 @@ +/* +** $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 new file mode 100644 index 0000000000..5255db259d --- /dev/null +++ b/ext/lua/include/lundump.h @@ -0,0 +1,28 @@ +/* +** $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 new file mode 100644 index 0000000000..5380270da6 --- /dev/null +++ b/ext/lua/include/lvm.h @@ -0,0 +1,44 @@ +/* +** $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 new file mode 100644 index 0000000000..441f7479cb --- /dev/null +++ b/ext/lua/include/lzio.h @@ -0,0 +1,65 @@ +/* +** $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 new file mode 100644 index 0000000000..d011431ead --- /dev/null +++ b/ext/lua/src/lapi.c @@ -0,0 +1,1284 @@ +/* +** $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 new file mode 100644 index 0000000000..b00f8c7096 --- /dev/null +++ b/ext/lua/src/lauxlib.c @@ -0,0 +1,959 @@ +/* +** $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 new file mode 100644 index 0000000000..5255b3cd9b --- /dev/null +++ b/ext/lua/src/lbaselib.c @@ -0,0 +1,458 @@ +/* +** $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 new file mode 100644 index 0000000000..31c7b66f12 --- /dev/null +++ b/ext/lua/src/lbitlib.c @@ -0,0 +1,212 @@ +/* +** $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 new file mode 100644 index 0000000000..820b95c0e1 --- /dev/null +++ b/ext/lua/src/lcode.c @@ -0,0 +1,881 @@ +/* +** $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 new file mode 100644 index 0000000000..ce4f6ad42c --- /dev/null +++ b/ext/lua/src/lcorolib.c @@ -0,0 +1,155 @@ +/* +** $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 new file mode 100644 index 0000000000..93f8cadc39 --- /dev/null +++ b/ext/lua/src/lctype.c @@ -0,0 +1,52 @@ +/* +** $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 new file mode 100644 index 0000000000..84fe3c7d82 --- /dev/null +++ b/ext/lua/src/ldblib.c @@ -0,0 +1,398 @@ +/* +** $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 new file mode 100644 index 0000000000..20d663efff --- /dev/null +++ b/ext/lua/src/ldebug.c @@ -0,0 +1,593 @@ +/* +** $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 new file mode 100644 index 0000000000..e9dd5fa951 --- /dev/null +++ b/ext/lua/src/ldo.c @@ -0,0 +1,681 @@ +/* +** $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 new file mode 100644 index 0000000000..61fa2cd892 --- /dev/null +++ b/ext/lua/src/ldump.c @@ -0,0 +1,173 @@ +/* +** $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 new file mode 100644 index 0000000000..e90e1520ce --- /dev/null +++ b/ext/lua/src/lfunc.c @@ -0,0 +1,161 @@ +/* +** $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 new file mode 100644 index 0000000000..52460dcdd5 --- /dev/null +++ b/ext/lua/src/lgc.c @@ -0,0 +1,1220 @@ +/* +** $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 new file mode 100644 index 0000000000..c1a3830471 --- /dev/null +++ b/ext/lua/src/linit.c @@ -0,0 +1,67 @@ +/* +** $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 new file mode 100644 index 0000000000..2a4ec4aa34 --- /dev/null +++ b/ext/lua/src/liolib.c @@ -0,0 +1,666 @@ +/* +** $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 new file mode 100644 index 0000000000..c4b820e833 --- /dev/null +++ b/ext/lua/src/llex.c @@ -0,0 +1,530 @@ +/* +** $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 new file mode 100644 index 0000000000..fe9fc5423d --- /dev/null +++ b/ext/lua/src/lmathlib.c @@ -0,0 +1,279 @@ +/* +** $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 new file mode 100644 index 0000000000..ee343e3e03 --- /dev/null +++ b/ext/lua/src/lmem.c @@ -0,0 +1,99 @@ +/* +** $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 new file mode 100644 index 0000000000..bedbea3e9a --- /dev/null +++ b/ext/lua/src/loadlib.c @@ -0,0 +1,725 @@ +/* +** $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 new file mode 100644 index 0000000000..882d994d41 --- /dev/null +++ b/ext/lua/src/lobject.c @@ -0,0 +1,287 @@ +/* +** $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 new file mode 100644 index 0000000000..4190dc7624 --- /dev/null +++ b/ext/lua/src/lopcodes.c @@ -0,0 +1,107 @@ +/* +** $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 new file mode 100644 index 0000000000..052ba17441 --- /dev/null +++ b/ext/lua/src/loslib.c @@ -0,0 +1,323 @@ +/* +** $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 new file mode 100644 index 0000000000..9e1a9ca2cf --- /dev/null +++ b/ext/lua/src/lparser.c @@ -0,0 +1,1638 @@ +/* +** $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 new file mode 100644 index 0000000000..c7f2672be7 --- /dev/null +++ b/ext/lua/src/lstate.c @@ -0,0 +1,323 @@ +/* +** $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 new file mode 100644 index 0000000000..af96c89c18 --- /dev/null +++ b/ext/lua/src/lstring.c @@ -0,0 +1,185 @@ +/* +** $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 new file mode 100644 index 0000000000..9261fd220d --- /dev/null +++ b/ext/lua/src/lstrlib.c @@ -0,0 +1,1019 @@ +/* +** $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 new file mode 100644 index 0000000000..5d76f97ec3 --- /dev/null +++ b/ext/lua/src/ltable.c @@ -0,0 +1,588 @@ +/* +** $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 new file mode 100644 index 0000000000..6001224e39 --- /dev/null +++ b/ext/lua/src/ltablib.c @@ -0,0 +1,283 @@ +/* +** $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 new file mode 100644 index 0000000000..4163cb5d3b --- /dev/null +++ b/ext/lua/src/lundump.c @@ -0,0 +1,258 @@ +/* +** $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 new file mode 100644 index 0000000000..141b9fd19c --- /dev/null +++ b/ext/lua/src/lvm.c @@ -0,0 +1,867 @@ +/* +** $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 new file mode 100644 index 0000000000..20efea9830 --- /dev/null +++ b/ext/lua/src/lzio.c @@ -0,0 +1,76 @@ +/* +** $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/CMakeLists.txt b/ext/spice/CMakeLists.txt new file mode 100644 index 0000000000..1ef4c3a90a --- /dev/null +++ b/ext/spice/CMakeLists.txt @@ -0,0 +1,28 @@ +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 new file mode 100644 index 0000000000..894d4e9a6c --- /dev/null +++ b/ext/spice/include/SpiceCK.h @@ -0,0 +1,155 @@ +/* + +-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 new file mode 100644 index 0000000000..7b0537e9ee --- /dev/null +++ b/ext/spice/include/SpiceCel.h @@ -0,0 +1,441 @@ +/* + +-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 new file mode 100644 index 0000000000..cbe213fb01 --- /dev/null +++ b/ext/spice/include/SpiceEK.h @@ -0,0 +1,448 @@ +/* + +-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 new file mode 100644 index 0000000000..d0c123ab06 --- /dev/null +++ b/ext/spice/include/SpiceEll.h @@ -0,0 +1,115 @@ +/* + +-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 new file mode 100644 index 0000000000..14d10de2fd --- /dev/null +++ b/ext/spice/include/SpiceGF.h @@ -0,0 +1,319 @@ +/* + +-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 new file mode 100644 index 0000000000..839fb15606 --- /dev/null +++ b/ext/spice/include/SpicePln.h @@ -0,0 +1,106 @@ +/* + +-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 new file mode 100644 index 0000000000..a4c8eac5f7 --- /dev/null +++ b/ext/spice/include/SpiceSPK.h @@ -0,0 +1,128 @@ +/* + +-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 new file mode 100644 index 0000000000..83038e32a3 --- /dev/null +++ b/ext/spice/include/SpiceUsr.h @@ -0,0 +1,217 @@ +/* + +-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 new file mode 100644 index 0000000000..f838e7f31c --- /dev/null +++ b/ext/spice/include/SpiceZad.h @@ -0,0 +1,205 @@ +/* + +-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 new file mode 100644 index 0000000000..36276051d6 --- /dev/null +++ b/ext/spice/include/SpiceZdf.h @@ -0,0 +1,246 @@ +/* + +-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 new file mode 100644 index 0000000000..33f541770b --- /dev/null +++ b/ext/spice/include/SpiceZfc.h @@ -0,0 +1,13228 @@ +/* + +-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 new file mode 100644 index 0000000000..ee8d96ebc6 --- /dev/null +++ b/ext/spice/include/SpiceZim.h @@ -0,0 +1,1358 @@ +/* + +-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 new file mode 100644 index 0000000000..df694a602e --- /dev/null +++ b/ext/spice/include/SpiceZmc.h @@ -0,0 +1,975 @@ +/* + +-Disclaimer + + THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE + CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. + GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE + ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE + PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" + TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY + WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A + PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC + SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE + SOFTWARE AND RELATED MATERIALS, HOWEVER USED. + + IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA + BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT + LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, + INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, + REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE + REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. + + RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF + THE SOFTWARE AND ANY RELATED MATERIALS, 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 new file mode 100644 index 0000000000..1413202b69 --- /dev/null +++ b/ext/spice/include/SpiceZpl.h @@ -0,0 +1,109 @@ +/* + +-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 new file mode 100644 index 0000000000..b4d672e98c --- /dev/null +++ b/ext/spice/include/SpiceZpr.h @@ -0,0 +1,3853 @@ +/* + +-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 new file mode 100644 index 0000000000..ba48b16c1c --- /dev/null +++ b/ext/spice/include/SpiceZst.h @@ -0,0 +1,199 @@ +/* + +-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 new file mode 100644 index 0000000000..079fdaf490 --- /dev/null +++ b/ext/spice/include/f2c.h @@ -0,0 +1,654 @@ +/* + +-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 new file mode 100644 index 0000000000..f18fded688 --- /dev/null +++ b/ext/spice/include/f2cMang.h @@ -0,0 +1,390 @@ +/* + +-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 new file mode 100644 index 0000000000..bb20dd2ca0 --- /dev/null +++ b/ext/spice/include/fio.h @@ -0,0 +1,107 @@ +#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 new file mode 100644 index 0000000000..19065a2f04 --- /dev/null +++ b/ext/spice/include/fmt.h @@ -0,0 +1,100 @@ +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 new file mode 100644 index 0000000000..40743d79f7 --- /dev/null +++ b/ext/spice/include/fp.h @@ -0,0 +1,28 @@ +#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 new file mode 100644 index 0000000000..012317206a --- /dev/null +++ b/ext/spice/include/lio.h @@ -0,0 +1,74 @@ +/* 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 new file mode 100644 index 0000000000..fd36a48260 --- /dev/null +++ b/ext/spice/include/rawio.h @@ -0,0 +1,41 @@ +#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 new file mode 100644 index 0000000000..360d8d0118 --- /dev/null +++ b/ext/spice/include/signal1.h @@ -0,0 +1,118 @@ +/* + +-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 new file mode 100644 index 0000000000..572268c8eb --- /dev/null +++ b/ext/spice/include/zzalloc.h @@ -0,0 +1,125 @@ +/* + +-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 new file mode 100644 index 0000000000..5709c667d5 --- /dev/null +++ b/ext/spice/include/zzerror.h @@ -0,0 +1,80 @@ +/* + +-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 new file mode 100644 index 0000000000..e8ba7442f6 --- /dev/null +++ b/ext/spice/src/cspice/F77_aloc.c @@ -0,0 +1,32 @@ +#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 new file mode 100644 index 0000000000..894d4e9a6c --- /dev/null +++ b/ext/spice/src/cspice/SpiceCK.h @@ -0,0 +1,155 @@ +/* + +-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 new file mode 100644 index 0000000000..7b0537e9ee --- /dev/null +++ b/ext/spice/src/cspice/SpiceCel.h @@ -0,0 +1,441 @@ +/* + +-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 new file mode 100644 index 0000000000..cbe213fb01 --- /dev/null +++ b/ext/spice/src/cspice/SpiceEK.h @@ -0,0 +1,448 @@ +/* + +-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 new file mode 100644 index 0000000000..d0c123ab06 --- /dev/null +++ b/ext/spice/src/cspice/SpiceEll.h @@ -0,0 +1,115 @@ +/* + +-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 new file mode 100644 index 0000000000..14d10de2fd --- /dev/null +++ b/ext/spice/src/cspice/SpiceGF.h @@ -0,0 +1,319 @@ +/* + +-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 new file mode 100644 index 0000000000..839fb15606 --- /dev/null +++ b/ext/spice/src/cspice/SpicePln.h @@ -0,0 +1,106 @@ +/* + +-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 new file mode 100644 index 0000000000..a4c8eac5f7 --- /dev/null +++ b/ext/spice/src/cspice/SpiceSPK.h @@ -0,0 +1,128 @@ +/* + +-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 new file mode 100644 index 0000000000..83038e32a3 --- /dev/null +++ b/ext/spice/src/cspice/SpiceUsr.h @@ -0,0 +1,217 @@ +/* + +-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 new file mode 100644 index 0000000000..f838e7f31c --- /dev/null +++ b/ext/spice/src/cspice/SpiceZad.h @@ -0,0 +1,205 @@ +/* + +-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 new file mode 100644 index 0000000000..36276051d6 --- /dev/null +++ b/ext/spice/src/cspice/SpiceZdf.h @@ -0,0 +1,246 @@ +/* + +-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 new file mode 100644 index 0000000000..33f541770b --- /dev/null +++ b/ext/spice/src/cspice/SpiceZfc.h @@ -0,0 +1,13228 @@ +/* + +-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 new file mode 100644 index 0000000000..ee8d96ebc6 --- /dev/null +++ b/ext/spice/src/cspice/SpiceZim.h @@ -0,0 +1,1358 @@ +/* + +-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 new file mode 100644 index 0000000000..df694a602e --- /dev/null +++ b/ext/spice/src/cspice/SpiceZmc.h @@ -0,0 +1,975 @@ +/* + +-Disclaimer + + THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE + CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. + GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE + ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE + PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" + TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY + WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A + PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC + SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE + SOFTWARE AND RELATED MATERIALS, HOWEVER USED. + + IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA + BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT + LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, + INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, + REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE + REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. + + RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF + THE SOFTWARE AND ANY RELATED MATERIALS, 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 new file mode 100644 index 0000000000..1413202b69 --- /dev/null +++ b/ext/spice/src/cspice/SpiceZpl.h @@ -0,0 +1,109 @@ +/* + +-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 new file mode 100644 index 0000000000..b4d672e98c --- /dev/null +++ b/ext/spice/src/cspice/SpiceZpr.h @@ -0,0 +1,3853 @@ +/* + +-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 new file mode 100644 index 0000000000..ba48b16c1c --- /dev/null +++ b/ext/spice/src/cspice/SpiceZst.h @@ -0,0 +1,199 @@ +/* + +-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 new file mode 100644 index 0000000000..696af7681e --- /dev/null +++ b/ext/spice/src/cspice/abort_.c @@ -0,0 +1,32 @@ +/* + 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 new file mode 100644 index 0000000000..c4d5e213ec --- /dev/null +++ b/ext/spice/src/cspice/accept.c @@ -0,0 +1,318 @@ +/* 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 new file mode 100644 index 0000000000..3be7a41c82 --- /dev/null +++ b/ext/spice/src/cspice/alltru.c @@ -0,0 +1,154 @@ +/* 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 new file mode 100644 index 0000000000..e0fc337d81 --- /dev/null +++ b/ext/spice/src/cspice/ana.c @@ -0,0 +1,281 @@ +/* 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 new file mode 100644 index 0000000000..8189f275b7 --- /dev/null +++ b/ext/spice/src/cspice/appndc.c @@ -0,0 +1,188 @@ +/* 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 new file mode 100644 index 0000000000..2391fbcbcd --- /dev/null +++ b/ext/spice/src/cspice/appndc_c.c @@ -0,0 +1,286 @@ +/* + +-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 new file mode 100644 index 0000000000..acfd1c24f5 --- /dev/null +++ b/ext/spice/src/cspice/appndd.c @@ -0,0 +1,188 @@ +/* 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 new file mode 100644 index 0000000000..24406614ab --- /dev/null +++ b/ext/spice/src/cspice/appndd_c.c @@ -0,0 +1,216 @@ +/* + +-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 new file mode 100644 index 0000000000..86a4de460d --- /dev/null +++ b/ext/spice/src/cspice/appndi.c @@ -0,0 +1,186 @@ +/* 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 new file mode 100644 index 0000000000..c23b02869b --- /dev/null +++ b/ext/spice/src/cspice/appndi_c.c @@ -0,0 +1,218 @@ +/* + +-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 new file mode 100644 index 0000000000..d7d8835f53 --- /dev/null +++ b/ext/spice/src/cspice/approx.c @@ -0,0 +1,144 @@ +/* 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 new file mode 100644 index 0000000000..44f9f010c8 --- /dev/null +++ b/ext/spice/src/cspice/astrip.c @@ -0,0 +1,239 @@ +/* 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 new file mode 100644 index 0000000000..6debcf2310 --- /dev/null +++ b/ext/spice/src/cspice/axisar.c @@ -0,0 +1,255 @@ +/* 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 new file mode 100644 index 0000000000..11d5ced651 --- /dev/null +++ b/ext/spice/src/cspice/axisar_c.c @@ -0,0 +1,226 @@ +/* + +-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 new file mode 100644 index 0000000000..b216222b19 --- /dev/null +++ b/ext/spice/src/cspice/b1900.c @@ -0,0 +1,126 @@ +/* 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 new file mode 100644 index 0000000000..b2d07a6799 --- /dev/null +++ b/ext/spice/src/cspice/b1900_c.c @@ -0,0 +1,136 @@ +/* + +-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 new file mode 100644 index 0000000000..5799defd51 --- /dev/null +++ b/ext/spice/src/cspice/b1950.c @@ -0,0 +1,144 @@ +/* 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 new file mode 100644 index 0000000000..18bbdee79f --- /dev/null +++ b/ext/spice/src/cspice/b1950_c.c @@ -0,0 +1,154 @@ +/* + +-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 new file mode 100644 index 0000000000..c3fa545df2 --- /dev/null +++ b/ext/spice/src/cspice/backspace.c @@ -0,0 +1,69 @@ +#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 new file mode 100644 index 0000000000..59b0ce5c99 --- /dev/null +++ b/ext/spice/src/cspice/badkpv.c @@ -0,0 +1,393 @@ +/* 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 new file mode 100644 index 0000000000..3e79d0061c --- /dev/null +++ b/ext/spice/src/cspice/badkpv_c.c @@ -0,0 +1,281 @@ +/* + +-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 new file mode 100644 index 0000000000..9f265757a4 --- /dev/null +++ b/ext/spice/src/cspice/bedec.c @@ -0,0 +1,278 @@ +/* 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 new file mode 100644 index 0000000000..716ccbf05d --- /dev/null +++ b/ext/spice/src/cspice/beint.c @@ -0,0 +1,227 @@ +/* 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 new file mode 100644 index 0000000000..fb84a2edc8 --- /dev/null +++ b/ext/spice/src/cspice/benum.c @@ -0,0 +1,214 @@ +/* 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 new file mode 100644 index 0000000000..7becf11e7d --- /dev/null +++ b/ext/spice/src/cspice/beuns.c @@ -0,0 +1,225 @@ +/* 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 new file mode 100644 index 0000000000..adedb99a7f --- /dev/null +++ b/ext/spice/src/cspice/bodc2n.c @@ -0,0 +1,265 @@ +/* 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 new file mode 100644 index 0000000000..2df87d7954 --- /dev/null +++ b/ext/spice/src/cspice/bodc2n_c.c @@ -0,0 +1,313 @@ +/* + +-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 new file mode 100644 index 0000000000..0a0fbef4fe --- /dev/null +++ b/ext/spice/src/cspice/bodc2s.c @@ -0,0 +1,249 @@ +/* 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 new file mode 100644 index 0000000000..009e5b45cf --- /dev/null +++ b/ext/spice/src/cspice/bodc2s_c.c @@ -0,0 +1,262 @@ +/* + +-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 new file mode 100644 index 0000000000..1c9e23d26e --- /dev/null +++ b/ext/spice/src/cspice/boddef.c @@ -0,0 +1,301 @@ +/* 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 new file mode 100644 index 0000000000..6f0f7f2592 --- /dev/null +++ b/ext/spice/src/cspice/boddef_c.c @@ -0,0 +1,319 @@ +/* + +-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 new file mode 100644 index 0000000000..c19acbc2c9 --- /dev/null +++ b/ext/spice/src/cspice/bodeul.c @@ -0,0 +1,622 @@ +/* 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 new file mode 100644 index 0000000000..44eb790734 --- /dev/null +++ b/ext/spice/src/cspice/bodfnd.c @@ -0,0 +1,214 @@ +/* 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 new file mode 100644 index 0000000000..821b821b2f --- /dev/null +++ b/ext/spice/src/cspice/bodfnd_c.c @@ -0,0 +1,210 @@ +/* + +-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 new file mode 100644 index 0000000000..f7f8283975 --- /dev/null +++ b/ext/spice/src/cspice/bodmat.c @@ -0,0 +1,842 @@ +/* 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 new file mode 100644 index 0000000000..feddd7b949 --- /dev/null +++ b/ext/spice/src/cspice/bodn2c.c @@ -0,0 +1,286 @@ +/* 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 new file mode 100644 index 0000000000..97b98de4f2 --- /dev/null +++ b/ext/spice/src/cspice/bodn2c_c.c @@ -0,0 +1,317 @@ +/* + +-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 new file mode 100644 index 0000000000..f92e91a0e7 --- /dev/null +++ b/ext/spice/src/cspice/bods2c.c @@ -0,0 +1,311 @@ +/* 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 new file mode 100644 index 0000000000..a49ee7eac2 --- /dev/null +++ b/ext/spice/src/cspice/bods2c_c.c @@ -0,0 +1,296 @@ +/* + +-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 new file mode 100644 index 0000000000..a6e73e9db3 --- /dev/null +++ b/ext/spice/src/cspice/bodvar.c @@ -0,0 +1,216 @@ +/* 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 new file mode 100644 index 0000000000..7734840448 --- /dev/null +++ b/ext/spice/src/cspice/bodvar_c.c @@ -0,0 +1,209 @@ +/* + +-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 new file mode 100644 index 0000000000..340388c766 --- /dev/null +++ b/ext/spice/src/cspice/bodvcd.c @@ -0,0 +1,314 @@ +/* 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 new file mode 100644 index 0000000000..7b0ed7fd2d --- /dev/null +++ b/ext/spice/src/cspice/bodvcd_c.c @@ -0,0 +1,270 @@ +/* + +-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 new file mode 100644 index 0000000000..593b6c6853 --- /dev/null +++ b/ext/spice/src/cspice/bodvrd.c @@ -0,0 +1,368 @@ +/* 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 new file mode 100644 index 0000000000..4aa101c71c --- /dev/null +++ b/ext/spice/src/cspice/bodvrd_c.c @@ -0,0 +1,299 @@ +/* + +-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 new file mode 100644 index 0000000000..77fadb34a5 --- /dev/null +++ b/ext/spice/src/cspice/brcktd.c @@ -0,0 +1,174 @@ +/* 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 new file mode 100644 index 0000000000..8fade57214 --- /dev/null +++ b/ext/spice/src/cspice/brcktd_c.c @@ -0,0 +1,183 @@ +/* + +-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 new file mode 100644 index 0000000000..493577093c --- /dev/null +++ b/ext/spice/src/cspice/brckti.c @@ -0,0 +1,174 @@ +/* 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 new file mode 100644 index 0000000000..1f8c49dca4 --- /dev/null +++ b/ext/spice/src/cspice/brckti_c.c @@ -0,0 +1,183 @@ +/* + +-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 new file mode 100644 index 0000000000..488814f9c3 --- /dev/null +++ b/ext/spice/src/cspice/bschoc.c @@ -0,0 +1,205 @@ +/* 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 new file mode 100644 index 0000000000..11a97bd3a6 --- /dev/null +++ b/ext/spice/src/cspice/bschoc_c.c @@ -0,0 +1,317 @@ +/* + +-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 new file mode 100644 index 0000000000..343b5dd361 --- /dev/null +++ b/ext/spice/src/cspice/bschoi.c @@ -0,0 +1,196 @@ +/* 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 new file mode 100644 index 0000000000..f9b2a8e770 --- /dev/null +++ b/ext/spice/src/cspice/bschoi_c.c @@ -0,0 +1,231 @@ +/* + +-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 new file mode 100644 index 0000000000..52a2551ac6 --- /dev/null +++ b/ext/spice/src/cspice/bsrchc.c @@ -0,0 +1,201 @@ +/* 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 new file mode 100644 index 0000000000..85c3190079 --- /dev/null +++ b/ext/spice/src/cspice/bsrchc_c.c @@ -0,0 +1,304 @@ +/* + +-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 new file mode 100644 index 0000000000..ab49100def --- /dev/null +++ b/ext/spice/src/cspice/bsrchd.c @@ -0,0 +1,189 @@ +/* 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 new file mode 100644 index 0000000000..9eae844349 --- /dev/null +++ b/ext/spice/src/cspice/bsrchd_c.c @@ -0,0 +1,161 @@ +/* + +-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 new file mode 100644 index 0000000000..121aea0f9f --- /dev/null +++ b/ext/spice/src/cspice/bsrchi.c @@ -0,0 +1,189 @@ +/* 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 new file mode 100644 index 0000000000..d93eb44c38 --- /dev/null +++ b/ext/spice/src/cspice/bsrchi_c.c @@ -0,0 +1,160 @@ +/* + +-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 new file mode 100644 index 0000000000..43e1b90d6a --- /dev/null +++ b/ext/spice/src/cspice/byebye.c @@ -0,0 +1,170 @@ +/* + +-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 new file mode 100644 index 0000000000..041fbd3d8b --- /dev/null +++ b/ext/spice/src/cspice/c_abs.c @@ -0,0 +1,14 @@ +#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 new file mode 100644 index 0000000000..4aea0c3cf6 --- /dev/null +++ b/ext/spice/src/cspice/c_cos.c @@ -0,0 +1,17 @@ +#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 new file mode 100644 index 0000000000..ac963079ba --- /dev/null +++ b/ext/spice/src/cspice/c_div.c @@ -0,0 +1,37 @@ +#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 new file mode 100644 index 0000000000..8252c7f701 --- /dev/null +++ b/ext/spice/src/cspice/c_exp.c @@ -0,0 +1,19 @@ +#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 new file mode 100644 index 0000000000..6ac990ca26 --- /dev/null +++ b/ext/spice/src/cspice/c_log.c @@ -0,0 +1,17 @@ +#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 new file mode 100644 index 0000000000..15acccc59a --- /dev/null +++ b/ext/spice/src/cspice/c_sin.c @@ -0,0 +1,17 @@ +#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 new file mode 100644 index 0000000000..8481ee4857 --- /dev/null +++ b/ext/spice/src/cspice/c_sqrt.c @@ -0,0 +1,35 @@ +#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 new file mode 100644 index 0000000000..0487277de7 --- /dev/null +++ b/ext/spice/src/cspice/cabs.c @@ -0,0 +1,103 @@ +/* + +-Disclaimer + + THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE + CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. + GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE + ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE + PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" + TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY + WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A + PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC + SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE + SOFTWARE AND RELATED MATERIALS, HOWEVER USED. + + IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA + BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT + LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, + INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, + REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE + REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. + + RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF + THE SOFTWARE AND ANY RELATED MATERIALS, 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 new file mode 100644 index 0000000000..cc2a27c54d --- /dev/null +++ b/ext/spice/src/cspice/card_c.c @@ -0,0 +1,228 @@ +/* + +-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 new file mode 100644 index 0000000000..5b73712b5c --- /dev/null +++ b/ext/spice/src/cspice/cardc.c @@ -0,0 +1,225 @@ +/* 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 new file mode 100644 index 0000000000..5e276ba0b5 --- /dev/null +++ b/ext/spice/src/cspice/cardd.c @@ -0,0 +1,223 @@ +/* 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 new file mode 100644 index 0000000000..15bc9a8b77 --- /dev/null +++ b/ext/spice/src/cspice/cardi.c @@ -0,0 +1,218 @@ +/* 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 new file mode 100644 index 0000000000..b0dec4481b --- /dev/null +++ b/ext/spice/src/cspice/cgv2el.c @@ -0,0 +1,194 @@ +/* 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 new file mode 100644 index 0000000000..c92869f149 --- /dev/null +++ b/ext/spice/src/cspice/cgv2el_c.c @@ -0,0 +1,179 @@ +/* + +-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 new file mode 100644 index 0000000000..9c0d125254 --- /dev/null +++ b/ext/spice/src/cspice/chbase.c @@ -0,0 +1,401 @@ +/* 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 new file mode 100644 index 0000000000..2fc07abf9d --- /dev/null +++ b/ext/spice/src/cspice/chbder.c @@ -0,0 +1,389 @@ +/* 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 new file mode 100644 index 0000000000..0895394abd --- /dev/null +++ b/ext/spice/src/cspice/chbint.c @@ -0,0 +1,315 @@ +/* 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 new file mode 100644 index 0000000000..a16b684dc3 --- /dev/null +++ b/ext/spice/src/cspice/chbval.c @@ -0,0 +1,285 @@ +/* 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 new file mode 100644 index 0000000000..841c5645dd --- /dev/null +++ b/ext/spice/src/cspice/chckid.c @@ -0,0 +1,276 @@ +/* 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 new file mode 100644 index 0000000000..3de395f92f --- /dev/null +++ b/ext/spice/src/cspice/chgirf.c @@ -0,0 +1,1601 @@ +/* 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 new file mode 100644 index 0000000000..7589a27df6 --- /dev/null +++ b/ext/spice/src/cspice/chkin_c.c @@ -0,0 +1,218 @@ +/* + +-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 new file mode 100644 index 0000000000..275eeacab4 --- /dev/null +++ b/ext/spice/src/cspice/chkout_c.c @@ -0,0 +1,215 @@ +/* + +-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 new file mode 100644 index 0000000000..cb635acdf9 --- /dev/null +++ b/ext/spice/src/cspice/cidfrm_c.c @@ -0,0 +1,216 @@ +/* + +-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 new file mode 100644 index 0000000000..a4b8e1aa04 --- /dev/null +++ b/ext/spice/src/cspice/ckbsr.c @@ -0,0 +1,4222 @@ +/* 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 new file mode 100644 index 0000000000..73af55223d --- /dev/null +++ b/ext/spice/src/cspice/ckcls.c @@ -0,0 +1,209 @@ +/* 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 new file mode 100644 index 0000000000..e0b81d3c7c --- /dev/null +++ b/ext/spice/src/cspice/ckcls_c.c @@ -0,0 +1,148 @@ +/* + +-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 new file mode 100644 index 0000000000..effdacbd71 --- /dev/null +++ b/ext/spice/src/cspice/ckcov.c @@ -0,0 +1,902 @@ +/* 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 new file mode 100644 index 0000000000..62c260009a --- /dev/null +++ b/ext/spice/src/cspice/ckcov_c.c @@ -0,0 +1,648 @@ +/* + +-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 new file mode 100644 index 0000000000..3c4d59df2d --- /dev/null +++ b/ext/spice/src/cspice/cke01.c @@ -0,0 +1,387 @@ +/* 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 new file mode 100644 index 0000000000..902a557e44 --- /dev/null +++ b/ext/spice/src/cspice/cke02.c @@ -0,0 +1,389 @@ +/* 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 new file mode 100644 index 0000000000..3fd51057f8 --- /dev/null +++ b/ext/spice/src/cspice/cke03.c @@ -0,0 +1,545 @@ +/* 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 new file mode 100644 index 0000000000..158f849661 --- /dev/null +++ b/ext/spice/src/cspice/cke04.c @@ -0,0 +1,566 @@ +/* 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 new file mode 100644 index 0000000000..a344f20314 --- /dev/null +++ b/ext/spice/src/cspice/cke05.c @@ -0,0 +1,1067 @@ +/* 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 new file mode 100644 index 0000000000..8a9efdd619 --- /dev/null +++ b/ext/spice/src/cspice/ckfrot.c @@ -0,0 +1,290 @@ +/* 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 new file mode 100644 index 0000000000..280155baac --- /dev/null +++ b/ext/spice/src/cspice/ckfxfm.c @@ -0,0 +1,351 @@ +/* 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 new file mode 100644 index 0000000000..a1c684182e --- /dev/null +++ b/ext/spice/src/cspice/ckgp.c @@ -0,0 +1,1026 @@ +/* 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 new file mode 100644 index 0000000000..24f984644f --- /dev/null +++ b/ext/spice/src/cspice/ckgp_c.c @@ -0,0 +1,721 @@ +/* + +-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 new file mode 100644 index 0000000000..1ee8790c58 --- /dev/null +++ b/ext/spice/src/cspice/ckgpav.c @@ -0,0 +1,1208 @@ +/* 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 new file mode 100644 index 0000000000..e910b10d30 --- /dev/null +++ b/ext/spice/src/cspice/ckgpav_c.c @@ -0,0 +1,759 @@ +/* + +-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 new file mode 100644 index 0000000000..955b7bb7f4 --- /dev/null +++ b/ext/spice/src/cspice/ckgr01.c @@ -0,0 +1,403 @@ +/* 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 new file mode 100644 index 0000000000..13c1a4f01d --- /dev/null +++ b/ext/spice/src/cspice/ckgr02.c @@ -0,0 +1,359 @@ +/* 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 new file mode 100644 index 0000000000..3dec38db8c --- /dev/null +++ b/ext/spice/src/cspice/ckgr03.c @@ -0,0 +1,396 @@ +/* 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 new file mode 100644 index 0000000000..2c3941cd79 --- /dev/null +++ b/ext/spice/src/cspice/ckgr04.c @@ -0,0 +1,534 @@ +/* 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 new file mode 100644 index 0000000000..f9109130ae --- /dev/null +++ b/ext/spice/src/cspice/ckgr05.c @@ -0,0 +1,521 @@ +/* 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 new file mode 100644 index 0000000000..136aa36826 --- /dev/null +++ b/ext/spice/src/cspice/cklpf_c.c @@ -0,0 +1,190 @@ +/* + +-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 new file mode 100644 index 0000000000..b9fd3c6018 --- /dev/null +++ b/ext/spice/src/cspice/ckmeta.c @@ -0,0 +1,419 @@ +/* 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 new file mode 100644 index 0000000000..ca5e41af04 --- /dev/null +++ b/ext/spice/src/cspice/cknr01.c @@ -0,0 +1,325 @@ +/* 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 new file mode 100644 index 0000000000..3bb6b025db --- /dev/null +++ b/ext/spice/src/cspice/cknr02.c @@ -0,0 +1,318 @@ +/* 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 new file mode 100644 index 0000000000..e0b9854d8e --- /dev/null +++ b/ext/spice/src/cspice/cknr03.c @@ -0,0 +1,324 @@ +/* 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 new file mode 100644 index 0000000000..e302f0b187 --- /dev/null +++ b/ext/spice/src/cspice/cknr04.c @@ -0,0 +1,433 @@ +/* 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 new file mode 100644 index 0000000000..1f948c88fe --- /dev/null +++ b/ext/spice/src/cspice/cknr05.c @@ -0,0 +1,304 @@ +/* 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 new file mode 100644 index 0000000000..6e8a7d1794 --- /dev/null +++ b/ext/spice/src/cspice/ckobj.c @@ -0,0 +1,433 @@ +/* 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 new file mode 100644 index 0000000000..6f27bc9fa8 --- /dev/null +++ b/ext/spice/src/cspice/ckobj_c.c @@ -0,0 +1,348 @@ +/* + +-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 new file mode 100644 index 0000000000..bcc23e7f41 --- /dev/null +++ b/ext/spice/src/cspice/ckopn.c @@ -0,0 +1,212 @@ +/* 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 new file mode 100644 index 0000000000..177eaab68b --- /dev/null +++ b/ext/spice/src/cspice/ckopn_c.c @@ -0,0 +1,194 @@ +/* + +-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 new file mode 100644 index 0000000000..24cf5c9242 --- /dev/null +++ b/ext/spice/src/cspice/ckpfs.c @@ -0,0 +1,622 @@ +/* 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 new file mode 100644 index 0000000000..fc54944c82 --- /dev/null +++ b/ext/spice/src/cspice/ckr01.c @@ -0,0 +1,602 @@ +/* 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 new file mode 100644 index 0000000000..9884f41f10 --- /dev/null +++ b/ext/spice/src/cspice/ckr02.c @@ -0,0 +1,659 @@ +/* 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 new file mode 100644 index 0000000000..6b8a4c3cb7 --- /dev/null +++ b/ext/spice/src/cspice/ckr03.c @@ -0,0 +1,995 @@ +/* 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 new file mode 100644 index 0000000000..9093a2f8b3 --- /dev/null +++ b/ext/spice/src/cspice/ckr04.c @@ -0,0 +1,783 @@ +/* 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 new file mode 100644 index 0000000000..e0213a6c76 --- /dev/null +++ b/ext/spice/src/cspice/ckr05.c @@ -0,0 +1,1251 @@ +/* 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 new file mode 100644 index 0000000000..b4f9ca2781 --- /dev/null +++ b/ext/spice/src/cspice/ckupf_c.c @@ -0,0 +1,146 @@ +/* + +-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 new file mode 100644 index 0000000000..d38db86374 --- /dev/null +++ b/ext/spice/src/cspice/ckw01.c @@ -0,0 +1,772 @@ +/* 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 new file mode 100644 index 0000000000..e3f7902fcc --- /dev/null +++ b/ext/spice/src/cspice/ckw01_c.c @@ -0,0 +1,546 @@ +/* + +-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 new file mode 100644 index 0000000000..599f893770 --- /dev/null +++ b/ext/spice/src/cspice/ckw02.c @@ -0,0 +1,839 @@ +/* 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 new file mode 100644 index 0000000000..d3a8e967d8 --- /dev/null +++ b/ext/spice/src/cspice/ckw02_c.c @@ -0,0 +1,544 @@ +/* + +-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 new file mode 100644 index 0000000000..80f61f73b8 --- /dev/null +++ b/ext/spice/src/cspice/ckw03.c @@ -0,0 +1,951 @@ +/* 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 new file mode 100644 index 0000000000..9e6e9b82f5 --- /dev/null +++ b/ext/spice/src/cspice/ckw03_c.c @@ -0,0 +1,667 @@ +/* + +-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 new file mode 100644 index 0000000000..d4fcb40f98 --- /dev/null +++ b/ext/spice/src/cspice/ckw04a.c @@ -0,0 +1,764 @@ +/* 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 new file mode 100644 index 0000000000..43e16666f7 --- /dev/null +++ b/ext/spice/src/cspice/ckw04b.c @@ -0,0 +1,948 @@ +/* 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 new file mode 100644 index 0000000000..e709619d61 --- /dev/null +++ b/ext/spice/src/cspice/ckw04e.c @@ -0,0 +1,328 @@ +/* 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 new file mode 100644 index 0000000000..f0ff062697 --- /dev/null +++ b/ext/spice/src/cspice/ckw05.c @@ -0,0 +1,1112 @@ +/* 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 new file mode 100644 index 0000000000..b691a5c294 --- /dev/null +++ b/ext/spice/src/cspice/ckw05_c.c @@ -0,0 +1,701 @@ +/* + +-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 new file mode 100644 index 0000000000..5acab4bf2d --- /dev/null +++ b/ext/spice/src/cspice/clearc.c @@ -0,0 +1,139 @@ +/* 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 new file mode 100644 index 0000000000..68ea17050b --- /dev/null +++ b/ext/spice/src/cspice/cleard.c @@ -0,0 +1,136 @@ +/* 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 new file mode 100644 index 0000000000..876d817c14 --- /dev/null +++ b/ext/spice/src/cspice/cleari.c @@ -0,0 +1,136 @@ +/* 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 new file mode 100644 index 0000000000..c1ba4675d7 --- /dev/null +++ b/ext/spice/src/cspice/clight.c @@ -0,0 +1,156 @@ +/* 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 new file mode 100644 index 0000000000..606c679d9e --- /dev/null +++ b/ext/spice/src/cspice/clight_c.c @@ -0,0 +1,146 @@ +/* + +-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 new file mode 100644 index 0000000000..58100593f7 --- /dev/null +++ b/ext/spice/src/cspice/close.c @@ -0,0 +1,94 @@ +#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 new file mode 100644 index 0000000000..1505d16b4a --- /dev/null +++ b/ext/spice/src/cspice/conics.c @@ -0,0 +1,436 @@ +/* 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 new file mode 100644 index 0000000000..bd72da8ed4 --- /dev/null +++ b/ext/spice/src/cspice/conics_c.c @@ -0,0 +1,203 @@ +/* + +-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 new file mode 100644 index 0000000000..d648c96cb7 --- /dev/null +++ b/ext/spice/src/cspice/convrt.c @@ -0,0 +1,414 @@ +/* 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 new file mode 100644 index 0000000000..ebf49f773c --- /dev/null +++ b/ext/spice/src/cspice/convrt_c.c @@ -0,0 +1,248 @@ +/* + +-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 new file mode 100644 index 0000000000..9c7590b0a9 --- /dev/null +++ b/ext/spice/src/cspice/copy_c.c @@ -0,0 +1,272 @@ +/* + +-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 new file mode 100644 index 0000000000..408f95d2b8 --- /dev/null +++ b/ext/spice/src/cspice/copyc.c @@ -0,0 +1,263 @@ +/* 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 new file mode 100644 index 0000000000..3962a35bdd --- /dev/null +++ b/ext/spice/src/cspice/copyd.c @@ -0,0 +1,199 @@ +/* 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 new file mode 100644 index 0000000000..9e3b887ffe --- /dev/null +++ b/ext/spice/src/cspice/copyi.c @@ -0,0 +1,200 @@ +/* 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 new file mode 100644 index 0000000000..a64578ba5f --- /dev/null +++ b/ext/spice/src/cspice/countc.c @@ -0,0 +1,319 @@ +/* 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 new file mode 100644 index 0000000000..e9544cb46a --- /dev/null +++ b/ext/spice/src/cspice/cpos.c @@ -0,0 +1,226 @@ +/* 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 new file mode 100644 index 0000000000..5786ab7818 --- /dev/null +++ b/ext/spice/src/cspice/cpos_c.c @@ -0,0 +1,226 @@ +/* + +-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 new file mode 100644 index 0000000000..64d8e32af2 --- /dev/null +++ b/ext/spice/src/cspice/cposr.c @@ -0,0 +1,234 @@ +/* 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 new file mode 100644 index 0000000000..ad7a9f4ed9 --- /dev/null +++ b/ext/spice/src/cspice/cposr_c.c @@ -0,0 +1,230 @@ +/* + +-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 new file mode 100644 index 0000000000..031dbc6832 --- /dev/null +++ b/ext/spice/src/cspice/cvpool_c.c @@ -0,0 +1,245 @@ +/* + +-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 new file mode 100644 index 0000000000..72cfd0a93d --- /dev/null +++ b/ext/spice/src/cspice/cyacip.c @@ -0,0 +1,286 @@ +/* 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 new file mode 100644 index 0000000000..095a05b7c0 --- /dev/null +++ b/ext/spice/src/cspice/cyadip.c @@ -0,0 +1,239 @@ +/* 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 new file mode 100644 index 0000000000..a1cfd969ea --- /dev/null +++ b/ext/spice/src/cspice/cyaiip.c @@ -0,0 +1,238 @@ +/* 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 new file mode 100644 index 0000000000..0c10a73936 --- /dev/null +++ b/ext/spice/src/cspice/cyclac.c @@ -0,0 +1,322 @@ +/* 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 new file mode 100644 index 0000000000..45a1494d5d --- /dev/null +++ b/ext/spice/src/cspice/cyclad.c @@ -0,0 +1,267 @@ +/* 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 new file mode 100644 index 0000000000..7b2609342a --- /dev/null +++ b/ext/spice/src/cspice/cyclai.c @@ -0,0 +1,265 @@ +/* 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 new file mode 100644 index 0000000000..b41f973d80 --- /dev/null +++ b/ext/spice/src/cspice/cyclec.c @@ -0,0 +1,325 @@ +/* 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 new file mode 100644 index 0000000000..4fac081cd7 --- /dev/null +++ b/ext/spice/src/cspice/cyllat.c @@ -0,0 +1,206 @@ +/* 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 new file mode 100644 index 0000000000..9f9ad2113f --- /dev/null +++ b/ext/spice/src/cspice/cyllat_c.c @@ -0,0 +1,211 @@ +/* + +-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 new file mode 100644 index 0000000000..3ef7605691 --- /dev/null +++ b/ext/spice/src/cspice/cylrec.c @@ -0,0 +1,183 @@ +/* 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 new file mode 100644 index 0000000000..c22a66719b --- /dev/null +++ b/ext/spice/src/cspice/cylrec_c.c @@ -0,0 +1,182 @@ +/* + +-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 new file mode 100644 index 0000000000..bf84cfeca4 --- /dev/null +++ b/ext/spice/src/cspice/cylsph.c @@ -0,0 +1,190 @@ +/* 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 new file mode 100644 index 0000000000..86e9c4afb2 --- /dev/null +++ b/ext/spice/src/cspice/cylsph_c.c @@ -0,0 +1,197 @@ +/* + +-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 new file mode 100644 index 0000000000..cb157e067b --- /dev/null +++ b/ext/spice/src/cspice/d_abs.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..ecb56e87f5 --- /dev/null +++ b/ext/spice/src/cspice/d_acos.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..045e73301c --- /dev/null +++ b/ext/spice/src/cspice/d_asin.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..03530a1857 --- /dev/null +++ b/ext/spice/src/cspice/d_atan.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..7c25ac0460 --- /dev/null +++ b/ext/spice/src/cspice/d_atn2.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..c778c38758 --- /dev/null +++ b/ext/spice/src/cspice/d_cnjg.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..45c4838bae --- /dev/null +++ b/ext/spice/src/cspice/d_cos.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..1181833cc1 --- /dev/null +++ b/ext/spice/src/cspice/d_cosh.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..1d0ecb7bbb --- /dev/null +++ b/ext/spice/src/cspice/d_dim.c @@ -0,0 +1,10 @@ +#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 new file mode 100644 index 0000000000..3f2b6ffcc4 --- /dev/null +++ b/ext/spice/src/cspice/d_exp.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..793a3f9c40 --- /dev/null +++ b/ext/spice/src/cspice/d_imag.c @@ -0,0 +1,10 @@ +#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 new file mode 100644 index 0000000000..6c0e64215d --- /dev/null +++ b/ext/spice/src/cspice/d_int.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..f03ff0043f --- /dev/null +++ b/ext/spice/src/cspice/d_lg10.c @@ -0,0 +1,15 @@ +#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 new file mode 100644 index 0000000000..d7a1941d56 --- /dev/null +++ b/ext/spice/src/cspice/d_log.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..0d3ffbff9e --- /dev/null +++ b/ext/spice/src/cspice/d_mod.c @@ -0,0 +1,40 @@ +#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 new file mode 100644 index 0000000000..2ead3df200 --- /dev/null +++ b/ext/spice/src/cspice/d_nint.c @@ -0,0 +1,14 @@ +#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 new file mode 100644 index 0000000000..3d4cef7835 --- /dev/null +++ b/ext/spice/src/cspice/d_prod.c @@ -0,0 +1,10 @@ +#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 new file mode 100644 index 0000000000..514ff0bbff --- /dev/null +++ b/ext/spice/src/cspice/d_sign.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..0013af0349 --- /dev/null +++ b/ext/spice/src/cspice/d_sin.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..1ccd02ead9 --- /dev/null +++ b/ext/spice/src/cspice/d_sinh.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..bee10a3a55 --- /dev/null +++ b/ext/spice/src/cspice/d_sqrt.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..23fa423188 --- /dev/null +++ b/ext/spice/src/cspice/d_tan.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..0363a49b1b --- /dev/null +++ b/ext/spice/src/cspice/d_tanh.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..8af1b8f926 --- /dev/null +++ b/ext/spice/src/cspice/dacosh.c @@ -0,0 +1,178 @@ +/* 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 new file mode 100644 index 0000000000..3a6a51974e --- /dev/null +++ b/ext/spice/src/cspice/dacosn.c @@ -0,0 +1,176 @@ +/* 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 new file mode 100644 index 0000000000..8fcb0cc506 --- /dev/null +++ b/ext/spice/src/cspice/dafa2b.c @@ -0,0 +1,271 @@ +/* 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 new file mode 100644 index 0000000000..3bef869eb0 --- /dev/null +++ b/ext/spice/src/cspice/dafac.c @@ -0,0 +1,720 @@ +/* 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 new file mode 100644 index 0000000000..befadaff63 --- /dev/null +++ b/ext/spice/src/cspice/dafac_c.c @@ -0,0 +1,258 @@ +/* + +-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 new file mode 100644 index 0000000000..96ca0a9c60 --- /dev/null +++ b/ext/spice/src/cspice/dafah.c @@ -0,0 +1,4965 @@ +/* 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 new file mode 100644 index 0000000000..499bc3fdc6 --- /dev/null +++ b/ext/spice/src/cspice/dafana.c @@ -0,0 +1,2457 @@ +/* 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 new file mode 100644 index 0000000000..bf8935bbf3 --- /dev/null +++ b/ext/spice/src/cspice/dafarr.c @@ -0,0 +1,477 @@ +/* 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 new file mode 100644 index 0000000000..682bb106ca --- /dev/null +++ b/ext/spice/src/cspice/dafb2a.c @@ -0,0 +1,263 @@ +/* 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 new file mode 100644 index 0000000000..0dab9dafb5 --- /dev/null +++ b/ext/spice/src/cspice/dafb2t.c @@ -0,0 +1,864 @@ +/* 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 new file mode 100644 index 0000000000..7143dae6f2 --- /dev/null +++ b/ext/spice/src/cspice/dafbbs_c.c @@ -0,0 +1,246 @@ +/* + +-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 new file mode 100644 index 0000000000..baab761422 --- /dev/null +++ b/ext/spice/src/cspice/dafbfs_c.c @@ -0,0 +1,247 @@ +/* + +-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 new file mode 100644 index 0000000000..97a1e5ff71 --- /dev/null +++ b/ext/spice/src/cspice/dafbt.c @@ -0,0 +1,917 @@ +/* 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 new file mode 100644 index 0000000000..04717f7b03 --- /dev/null +++ b/ext/spice/src/cspice/dafcls_c.c @@ -0,0 +1,180 @@ +/* + +-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 new file mode 100644 index 0000000000..b5125ecfdb --- /dev/null +++ b/ext/spice/src/cspice/dafcs_c.c @@ -0,0 +1,256 @@ +/* + +-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 new file mode 100644 index 0000000000..bd4d89edc4 --- /dev/null +++ b/ext/spice/src/cspice/dafdc.c @@ -0,0 +1,206 @@ +/* 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 new file mode 100644 index 0000000000..0b4e47546d --- /dev/null +++ b/ext/spice/src/cspice/dafdc_c.c @@ -0,0 +1,156 @@ +/* + +-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 new file mode 100644 index 0000000000..1cb61173d6 --- /dev/null +++ b/ext/spice/src/cspice/dafec.c @@ -0,0 +1,846 @@ +/* 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 new file mode 100644 index 0000000000..7886245910 --- /dev/null +++ b/ext/spice/src/cspice/dafec_c.c @@ -0,0 +1,302 @@ +/* + +-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 new file mode 100644 index 0000000000..2f10d72801 --- /dev/null +++ b/ext/spice/src/cspice/daffa.c @@ -0,0 +1,4239 @@ +/* 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 new file mode 100644 index 0000000000..a413b86f1f --- /dev/null +++ b/ext/spice/src/cspice/daffna_c.c @@ -0,0 +1,263 @@ +/* + +-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 new file mode 100644 index 0000000000..053bed0e2f --- /dev/null +++ b/ext/spice/src/cspice/daffpa_c.c @@ -0,0 +1,265 @@ +/* + +-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 new file mode 100644 index 0000000000..3169ecfdbf --- /dev/null +++ b/ext/spice/src/cspice/dafgda.c @@ -0,0 +1,244 @@ +/* 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 new file mode 100644 index 0000000000..ea13f93fa7 --- /dev/null +++ b/ext/spice/src/cspice/dafgda_c.c @@ -0,0 +1,193 @@ +/* + +-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 new file mode 100644 index 0000000000..e5f51fca14 --- /dev/null +++ b/ext/spice/src/cspice/dafgn_c.c @@ -0,0 +1,290 @@ +/* + +-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 new file mode 100644 index 0000000000..c8f7575028 --- /dev/null +++ b/ext/spice/src/cspice/dafgs_c.c @@ -0,0 +1,261 @@ +/* + +-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 new file mode 100644 index 0000000000..e077616d87 --- /dev/null +++ b/ext/spice/src/cspice/dafgsr_c.c @@ -0,0 +1,208 @@ +/* + +-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 new file mode 100644 index 0000000000..ab4c238162 --- /dev/null +++ b/ext/spice/src/cspice/dafopr_c.c @@ -0,0 +1,205 @@ +/* + +-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 new file mode 100644 index 0000000000..0e7d7aaa7a --- /dev/null +++ b/ext/spice/src/cspice/dafopw_c.c @@ -0,0 +1,308 @@ +/* + +-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 new file mode 100644 index 0000000000..bf0a22adde --- /dev/null +++ b/ext/spice/src/cspice/dafps.c @@ -0,0 +1,367 @@ +/* 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 new file mode 100644 index 0000000000..aa232ed0f9 --- /dev/null +++ b/ext/spice/src/cspice/dafps_c.c @@ -0,0 +1,243 @@ +/* + +-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 new file mode 100644 index 0000000000..c03069254b --- /dev/null +++ b/ext/spice/src/cspice/dafra.c @@ -0,0 +1,365 @@ +/* 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 new file mode 100644 index 0000000000..7a478974cf --- /dev/null +++ b/ext/spice/src/cspice/dafrcr.c @@ -0,0 +1,256 @@ +/* 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 new file mode 100644 index 0000000000..c0bcc6bae4 --- /dev/null +++ b/ext/spice/src/cspice/dafrda.c @@ -0,0 +1,318 @@ +/* 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 new file mode 100644 index 0000000000..4d1b2cce77 --- /dev/null +++ b/ext/spice/src/cspice/dafrda_c.c @@ -0,0 +1,211 @@ +/* + +-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 new file mode 100644 index 0000000000..e968eee8eb --- /dev/null +++ b/ext/spice/src/cspice/dafrfr.c @@ -0,0 +1,280 @@ +/* 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 new file mode 100644 index 0000000000..455ab4e0f3 --- /dev/null +++ b/ext/spice/src/cspice/dafrfr_c.c @@ -0,0 +1,228 @@ +/* + +-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 new file mode 100644 index 0000000000..42c752c219 --- /dev/null +++ b/ext/spice/src/cspice/dafrrr.c @@ -0,0 +1,392 @@ +/* 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 new file mode 100644 index 0000000000..f498680963 --- /dev/null +++ b/ext/spice/src/cspice/dafrs_c.c @@ -0,0 +1,228 @@ +/* + +-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 new file mode 100644 index 0000000000..5f0b86d874 --- /dev/null +++ b/ext/spice/src/cspice/dafrwa.c @@ -0,0 +1,316 @@ +/* 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 new file mode 100644 index 0000000000..c27b64a24e --- /dev/null +++ b/ext/spice/src/cspice/dafrwd.c @@ -0,0 +1,2304 @@ +/* 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 new file mode 100644 index 0000000000..d1da3371b8 --- /dev/null +++ b/ext/spice/src/cspice/daft2b.c @@ -0,0 +1,815 @@ +/* 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 new file mode 100644 index 0000000000..6661f020d0 --- /dev/null +++ b/ext/spice/src/cspice/daftb.c @@ -0,0 +1,900 @@ +/* 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 new file mode 100644 index 0000000000..6588494852 --- /dev/null +++ b/ext/spice/src/cspice/dafus_c.c @@ -0,0 +1,197 @@ +/* + +-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 new file mode 100644 index 0000000000..4685c51045 --- /dev/null +++ b/ext/spice/src/cspice/dafwcr.c @@ -0,0 +1,240 @@ +/* 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 new file mode 100644 index 0000000000..df94958fce --- /dev/null +++ b/ext/spice/src/cspice/dafwda.c @@ -0,0 +1,262 @@ +/* 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 new file mode 100644 index 0000000000..c57be627b9 --- /dev/null +++ b/ext/spice/src/cspice/dafwfr.c @@ -0,0 +1,478 @@ +/* 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 new file mode 100644 index 0000000000..7de3607f56 --- /dev/null +++ b/ext/spice/src/cspice/dasa2l.c @@ -0,0 +1,1042 @@ +/* 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 new file mode 100644 index 0000000000..eb19ce6505 --- /dev/null +++ b/ext/spice/src/cspice/dasac.c @@ -0,0 +1,548 @@ +/* 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 new file mode 100644 index 0000000000..a7d46931d7 --- /dev/null +++ b/ext/spice/src/cspice/dasac_c.c @@ -0,0 +1,273 @@ +/* + +-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 new file mode 100644 index 0000000000..3534146928 --- /dev/null +++ b/ext/spice/src/cspice/dasacr.c @@ -0,0 +1,502 @@ +/* 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 new file mode 100644 index 0000000000..86d6a940d2 --- /dev/null +++ b/ext/spice/src/cspice/dasacu.c @@ -0,0 +1,799 @@ +/* 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 new file mode 100644 index 0000000000..893b526d85 --- /dev/null +++ b/ext/spice/src/cspice/dasadc.c @@ -0,0 +1,532 @@ +/* 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 new file mode 100644 index 0000000000..413b6edd91 --- /dev/null +++ b/ext/spice/src/cspice/dasadd.c @@ -0,0 +1,412 @@ +/* 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 new file mode 100644 index 0000000000..47381d1961 --- /dev/null +++ b/ext/spice/src/cspice/dasadi.c @@ -0,0 +1,391 @@ +/* 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 new file mode 100644 index 0000000000..a46dcfe99c --- /dev/null +++ b/ext/spice/src/cspice/dasbt.c @@ -0,0 +1,1311 @@ +/* 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 new file mode 100644 index 0000000000..e6bbe106f5 --- /dev/null +++ b/ext/spice/src/cspice/dascls.c @@ -0,0 +1,363 @@ +/* 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 new file mode 100644 index 0000000000..16f5a5836f --- /dev/null +++ b/ext/spice/src/cspice/dascls_c.c @@ -0,0 +1,202 @@ +/* + +-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 new file mode 100644 index 0000000000..0e2dbaeb93 --- /dev/null +++ b/ext/spice/src/cspice/dascud.c @@ -0,0 +1,828 @@ +/* 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 new file mode 100644 index 0000000000..cf77593bf0 --- /dev/null +++ b/ext/spice/src/cspice/dasdc.c @@ -0,0 +1,251 @@ +/* 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 new file mode 100644 index 0000000000..952e3e4f92 --- /dev/null +++ b/ext/spice/src/cspice/dasec.c @@ -0,0 +1,752 @@ +/* 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 new file mode 100644 index 0000000000..0757d4531f --- /dev/null +++ b/ext/spice/src/cspice/dasec_c.c @@ -0,0 +1,306 @@ +/* + +-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 new file mode 100644 index 0000000000..84c9aa2027 --- /dev/null +++ b/ext/spice/src/cspice/dasecu.c @@ -0,0 +1,235 @@ +/* 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 new file mode 100644 index 0000000000..fef5359773 --- /dev/null +++ b/ext/spice/src/cspice/dasfm.c @@ -0,0 +1,6452 @@ +/* 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 new file mode 100644 index 0000000000..68e6f51c1d --- /dev/null +++ b/ext/spice/src/cspice/dasine.c @@ -0,0 +1,176 @@ +/* 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 new file mode 100644 index 0000000000..2bf20f22a9 --- /dev/null +++ b/ext/spice/src/cspice/dasioc.c @@ -0,0 +1,299 @@ +/* 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 new file mode 100644 index 0000000000..b17d4424fa --- /dev/null +++ b/ext/spice/src/cspice/dasiod.c @@ -0,0 +1,301 @@ +/* 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 new file mode 100644 index 0000000000..28c82f23cc --- /dev/null +++ b/ext/spice/src/cspice/dasioi.c @@ -0,0 +1,297 @@ +/* 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 new file mode 100644 index 0000000000..edb4c1015b --- /dev/null +++ b/ext/spice/src/cspice/daslla.c @@ -0,0 +1,204 @@ +/* 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 new file mode 100644 index 0000000000..59eae61dad --- /dev/null +++ b/ext/spice/src/cspice/dasopr_c.c @@ -0,0 +1,180 @@ +/* + +-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 new file mode 100644 index 0000000000..18a8e65507 --- /dev/null +++ b/ext/spice/src/cspice/dasrcr.c @@ -0,0 +1,465 @@ +/* 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 new file mode 100644 index 0000000000..aa7fb7341b --- /dev/null +++ b/ext/spice/src/cspice/dasrdc.c @@ -0,0 +1,480 @@ +/* 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 new file mode 100644 index 0000000000..c91b43c9a2 --- /dev/null +++ b/ext/spice/src/cspice/dasrdd.c @@ -0,0 +1,328 @@ +/* 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 new file mode 100644 index 0000000000..ba8fd28f72 --- /dev/null +++ b/ext/spice/src/cspice/dasrdi.c @@ -0,0 +1,325 @@ +/* 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 new file mode 100644 index 0000000000..ff92ad94a2 --- /dev/null +++ b/ext/spice/src/cspice/dasrfr.c @@ -0,0 +1,322 @@ +/* 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 new file mode 100644 index 0000000000..7c80c7eeec --- /dev/null +++ b/ext/spice/src/cspice/dasrwr.c @@ -0,0 +1,3906 @@ +/* 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 new file mode 100644 index 0000000000..da0f576aeb --- /dev/null +++ b/ext/spice/src/cspice/dassdr.c @@ -0,0 +1,948 @@ +/* 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 new file mode 100644 index 0000000000..067669a31f --- /dev/null +++ b/ext/spice/src/cspice/dastb.c @@ -0,0 +1,2249 @@ +/* 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 new file mode 100644 index 0000000000..34ac5232e5 --- /dev/null +++ b/ext/spice/src/cspice/dasudc.c @@ -0,0 +1,477 @@ +/* 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 new file mode 100644 index 0000000000..aa1e67465d --- /dev/null +++ b/ext/spice/src/cspice/dasudd.c @@ -0,0 +1,393 @@ +/* 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 new file mode 100644 index 0000000000..eba4d6cca3 --- /dev/null +++ b/ext/spice/src/cspice/dasudi.c @@ -0,0 +1,389 @@ +/* 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 new file mode 100644 index 0000000000..219165b1a4 --- /dev/null +++ b/ext/spice/src/cspice/daswfr.c @@ -0,0 +1,474 @@ +/* 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 new file mode 100644 index 0000000000..3182626610 --- /dev/null +++ b/ext/spice/src/cspice/datanh.c @@ -0,0 +1,176 @@ +/* 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 new file mode 100644 index 0000000000..0d0a7d8690 --- /dev/null +++ b/ext/spice/src/cspice/dcbrt.c @@ -0,0 +1,142 @@ +/* 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 new file mode 100644 index 0000000000..39831c9b37 --- /dev/null +++ b/ext/spice/src/cspice/dcyldr.c @@ -0,0 +1,251 @@ +/* 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 new file mode 100644 index 0000000000..80909b5182 --- /dev/null +++ b/ext/spice/src/cspice/dcyldr_c.c @@ -0,0 +1,213 @@ +/* + +-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 new file mode 100644 index 0000000000..6bd7bf4524 --- /dev/null +++ b/ext/spice/src/cspice/delfil.c @@ -0,0 +1,286 @@ +/* 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 new file mode 100644 index 0000000000..ebe40b9a1d --- /dev/null +++ b/ext/spice/src/cspice/deltet.c @@ -0,0 +1,424 @@ +/* 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 new file mode 100644 index 0000000000..8a1a0cb040 --- /dev/null +++ b/ext/spice/src/cspice/deltet_c.c @@ -0,0 +1,211 @@ +/* + +-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 new file mode 100644 index 0000000000..6afaccdaa3 --- /dev/null +++ b/ext/spice/src/cspice/derf_.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..e199f91605 --- /dev/null +++ b/ext/spice/src/cspice/derfc_.c @@ -0,0 +1,14 @@ +#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 new file mode 100644 index 0000000000..1f6d8d00a5 --- /dev/null +++ b/ext/spice/src/cspice/det.c @@ -0,0 +1,134 @@ +/* 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 new file mode 100644 index 0000000000..58ead2e371 --- /dev/null +++ b/ext/spice/src/cspice/det_c.c @@ -0,0 +1,134 @@ +/* + +-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 new file mode 100644 index 0000000000..6963d5a011 --- /dev/null +++ b/ext/spice/src/cspice/dfe.c @@ -0,0 +1,141 @@ +#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 new file mode 100644 index 0000000000..43c8ba9868 --- /dev/null +++ b/ext/spice/src/cspice/dgeodr.c @@ -0,0 +1,288 @@ +/* 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 new file mode 100644 index 0000000000..166d691ecc --- /dev/null +++ b/ext/spice/src/cspice/dgeodr_c.c @@ -0,0 +1,237 @@ +/* + +-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 new file mode 100644 index 0000000000..f1f018d21e --- /dev/null +++ b/ext/spice/src/cspice/dhfa.c @@ -0,0 +1,346 @@ +/* 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 new file mode 100644 index 0000000000..787c534219 --- /dev/null +++ b/ext/spice/src/cspice/diags2.c @@ -0,0 +1,574 @@ +/* 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 new file mode 100644 index 0000000000..7eff8e4734 --- /dev/null +++ b/ext/spice/src/cspice/diags2_c.c @@ -0,0 +1,551 @@ +/* + +-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 new file mode 100644 index 0000000000..7187bf8a9d --- /dev/null +++ b/ext/spice/src/cspice/diff_c.c @@ -0,0 +1,358 @@ +/* + +-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 new file mode 100644 index 0000000000..b009abb04c --- /dev/null +++ b/ext/spice/src/cspice/diffc.c @@ -0,0 +1,310 @@ +/* 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 new file mode 100644 index 0000000000..5533391f9d --- /dev/null +++ b/ext/spice/src/cspice/diffd.c @@ -0,0 +1,268 @@ +/* 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 new file mode 100644 index 0000000000..1373c69af7 --- /dev/null +++ b/ext/spice/src/cspice/diffi.c @@ -0,0 +1,267 @@ +/* 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 new file mode 100644 index 0000000000..44a8111a18 --- /dev/null +++ b/ext/spice/src/cspice/dlatdr.c @@ -0,0 +1,253 @@ +/* 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 new file mode 100644 index 0000000000..556397b407 --- /dev/null +++ b/ext/spice/src/cspice/dlatdr_c.c @@ -0,0 +1,218 @@ +/* + +-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 new file mode 100644 index 0000000000..1b86fe4c6b --- /dev/null +++ b/ext/spice/src/cspice/dnearp.c @@ -0,0 +1,528 @@ +/* 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 new file mode 100644 index 0000000000..4b5a2ca658 --- /dev/null +++ b/ext/spice/src/cspice/dolio.c @@ -0,0 +1,20 @@ +#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 new file mode 100644 index 0000000000..19ba07d17a --- /dev/null +++ b/ext/spice/src/cspice/dp2hx.c @@ -0,0 +1,568 @@ +/* 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 new file mode 100644 index 0000000000..110ff59175 --- /dev/null +++ b/ext/spice/src/cspice/dp2hx_c.c @@ -0,0 +1,275 @@ +/* + +-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 new file mode 100644 index 0000000000..cfb0f1572a --- /dev/null +++ b/ext/spice/src/cspice/dpfmt.c @@ -0,0 +1,623 @@ +/* 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 new file mode 100644 index 0000000000..568f7e6caa --- /dev/null +++ b/ext/spice/src/cspice/dpgrdr.c @@ -0,0 +1,674 @@ +/* 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 new file mode 100644 index 0000000000..f05986858b --- /dev/null +++ b/ext/spice/src/cspice/dpgrdr_c.c @@ -0,0 +1,555 @@ +/* + +-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 new file mode 100644 index 0000000000..0f41e76c9c --- /dev/null +++ b/ext/spice/src/cspice/dpmax.c @@ -0,0 +1,170 @@ +/* + +-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 new file mode 100644 index 0000000000..9c8befe490 --- /dev/null +++ b/ext/spice/src/cspice/dpmax_c.c @@ -0,0 +1,185 @@ +/* + +-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 new file mode 100644 index 0000000000..80c998ff89 --- /dev/null +++ b/ext/spice/src/cspice/dpmin.c @@ -0,0 +1,150 @@ +/* + +-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 new file mode 100644 index 0000000000..06bdfc5dc7 --- /dev/null +++ b/ext/spice/src/cspice/dpmin_c.c @@ -0,0 +1,163 @@ +/* + +-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 new file mode 100644 index 0000000000..bb5fa92710 --- /dev/null +++ b/ext/spice/src/cspice/dpr.c @@ -0,0 +1,158 @@ +/* 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 new file mode 100644 index 0000000000..fa06eeed21 --- /dev/null +++ b/ext/spice/src/cspice/dpr_c.c @@ -0,0 +1,141 @@ +/* + +-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 new file mode 100644 index 0000000000..1f07ca0507 --- /dev/null +++ b/ext/spice/src/cspice/dpspce.c @@ -0,0 +1,795 @@ +/* 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 new file mode 100644 index 0000000000..3e5ef4f917 --- /dev/null +++ b/ext/spice/src/cspice/dpstr.c @@ -0,0 +1,472 @@ +/* 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 new file mode 100644 index 0000000000..d7be89a07f --- /dev/null +++ b/ext/spice/src/cspice/dpstrf.c @@ -0,0 +1,366 @@ +/* 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 new file mode 100644 index 0000000000..bd94ce27a4 --- /dev/null +++ b/ext/spice/src/cspice/drdcyl.c @@ -0,0 +1,211 @@ +/* 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 new file mode 100644 index 0000000000..e2e8eb9969 --- /dev/null +++ b/ext/spice/src/cspice/drdcyl_c.c @@ -0,0 +1,215 @@ +/* + +-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 new file mode 100644 index 0000000000..0fea54931b --- /dev/null +++ b/ext/spice/src/cspice/drdgeo.c @@ -0,0 +1,449 @@ +/* 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 new file mode 100644 index 0000000000..2cdfe90e55 --- /dev/null +++ b/ext/spice/src/cspice/drdgeo_c.c @@ -0,0 +1,253 @@ +/* + +-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 new file mode 100644 index 0000000000..98cd0530e4 --- /dev/null +++ b/ext/spice/src/cspice/drdlat.c @@ -0,0 +1,212 @@ +/* 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 new file mode 100644 index 0000000000..cb83c4c788 --- /dev/null +++ b/ext/spice/src/cspice/drdlat_c.c @@ -0,0 +1,213 @@ +/* + +-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 new file mode 100644 index 0000000000..e1a3295d7a --- /dev/null +++ b/ext/spice/src/cspice/drdpgr.c @@ -0,0 +1,696 @@ +/* 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 new file mode 100644 index 0000000000..c4d6f86afd --- /dev/null +++ b/ext/spice/src/cspice/drdpgr_c.c @@ -0,0 +1,577 @@ +/* + +-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 new file mode 100644 index 0000000000..66bbde557a --- /dev/null +++ b/ext/spice/src/cspice/drdsph.c @@ -0,0 +1,224 @@ +/* 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 new file mode 100644 index 0000000000..e601dd8683 --- /dev/null +++ b/ext/spice/src/cspice/drdsph_c.c @@ -0,0 +1,220 @@ +/* + +-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 new file mode 100644 index 0000000000..01af24c49f --- /dev/null +++ b/ext/spice/src/cspice/drotat.c @@ -0,0 +1,253 @@ +/* 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 new file mode 100644 index 0000000000..d16cfcd85b --- /dev/null +++ b/ext/spice/src/cspice/dsphdr.c @@ -0,0 +1,252 @@ +/* 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 new file mode 100644 index 0000000000..fb30130422 --- /dev/null +++ b/ext/spice/src/cspice/dsphdr_c.c @@ -0,0 +1,218 @@ +/* + +-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 new file mode 100644 index 0000000000..3f665ceb99 --- /dev/null +++ b/ext/spice/src/cspice/dtime_.c @@ -0,0 +1,128 @@ +/* + +-Disclaimer + + THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE + CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. + GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE + ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE + PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" + TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY + WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A + PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC + SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE + SOFTWARE AND RELATED MATERIALS, HOWEVER USED. + + IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA + BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT + LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, + INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, + REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE + REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. + + RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF + THE SOFTWARE AND ANY RELATED MATERIALS, 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 new file mode 100644 index 0000000000..4ef90d1243 --- /dev/null +++ b/ext/spice/src/cspice/dtpool_c.c @@ -0,0 +1,222 @@ +/* + +-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 new file mode 100644 index 0000000000..5f8c33f78a --- /dev/null +++ b/ext/spice/src/cspice/ducrss.c @@ -0,0 +1,194 @@ +/* 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 new file mode 100644 index 0000000000..2d9a62a436 --- /dev/null +++ b/ext/spice/src/cspice/ducrss_c.c @@ -0,0 +1,189 @@ +/* + +-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 new file mode 100644 index 0000000000..83f4dc00a4 --- /dev/null +++ b/ext/spice/src/cspice/due.c @@ -0,0 +1,70 @@ +#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 new file mode 100644 index 0000000000..0ab8a4ceab --- /dev/null +++ b/ext/spice/src/cspice/dvcrss.c @@ -0,0 +1,166 @@ +/* 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 new file mode 100644 index 0000000000..958ac79afb --- /dev/null +++ b/ext/spice/src/cspice/dvcrss_c.c @@ -0,0 +1,175 @@ +/* + +-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 new file mode 100644 index 0000000000..7d1683c480 --- /dev/null +++ b/ext/spice/src/cspice/dvdot.c @@ -0,0 +1,158 @@ +/* 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 new file mode 100644 index 0000000000..cd7f4109ce --- /dev/null +++ b/ext/spice/src/cspice/dvdot_c.c @@ -0,0 +1,159 @@ +/* + +-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 new file mode 100644 index 0000000000..43ab077863 --- /dev/null +++ b/ext/spice/src/cspice/dvhat.c @@ -0,0 +1,249 @@ +/* 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 new file mode 100644 index 0000000000..c9ca4d25a6 --- /dev/null +++ b/ext/spice/src/cspice/dvhat_c.c @@ -0,0 +1,271 @@ +/* + +-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 new file mode 100644 index 0000000000..7accb4043b --- /dev/null +++ b/ext/spice/src/cspice/dvnorm.c @@ -0,0 +1,254 @@ +/* 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 new file mode 100644 index 0000000000..0ca35a7c9c --- /dev/null +++ b/ext/spice/src/cspice/dvnorm_c.c @@ -0,0 +1,227 @@ +/* + +-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 new file mode 100644 index 0000000000..bea35cb34e --- /dev/null +++ b/ext/spice/src/cspice/dvpool_c.c @@ -0,0 +1,161 @@ +/* + +-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 new file mode 100644 index 0000000000..f6a259e2c4 --- /dev/null +++ b/ext/spice/src/cspice/dvsep.c @@ -0,0 +1,349 @@ +/* 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 new file mode 100644 index 0000000000..3b5eccab37 --- /dev/null +++ b/ext/spice/src/cspice/dvsep_c.c @@ -0,0 +1,239 @@ +/* + +-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 new file mode 100644 index 0000000000..5df7f50cf5 --- /dev/null +++ b/ext/spice/src/cspice/dxtrct.c @@ -0,0 +1,363 @@ +/* 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 new file mode 100644 index 0000000000..eaff0d48fe --- /dev/null +++ b/ext/spice/src/cspice/edlimb.c @@ -0,0 +1,446 @@ +/* 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 new file mode 100644 index 0000000000..68a5836a2d --- /dev/null +++ b/ext/spice/src/cspice/edlimb_c.c @@ -0,0 +1,406 @@ +/* + +-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 new file mode 100644 index 0000000000..d0e0ad17d5 --- /dev/null +++ b/ext/spice/src/cspice/edterm.c @@ -0,0 +1,766 @@ +/* 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 new file mode 100644 index 0000000000..5e9c4fb45d --- /dev/null +++ b/ext/spice/src/cspice/ef1asc_.c @@ -0,0 +1,35 @@ +/* + 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 new file mode 100644 index 0000000000..8239a6ba2e --- /dev/null +++ b/ext/spice/src/cspice/ef1cmc_.c @@ -0,0 +1,14 @@ +/* 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 new file mode 100644 index 0000000000..d39e5b572c --- /dev/null +++ b/ext/spice/src/cspice/ekacec.c @@ -0,0 +1,683 @@ +/* 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 new file mode 100644 index 0000000000..6b904e5be4 --- /dev/null +++ b/ext/spice/src/cspice/ekacec_c.c @@ -0,0 +1,487 @@ +/* + +-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 new file mode 100644 index 0000000000..1aae325d77 --- /dev/null +++ b/ext/spice/src/cspice/ekaced.c @@ -0,0 +1,686 @@ +/* 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 new file mode 100644 index 0000000000..309430d271 --- /dev/null +++ b/ext/spice/src/cspice/ekaced_c.c @@ -0,0 +1,392 @@ +/* + +-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 new file mode 100644 index 0000000000..6bc8127a9d --- /dev/null +++ b/ext/spice/src/cspice/ekacei.c @@ -0,0 +1,688 @@ +/* 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 new file mode 100644 index 0000000000..04070d9fac --- /dev/null +++ b/ext/spice/src/cspice/ekacei_c.c @@ -0,0 +1,389 @@ +/* + +-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 new file mode 100644 index 0000000000..5f2bcb201a --- /dev/null +++ b/ext/spice/src/cspice/ekaclc.c @@ -0,0 +1,730 @@ +/* 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 new file mode 100644 index 0000000000..8a0e54781c --- /dev/null +++ b/ext/spice/src/cspice/ekaclc_c.c @@ -0,0 +1,696 @@ +/* + +-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 new file mode 100644 index 0000000000..77a214db1e --- /dev/null +++ b/ext/spice/src/cspice/ekacld.c @@ -0,0 +1,728 @@ +/* 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 new file mode 100644 index 0000000000..785a7cecf0 --- /dev/null +++ b/ext/spice/src/cspice/ekacld_c.c @@ -0,0 +1,555 @@ +/* + +-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 new file mode 100644 index 0000000000..c7f466e3a0 --- /dev/null +++ b/ext/spice/src/cspice/ekacli.c @@ -0,0 +1,727 @@ +/* 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 new file mode 100644 index 0000000000..5a5b826ad6 --- /dev/null +++ b/ext/spice/src/cspice/ekacli_c.c @@ -0,0 +1,555 @@ +/* + +-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 new file mode 100644 index 0000000000..1e8706641f --- /dev/null +++ b/ext/spice/src/cspice/ekappr.c @@ -0,0 +1,838 @@ +/* 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 new file mode 100644 index 0000000000..390d5fbc88 --- /dev/null +++ b/ext/spice/src/cspice/ekappr_c.c @@ -0,0 +1,294 @@ +/* + +-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 new file mode 100644 index 0000000000..e8ecb6e30b --- /dev/null +++ b/ext/spice/src/cspice/ekbseg.c @@ -0,0 +1,1384 @@ +/* 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 new file mode 100644 index 0000000000..245df77c68 --- /dev/null +++ b/ext/spice/src/cspice/ekbseg_c.c @@ -0,0 +1,548 @@ +/* + +-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 new file mode 100644 index 0000000000..f9529665b0 --- /dev/null +++ b/ext/spice/src/cspice/ekccnt_c.c @@ -0,0 +1,273 @@ +/* + +-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 new file mode 100644 index 0000000000..5e30355e1a --- /dev/null +++ b/ext/spice/src/cspice/ekcii_c.c @@ -0,0 +1,354 @@ +/* + +-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 new file mode 100644 index 0000000000..52deb61d49 --- /dev/null +++ b/ext/spice/src/cspice/ekcls.c @@ -0,0 +1,157 @@ +/* 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 new file mode 100644 index 0000000000..1c96a3f65f --- /dev/null +++ b/ext/spice/src/cspice/ekcls_c.c @@ -0,0 +1,151 @@ +/* + +-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 new file mode 100644 index 0000000000..4982d18ee2 --- /dev/null +++ b/ext/spice/src/cspice/ekdelr.c @@ -0,0 +1,734 @@ +/* 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 new file mode 100644 index 0000000000..f244048737 --- /dev/null +++ b/ext/spice/src/cspice/ekdelr_c.c @@ -0,0 +1,211 @@ +/* + +-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 new file mode 100644 index 0000000000..81f1566dc6 --- /dev/null +++ b/ext/spice/src/cspice/ekffld.c @@ -0,0 +1,480 @@ +/* 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 new file mode 100644 index 0000000000..f3df648dad --- /dev/null +++ b/ext/spice/src/cspice/ekffld_c.c @@ -0,0 +1,416 @@ +/* + +-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 new file mode 100644 index 0000000000..60a7d8f86e --- /dev/null +++ b/ext/spice/src/cspice/ekfind.c @@ -0,0 +1,1333 @@ +/* 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 new file mode 100644 index 0000000000..559577ae19 --- /dev/null +++ b/ext/spice/src/cspice/ekfind_c.c @@ -0,0 +1,674 @@ +/* + +-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 new file mode 100644 index 0000000000..ca0302731c --- /dev/null +++ b/ext/spice/src/cspice/ekgc_c.c @@ -0,0 +1,435 @@ +/* + +-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 new file mode 100644 index 0000000000..35e43e9f39 --- /dev/null +++ b/ext/spice/src/cspice/ekgd_c.c @@ -0,0 +1,408 @@ +/* + +-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 new file mode 100644 index 0000000000..c5800ff9bf --- /dev/null +++ b/ext/spice/src/cspice/ekgi_c.c @@ -0,0 +1,411 @@ +/* + +-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 new file mode 100644 index 0000000000..bde01cf386 --- /dev/null +++ b/ext/spice/src/cspice/ekifld.c @@ -0,0 +1,714 @@ +/* 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 new file mode 100644 index 0000000000..779ac1bd99 --- /dev/null +++ b/ext/spice/src/cspice/ekifld_c.c @@ -0,0 +1,677 @@ +/* + +-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 new file mode 100644 index 0000000000..5ad01ab023 --- /dev/null +++ b/ext/spice/src/cspice/ekinsr.c @@ -0,0 +1,1094 @@ +/* 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 new file mode 100644 index 0000000000..0a4c0bdade --- /dev/null +++ b/ext/spice/src/cspice/ekinsr_c.c @@ -0,0 +1,294 @@ +/* + +-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 new file mode 100644 index 0000000000..96b40cf976 --- /dev/null +++ b/ext/spice/src/cspice/eklef_c.c @@ -0,0 +1,221 @@ +/* + +-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 new file mode 100644 index 0000000000..49914d0539 --- /dev/null +++ b/ext/spice/src/cspice/eknelt_c.c @@ -0,0 +1,344 @@ +/* + +-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 new file mode 100644 index 0000000000..ac9b887dc0 --- /dev/null +++ b/ext/spice/src/cspice/eknseg.c @@ -0,0 +1,238 @@ +/* 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 new file mode 100644 index 0000000000..fa81108c92 --- /dev/null +++ b/ext/spice/src/cspice/eknseg_c.c @@ -0,0 +1,156 @@ +/* + +-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 new file mode 100644 index 0000000000..9039e6b579 --- /dev/null +++ b/ext/spice/src/cspice/ekntab_c.c @@ -0,0 +1,151 @@ +/* + +-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 new file mode 100644 index 0000000000..da02266213 --- /dev/null +++ b/ext/spice/src/cspice/ekopn.c @@ -0,0 +1,356 @@ +/* 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 new file mode 100644 index 0000000000..891000b393 --- /dev/null +++ b/ext/spice/src/cspice/ekopn_c.c @@ -0,0 +1,190 @@ +/* + +-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 new file mode 100644 index 0000000000..b7bfc049b2 --- /dev/null +++ b/ext/spice/src/cspice/ekopr.c @@ -0,0 +1,172 @@ +/* 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 new file mode 100644 index 0000000000..849b9d7ac7 --- /dev/null +++ b/ext/spice/src/cspice/ekopr_c.c @@ -0,0 +1,176 @@ +/* + +-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 new file mode 100644 index 0000000000..41f98b69ee --- /dev/null +++ b/ext/spice/src/cspice/ekops.c @@ -0,0 +1,311 @@ +/* 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 new file mode 100644 index 0000000000..54c7001ec7 --- /dev/null +++ b/ext/spice/src/cspice/ekops_c.c @@ -0,0 +1,152 @@ +/* + +-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 new file mode 100644 index 0000000000..4fa4469f39 --- /dev/null +++ b/ext/spice/src/cspice/ekopw.c @@ -0,0 +1,215 @@ +/* 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 new file mode 100644 index 0000000000..63ac2386a8 --- /dev/null +++ b/ext/spice/src/cspice/ekopw_c.c @@ -0,0 +1,213 @@ +/* + +-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 new file mode 100644 index 0000000000..c99673f65a --- /dev/null +++ b/ext/spice/src/cspice/ekpsel.c @@ -0,0 +1,1150 @@ +/* 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 new file mode 100644 index 0000000000..2115b87e7d --- /dev/null +++ b/ext/spice/src/cspice/ekpsel_c.c @@ -0,0 +1,796 @@ +/* + +-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 new file mode 100644 index 0000000000..b68dd58ad5 --- /dev/null +++ b/ext/spice/src/cspice/ekqmgr.c @@ -0,0 +1,7491 @@ +/* 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 new file mode 100644 index 0000000000..da8c5611ef --- /dev/null +++ b/ext/spice/src/cspice/ekrcec.c @@ -0,0 +1,597 @@ +/* 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 new file mode 100644 index 0000000000..07f2addc13 --- /dev/null +++ b/ext/spice/src/cspice/ekrcec_c.c @@ -0,0 +1,289 @@ +/* + +-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 new file mode 100644 index 0000000000..ba864f9bdf --- /dev/null +++ b/ext/spice/src/cspice/ekrced.c @@ -0,0 +1,579 @@ +/* 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 new file mode 100644 index 0000000000..651132f404 --- /dev/null +++ b/ext/spice/src/cspice/ekrced_c.c @@ -0,0 +1,237 @@ +/* + +-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 new file mode 100644 index 0000000000..4c86429ae6 --- /dev/null +++ b/ext/spice/src/cspice/ekrcei.c @@ -0,0 +1,578 @@ +/* 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 new file mode 100644 index 0000000000..ff3d70bd78 --- /dev/null +++ b/ext/spice/src/cspice/ekrcei_c.c @@ -0,0 +1,229 @@ +/* + +-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 new file mode 100644 index 0000000000..d0dd790970 --- /dev/null +++ b/ext/spice/src/cspice/ekshdw.c @@ -0,0 +1,125 @@ +/* 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 new file mode 100644 index 0000000000..864ff60e9a --- /dev/null +++ b/ext/spice/src/cspice/ekssum.c @@ -0,0 +1,722 @@ +/* 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 new file mode 100644 index 0000000000..f9cc534287 --- /dev/null +++ b/ext/spice/src/cspice/ekssum_c.c @@ -0,0 +1,446 @@ +/* + +-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 new file mode 100644 index 0000000000..634c5202f3 --- /dev/null +++ b/ext/spice/src/cspice/ektnam_c.c @@ -0,0 +1,198 @@ +/* + +-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 new file mode 100644 index 0000000000..c71daea49f --- /dev/null +++ b/ext/spice/src/cspice/ekucec.c @@ -0,0 +1,600 @@ +/* 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 new file mode 100644 index 0000000000..c0e6f9a876 --- /dev/null +++ b/ext/spice/src/cspice/ekucec_c.c @@ -0,0 +1,357 @@ +/* + +-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 new file mode 100644 index 0000000000..1165542969 --- /dev/null +++ b/ext/spice/src/cspice/ekuced.c @@ -0,0 +1,600 @@ +/* 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 new file mode 100644 index 0000000000..da58034c09 --- /dev/null +++ b/ext/spice/src/cspice/ekuced_c.c @@ -0,0 +1,294 @@ +/* + +-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 new file mode 100644 index 0000000000..5b79a78706 --- /dev/null +++ b/ext/spice/src/cspice/ekucei.c @@ -0,0 +1,595 @@ +/* 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 new file mode 100644 index 0000000000..dc99404bc4 --- /dev/null +++ b/ext/spice/src/cspice/ekucei_c.c @@ -0,0 +1,287 @@ +/* + +-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 new file mode 100644 index 0000000000..18bd471d86 --- /dev/null +++ b/ext/spice/src/cspice/ekuef_c.c @@ -0,0 +1,145 @@ +/* + +-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 new file mode 100644 index 0000000000..4d0940ac25 --- /dev/null +++ b/ext/spice/src/cspice/el2cgv.c @@ -0,0 +1,185 @@ +/* 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 new file mode 100644 index 0000000000..897471292c --- /dev/null +++ b/ext/spice/src/cspice/el2cgv_c.c @@ -0,0 +1,179 @@ +/* + +-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 new file mode 100644 index 0000000000..459e8c06e1 --- /dev/null +++ b/ext/spice/src/cspice/elemc.c @@ -0,0 +1,190 @@ +/* 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 new file mode 100644 index 0000000000..7311cc2fe1 --- /dev/null +++ b/ext/spice/src/cspice/elemc_c.c @@ -0,0 +1,206 @@ +/* + +-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 new file mode 100644 index 0000000000..6ccc5a3c3f --- /dev/null +++ b/ext/spice/src/cspice/elemd.c @@ -0,0 +1,191 @@ +/* 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 new file mode 100644 index 0000000000..ba5d0aa23f --- /dev/null +++ b/ext/spice/src/cspice/elemd_c.c @@ -0,0 +1,170 @@ +/* + +-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 new file mode 100644 index 0000000000..16ebc57ed3 --- /dev/null +++ b/ext/spice/src/cspice/elemi.c @@ -0,0 +1,190 @@ +/* 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 new file mode 100644 index 0000000000..89c5a5d224 --- /dev/null +++ b/ext/spice/src/cspice/elemi_c.c @@ -0,0 +1,173 @@ +/* + +-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 new file mode 100644 index 0000000000..f260729e10 --- /dev/null +++ b/ext/spice/src/cspice/elltof.c @@ -0,0 +1,346 @@ +/* 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 new file mode 100644 index 0000000000..38059720a8 --- /dev/null +++ b/ext/spice/src/cspice/enchar.c @@ -0,0 +1,400 @@ +/* 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 new file mode 100644 index 0000000000..d28b6c411d --- /dev/null +++ b/ext/spice/src/cspice/endfile.c @@ -0,0 +1,119 @@ +#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 new file mode 100644 index 0000000000..134984c20e --- /dev/null +++ b/ext/spice/src/cspice/eqchr.c @@ -0,0 +1,515 @@ +/* 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 new file mode 100644 index 0000000000..1f795f5b77 --- /dev/null +++ b/ext/spice/src/cspice/eqncpv.c @@ -0,0 +1,548 @@ +/* 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 new file mode 100644 index 0000000000..5382c6a1cf --- /dev/null +++ b/ext/spice/src/cspice/eqstr.c @@ -0,0 +1,387 @@ +/* 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 new file mode 100644 index 0000000000..48a3e46788 --- /dev/null +++ b/ext/spice/src/cspice/eqstr_c.c @@ -0,0 +1,487 @@ +/* + +-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 new file mode 100644 index 0000000000..f7565ae6ae --- /dev/null +++ b/ext/spice/src/cspice/erf_.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..56adb2f910 --- /dev/null +++ b/ext/spice/src/cspice/erfc_.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..e25d19f20b --- /dev/null +++ b/ext/spice/src/cspice/err.c @@ -0,0 +1,270 @@ +#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 new file mode 100644 index 0000000000..aecf6b0f08 --- /dev/null +++ b/ext/spice/src/cspice/erract.c @@ -0,0 +1,495 @@ +/* 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 new file mode 100644 index 0000000000..c7efcd43d3 --- /dev/null +++ b/ext/spice/src/cspice/erract_c.c @@ -0,0 +1,432 @@ +/* + +-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 new file mode 100644 index 0000000000..e5cc2a880a --- /dev/null +++ b/ext/spice/src/cspice/errch.c @@ -0,0 +1,445 @@ +/* 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 new file mode 100644 index 0000000000..cf418a6a58 --- /dev/null +++ b/ext/spice/src/cspice/errch_c.c @@ -0,0 +1,247 @@ +/* + +-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 new file mode 100644 index 0000000000..67b52e1d0d --- /dev/null +++ b/ext/spice/src/cspice/errdev.c @@ -0,0 +1,420 @@ +/* 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 new file mode 100644 index 0000000000..e2f02ed82f --- /dev/null +++ b/ext/spice/src/cspice/errdev_c.c @@ -0,0 +1,277 @@ +/* + +-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 new file mode 100644 index 0000000000..0255044612 --- /dev/null +++ b/ext/spice/src/cspice/errdp.c @@ -0,0 +1,381 @@ +/* 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 new file mode 100644 index 0000000000..4a194c02c2 --- /dev/null +++ b/ext/spice/src/cspice/errdp_c.c @@ -0,0 +1,208 @@ +/* + +-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 new file mode 100644 index 0000000000..2eef249177 --- /dev/null +++ b/ext/spice/src/cspice/errfnm.c @@ -0,0 +1,271 @@ +/* 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 new file mode 100644 index 0000000000..c124120407 --- /dev/null +++ b/ext/spice/src/cspice/errhan.c @@ -0,0 +1,438 @@ +/* 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 new file mode 100644 index 0000000000..eebd1a3795 --- /dev/null +++ b/ext/spice/src/cspice/errint.c @@ -0,0 +1,354 @@ +/* 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 new file mode 100644 index 0000000000..5c80196fed --- /dev/null +++ b/ext/spice/src/cspice/errint_c.c @@ -0,0 +1,206 @@ +/* + +-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 new file mode 100644 index 0000000000..5403238c75 --- /dev/null +++ b/ext/spice/src/cspice/errprt.c @@ -0,0 +1,479 @@ +/* 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 new file mode 100644 index 0000000000..a3c252b19d --- /dev/null +++ b/ext/spice/src/cspice/errprt_c.c @@ -0,0 +1,376 @@ +/* + +-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 new file mode 100644 index 0000000000..10669e6e0c --- /dev/null +++ b/ext/spice/src/cspice/esrchc.c @@ -0,0 +1,173 @@ +/* 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 new file mode 100644 index 0000000000..496088594b --- /dev/null +++ b/ext/spice/src/cspice/esrchc_c.c @@ -0,0 +1,230 @@ +/* + +-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 new file mode 100644 index 0000000000..455c451fd8 --- /dev/null +++ b/ext/spice/src/cspice/et2lst.c @@ -0,0 +1,592 @@ +/* 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 new file mode 100644 index 0000000000..7365ff575f --- /dev/null +++ b/ext/spice/src/cspice/et2lst_c.c @@ -0,0 +1,389 @@ +/* + +-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 new file mode 100644 index 0000000000..555b8275fd --- /dev/null +++ b/ext/spice/src/cspice/et2utc.c @@ -0,0 +1,816 @@ +/* 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 new file mode 100644 index 0000000000..2a3c4b5ac4 --- /dev/null +++ b/ext/spice/src/cspice/et2utc_c.c @@ -0,0 +1,370 @@ +/* + +-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 new file mode 100644 index 0000000000..bc01bcb339 --- /dev/null +++ b/ext/spice/src/cspice/etcal.c @@ -0,0 +1,630 @@ +/* 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 new file mode 100644 index 0000000000..cd225854b4 --- /dev/null +++ b/ext/spice/src/cspice/etcal_c.c @@ -0,0 +1,255 @@ +/* + +-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 new file mode 100644 index 0000000000..2b2b20465b --- /dev/null +++ b/ext/spice/src/cspice/etime_.c @@ -0,0 +1,121 @@ +/* + +-Disclaimer + + THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE + CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. + GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE + ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE + PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" + TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY + WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A + PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC + SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE + SOFTWARE AND RELATED MATERIALS, HOWEVER USED. + + IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA + BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT + LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, + INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, + REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE + REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. + + RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF + THE SOFTWARE AND ANY RELATED MATERIALS, 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 new file mode 100644 index 0000000000..b61592cfe4 --- /dev/null +++ b/ext/spice/src/cspice/eul2m.c @@ -0,0 +1,484 @@ +/* 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 new file mode 100644 index 0000000000..c577595d01 --- /dev/null +++ b/ext/spice/src/cspice/eul2m_c.c @@ -0,0 +1,414 @@ +/* + +-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 new file mode 100644 index 0000000000..b15873feb1 --- /dev/null +++ b/ext/spice/src/cspice/eul2xf_c.c @@ -0,0 +1,367 @@ +/* + +-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 new file mode 100644 index 0000000000..620a194459 --- /dev/null +++ b/ext/spice/src/cspice/ev2lin.c @@ -0,0 +1,1268 @@ +/* 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 new file mode 100644 index 0000000000..12d5c3d2b7 --- /dev/null +++ b/ext/spice/src/cspice/even.c @@ -0,0 +1,146 @@ +/* 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 new file mode 100644 index 0000000000..00c44279b0 --- /dev/null +++ b/ext/spice/src/cspice/exact.c @@ -0,0 +1,140 @@ +/* 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 new file mode 100644 index 0000000000..b90a321c36 --- /dev/null +++ b/ext/spice/src/cspice/excess.c @@ -0,0 +1,242 @@ +/* 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 new file mode 100644 index 0000000000..aa74d63b59 --- /dev/null +++ b/ext/spice/src/cspice/exists.c @@ -0,0 +1,264 @@ +/* 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 new file mode 100644 index 0000000000..c2c4ace109 --- /dev/null +++ b/ext/spice/src/cspice/exists_c.c @@ -0,0 +1,179 @@ +/* + +-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 new file mode 100644 index 0000000000..da3ab5c10e --- /dev/null +++ b/ext/spice/src/cspice/exit_.c @@ -0,0 +1,37 @@ +/* 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 new file mode 100644 index 0000000000..561a3dbef1 --- /dev/null +++ b/ext/spice/src/cspice/expln.c @@ -0,0 +1,332 @@ +/* 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 new file mode 100644 index 0000000000..24706a7622 --- /dev/null +++ b/ext/spice/src/cspice/expool_c.c @@ -0,0 +1,183 @@ +/* + +-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 new file mode 100644 index 0000000000..079fdaf490 --- /dev/null +++ b/ext/spice/src/cspice/f2c.h @@ -0,0 +1,654 @@ +/* + +-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 new file mode 100644 index 0000000000..f18fded688 --- /dev/null +++ b/ext/spice/src/cspice/f2cMang.h @@ -0,0 +1,390 @@ +/* + +-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 new file mode 100644 index 0000000000..117bf2a77b --- /dev/null +++ b/ext/spice/src/cspice/failed_c.c @@ -0,0 +1,254 @@ +/* + +-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 new file mode 100644 index 0000000000..03ef003c17 --- /dev/null +++ b/ext/spice/src/cspice/fetchc.c @@ -0,0 +1,222 @@ +/* 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 new file mode 100644 index 0000000000..c2f6232fd3 --- /dev/null +++ b/ext/spice/src/cspice/fetchd.c @@ -0,0 +1,227 @@ +/* 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 new file mode 100644 index 0000000000..482c5a16c1 --- /dev/null +++ b/ext/spice/src/cspice/fetchi.c @@ -0,0 +1,227 @@ +/* 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 new file mode 100644 index 0000000000..91d72404d1 --- /dev/null +++ b/ext/spice/src/cspice/fillc.c @@ -0,0 +1,145 @@ +/* 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 new file mode 100644 index 0000000000..39e9e819d9 --- /dev/null +++ b/ext/spice/src/cspice/filld.c @@ -0,0 +1,143 @@ +/* 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 new file mode 100644 index 0000000000..c91d5efa91 --- /dev/null +++ b/ext/spice/src/cspice/filli.c @@ -0,0 +1,142 @@ +/* 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 new file mode 100644 index 0000000000..bb20dd2ca0 --- /dev/null +++ b/ext/spice/src/cspice/fio.h @@ -0,0 +1,107 @@ +#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 new file mode 100644 index 0000000000..364210c262 --- /dev/null +++ b/ext/spice/src/cspice/fmt.c @@ -0,0 +1,516 @@ +#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 new file mode 100644 index 0000000000..19065a2f04 --- /dev/null +++ b/ext/spice/src/cspice/fmt.h @@ -0,0 +1,100 @@ +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 new file mode 100644 index 0000000000..91483fc529 --- /dev/null +++ b/ext/spice/src/cspice/fmtlib.c @@ -0,0 +1,45 @@ +/* @(#)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 new file mode 100644 index 0000000000..aaf66bd323 --- /dev/null +++ b/ext/spice/src/cspice/fn2lun.c @@ -0,0 +1,227 @@ +/* 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 new file mode 100644 index 0000000000..a7b6dbe347 --- /dev/null +++ b/ext/spice/src/cspice/fndlun.c @@ -0,0 +1,1037 @@ +/* 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 new file mode 100644 index 0000000000..71338822c9 --- /dev/null +++ b/ext/spice/src/cspice/fndnwd.c @@ -0,0 +1,224 @@ +/* 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 new file mode 100644 index 0000000000..40743d79f7 --- /dev/null +++ b/ext/spice/src/cspice/fp.h @@ -0,0 +1,28 @@ +#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 new file mode 100644 index 0000000000..0dc567ce05 --- /dev/null +++ b/ext/spice/src/cspice/frame.c @@ -0,0 +1,285 @@ +/* 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 new file mode 100644 index 0000000000..01c86e12dd --- /dev/null +++ b/ext/spice/src/cspice/frame_c.c @@ -0,0 +1,270 @@ +/* + +-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 new file mode 100644 index 0000000000..ee7e41c707 --- /dev/null +++ b/ext/spice/src/cspice/framex.c @@ -0,0 +1,2589 @@ +/* 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 new file mode 100644 index 0000000000..0ca660845f --- /dev/null +++ b/ext/spice/src/cspice/frinfo_c.c @@ -0,0 +1,196 @@ +/* + +-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 new file mode 100644 index 0000000000..7273691850 --- /dev/null +++ b/ext/spice/src/cspice/frmchg.c @@ -0,0 +1,875 @@ +/* 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 new file mode 100644 index 0000000000..8041b91309 --- /dev/null +++ b/ext/spice/src/cspice/frmget.c @@ -0,0 +1,360 @@ +/* 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 new file mode 100644 index 0000000000..0a08e1b991 --- /dev/null +++ b/ext/spice/src/cspice/frmnam_c.c @@ -0,0 +1,238 @@ +/* + +-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 new file mode 100644 index 0000000000..8e54fb0bbc --- /dev/null +++ b/ext/spice/src/cspice/frstnb.c @@ -0,0 +1,159 @@ +/* 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 new file mode 100644 index 0000000000..7b9f90abe8 --- /dev/null +++ b/ext/spice/src/cspice/frstnp.c @@ -0,0 +1,178 @@ +/* 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 new file mode 100644 index 0000000000..0445a3abf1 --- /dev/null +++ b/ext/spice/src/cspice/frstpc.c @@ -0,0 +1,185 @@ +/* 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 new file mode 100644 index 0000000000..2d3aad999a --- /dev/null +++ b/ext/spice/src/cspice/ftell_.c @@ -0,0 +1,46 @@ +#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 new file mode 100644 index 0000000000..0c26153969 --- /dev/null +++ b/ext/spice/src/cspice/ftncls_c.c @@ -0,0 +1,219 @@ +/* + +-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 new file mode 100644 index 0000000000..71c05f1e08 --- /dev/null +++ b/ext/spice/src/cspice/furnsh_c.c @@ -0,0 +1,383 @@ +/* + +-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 new file mode 100644 index 0000000000..4b89ceaa7b --- /dev/null +++ b/ext/spice/src/cspice/gcd.c @@ -0,0 +1,176 @@ +/* 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 new file mode 100644 index 0000000000..5c53f4ecc7 --- /dev/null +++ b/ext/spice/src/cspice/gcpool_c.c @@ -0,0 +1,359 @@ +/* + +-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 new file mode 100644 index 0000000000..f759c0d04f --- /dev/null +++ b/ext/spice/src/cspice/gdpool_c.c @@ -0,0 +1,306 @@ +/* + +-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 new file mode 100644 index 0000000000..056b433ed8 --- /dev/null +++ b/ext/spice/src/cspice/georec.c @@ -0,0 +1,340 @@ +/* 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 new file mode 100644 index 0000000000..14b63fe561 --- /dev/null +++ b/ext/spice/src/cspice/georec_c.c @@ -0,0 +1,257 @@ +/* + +-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 new file mode 100644 index 0000000000..5a281011b1 --- /dev/null +++ b/ext/spice/src/cspice/getcml_c.c @@ -0,0 +1,179 @@ +/* + +-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 new file mode 100644 index 0000000000..5c739ebcb8 --- /dev/null +++ b/ext/spice/src/cspice/getelm.c @@ -0,0 +1,306 @@ +/* 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 new file mode 100644 index 0000000000..0e2a69202c --- /dev/null +++ b/ext/spice/src/cspice/getelm_c.c @@ -0,0 +1,443 @@ +/* + +-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 new file mode 100644 index 0000000000..02721aa31a --- /dev/null +++ b/ext/spice/src/cspice/getenv_.c @@ -0,0 +1,194 @@ +/* + +-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 new file mode 100644 index 0000000000..2959c69701 --- /dev/null +++ b/ext/spice/src/cspice/getfat_c.c @@ -0,0 +1,282 @@ +/* + +-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 new file mode 100644 index 0000000000..878f8eeb0a --- /dev/null +++ b/ext/spice/src/cspice/getfov.c @@ -0,0 +1,1319 @@ +/* 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 new file mode 100644 index 0000000000..ba16ab52fc --- /dev/null +++ b/ext/spice/src/cspice/getfov_c.c @@ -0,0 +1,624 @@ +/* + +-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 new file mode 100644 index 0000000000..a757aea84e --- /dev/null +++ b/ext/spice/src/cspice/getlun.c @@ -0,0 +1,240 @@ +/* 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 new file mode 100644 index 0000000000..623eb7ee49 --- /dev/null +++ b/ext/spice/src/cspice/getmsg.c @@ -0,0 +1,309 @@ +/* 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 new file mode 100644 index 0000000000..5ce04c202e --- /dev/null +++ b/ext/spice/src/cspice/getmsg_c.c @@ -0,0 +1,282 @@ +/* + +-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 new file mode 100644 index 0000000000..40037facf4 --- /dev/null +++ b/ext/spice/src/cspice/gfbail.c @@ -0,0 +1,215 @@ +/* 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 new file mode 100644 index 0000000000..e1dc2c5aef --- /dev/null +++ b/ext/spice/src/cspice/gfbail_c.c @@ -0,0 +1,189 @@ +/* + +-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 new file mode 100644 index 0000000000..f27b11e95e --- /dev/null +++ b/ext/spice/src/cspice/gfclrh_c.c @@ -0,0 +1,186 @@ +/* + +-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 new file mode 100644 index 0000000000..3e6e548b4f --- /dev/null +++ b/ext/spice/src/cspice/gfdist.c @@ -0,0 +1,1382 @@ +/* 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 new file mode 100644 index 0000000000..0c77417332 --- /dev/null +++ b/ext/spice/src/cspice/gfdist_c.c @@ -0,0 +1,1139 @@ +/* + +-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 new file mode 100644 index 0000000000..4d85ddb5a8 --- /dev/null +++ b/ext/spice/src/cspice/gfevnt.c @@ -0,0 +1,2414 @@ +/* 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 new file mode 100644 index 0000000000..ffe0ee23a0 --- /dev/null +++ b/ext/spice/src/cspice/gfevnt_c.c @@ -0,0 +1,1561 @@ +/* + +-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 new file mode 100644 index 0000000000..14fe8199e1 --- /dev/null +++ b/ext/spice/src/cspice/gffove.c @@ -0,0 +1,1708 @@ +/* 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 new file mode 100644 index 0000000000..119bdef061 --- /dev/null +++ b/ext/spice/src/cspice/gffove_c.c @@ -0,0 +1,1638 @@ +/* + +-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 new file mode 100644 index 0000000000..d34cfe5ffc --- /dev/null +++ b/ext/spice/src/cspice/gfinth_c.c @@ -0,0 +1,233 @@ +/* + +-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 new file mode 100644 index 0000000000..d48f3bbeb1 --- /dev/null +++ b/ext/spice/src/cspice/gfocce.c @@ -0,0 +1,1267 @@ +/* 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 new file mode 100644 index 0000000000..00c7a1c018 --- /dev/null +++ b/ext/spice/src/cspice/gfocce_c.c @@ -0,0 +1,1247 @@ +/* + +-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 new file mode 100644 index 0000000000..82a55de584 --- /dev/null +++ b/ext/spice/src/cspice/gfoclt.c @@ -0,0 +1,1342 @@ +/* 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 new file mode 100644 index 0000000000..6e74279701 --- /dev/null +++ b/ext/spice/src/cspice/gfoclt_c.c @@ -0,0 +1,1172 @@ +/* + +-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 new file mode 100644 index 0000000000..8eda0d42c5 --- /dev/null +++ b/ext/spice/src/cspice/gfposc.c @@ -0,0 +1,1556 @@ +/* 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 new file mode 100644 index 0000000000..95f574bcda --- /dev/null +++ b/ext/spice/src/cspice/gfposc_c.c @@ -0,0 +1,1039 @@ +/* + +-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 new file mode 100644 index 0000000000..39e548aad2 --- /dev/null +++ b/ext/spice/src/cspice/gfrefn.c @@ -0,0 +1,168 @@ +/* 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 new file mode 100644 index 0000000000..25d33e839f --- /dev/null +++ b/ext/spice/src/cspice/gfrefn_c.c @@ -0,0 +1,183 @@ +/* + +-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 new file mode 100644 index 0000000000..bc7aa53d3c --- /dev/null +++ b/ext/spice/src/cspice/gfrepf_c.c @@ -0,0 +1,206 @@ +/* + +-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 new file mode 100644 index 0000000000..5a3d6dd03f --- /dev/null +++ b/ext/spice/src/cspice/gfrepi_c.c @@ -0,0 +1,291 @@ +/* + +-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 new file mode 100644 index 0000000000..d381d6cdc4 --- /dev/null +++ b/ext/spice/src/cspice/gfrepu_c.c @@ -0,0 +1,238 @@ +/* + +-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 new file mode 100644 index 0000000000..5cd851d27d --- /dev/null +++ b/ext/spice/src/cspice/gfrfov.c @@ -0,0 +1,1085 @@ +/* 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 new file mode 100644 index 0000000000..ee61127a84 --- /dev/null +++ b/ext/spice/src/cspice/gfrfov_c.c @@ -0,0 +1,898 @@ +/* + +-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 new file mode 100644 index 0000000000..c3da240712 --- /dev/null +++ b/ext/spice/src/cspice/gfrprt.c @@ -0,0 +1,1121 @@ +/* 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 new file mode 100644 index 0000000000..04c1b275b4 --- /dev/null +++ b/ext/spice/src/cspice/gfrr.c @@ -0,0 +1,1253 @@ +/* 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 new file mode 100644 index 0000000000..58608d0268 --- /dev/null +++ b/ext/spice/src/cspice/gfrr_c.c @@ -0,0 +1,889 @@ +/* + +-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 new file mode 100644 index 0000000000..6e8ed9783e --- /dev/null +++ b/ext/spice/src/cspice/gfsep.c @@ -0,0 +1,1332 @@ +/* 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 new file mode 100644 index 0000000000..fb266206b7 --- /dev/null +++ b/ext/spice/src/cspice/gfsep_c.c @@ -0,0 +1,1015 @@ +/* + +-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 new file mode 100644 index 0000000000..2665480132 --- /dev/null +++ b/ext/spice/src/cspice/gfsntc.c @@ -0,0 +1,1708 @@ +/* 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 new file mode 100644 index 0000000000..66213de371 --- /dev/null +++ b/ext/spice/src/cspice/gfsntc_c.c @@ -0,0 +1,1300 @@ +/* + +-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 new file mode 100644 index 0000000000..55ba194f11 --- /dev/null +++ b/ext/spice/src/cspice/gfsstp_c.c @@ -0,0 +1,174 @@ +/* + +-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 new file mode 100644 index 0000000000..1946f3349a --- /dev/null +++ b/ext/spice/src/cspice/gfstep.c @@ -0,0 +1,340 @@ +/* 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 new file mode 100644 index 0000000000..5c1f0a2191 --- /dev/null +++ b/ext/spice/src/cspice/gfstep_c.c @@ -0,0 +1,186 @@ +/* + +-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 new file mode 100644 index 0000000000..72a46c7192 --- /dev/null +++ b/ext/spice/src/cspice/gfsubc.c @@ -0,0 +1,1588 @@ +/* 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 new file mode 100644 index 0000000000..24cf6f219b --- /dev/null +++ b/ext/spice/src/cspice/gfsubc_c.c @@ -0,0 +1,1086 @@ +/* + +-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 new file mode 100644 index 0000000000..4c96e47e8b --- /dev/null +++ b/ext/spice/src/cspice/gftfov.c @@ -0,0 +1,1098 @@ +/* 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 new file mode 100644 index 0000000000..376105947a --- /dev/null +++ b/ext/spice/src/cspice/gftfov_c.c @@ -0,0 +1,904 @@ +/* + +-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 new file mode 100644 index 0000000000..24ee8c2684 --- /dev/null +++ b/ext/spice/src/cspice/gfuds.c @@ -0,0 +1,1303 @@ +/* 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 new file mode 100644 index 0000000000..16dae197fc --- /dev/null +++ b/ext/spice/src/cspice/gfuds_c.c @@ -0,0 +1,957 @@ +/* + +-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 new file mode 100644 index 0000000000..f351b67612 --- /dev/null +++ b/ext/spice/src/cspice/gipool_c.c @@ -0,0 +1,306 @@ +/* + +-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 new file mode 100644 index 0000000000..86b2c74a13 --- /dev/null +++ b/ext/spice/src/cspice/gnpool_c.c @@ -0,0 +1,380 @@ +/* + +-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 new file mode 100644 index 0000000000..73b82151ac --- /dev/null +++ b/ext/spice/src/cspice/h_abs.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..ceff660e26 --- /dev/null +++ b/ext/spice/src/cspice/h_dim.c @@ -0,0 +1,10 @@ +#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 new file mode 100644 index 0000000000..6ffae9877b --- /dev/null +++ b/ext/spice/src/cspice/h_dnnt.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..a211cc7fa0 --- /dev/null +++ b/ext/spice/src/cspice/h_indx.c @@ -0,0 +1,26 @@ +#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 new file mode 100644 index 0000000000..00a2151bfa --- /dev/null +++ b/ext/spice/src/cspice/h_len.c @@ -0,0 +1,10 @@ +#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 new file mode 100644 index 0000000000..43431c1c50 --- /dev/null +++ b/ext/spice/src/cspice/h_mod.c @@ -0,0 +1,10 @@ +#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 new file mode 100644 index 0000000000..1cd87df34f --- /dev/null +++ b/ext/spice/src/cspice/h_nint.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..7b06c157a7 --- /dev/null +++ b/ext/spice/src/cspice/h_sign.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..7c420d4358 --- /dev/null +++ b/ext/spice/src/cspice/halfpi.c @@ -0,0 +1,175 @@ +/* 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 new file mode 100644 index 0000000000..f311158e30 --- /dev/null +++ b/ext/spice/src/cspice/halfpi_c.c @@ -0,0 +1,163 @@ +/* + +-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 new file mode 100644 index 0000000000..4c29527065 --- /dev/null +++ b/ext/spice/src/cspice/hl_ge.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..c4f345a085 --- /dev/null +++ b/ext/spice/src/cspice/hl_gt.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..a9cce596c7 --- /dev/null +++ b/ext/spice/src/cspice/hl_le.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..162d919c3b --- /dev/null +++ b/ext/spice/src/cspice/hl_lt.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..234adbc8af --- /dev/null +++ b/ext/spice/src/cspice/hrmesp.c @@ -0,0 +1,484 @@ +/* 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 new file mode 100644 index 0000000000..be4964d291 --- /dev/null +++ b/ext/spice/src/cspice/hrmint.c @@ -0,0 +1,486 @@ +/* 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 new file mode 100644 index 0000000000..c937487b3d --- /dev/null +++ b/ext/spice/src/cspice/hx2dp.c @@ -0,0 +1,730 @@ +/* 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 new file mode 100644 index 0000000000..3b3b667748 --- /dev/null +++ b/ext/spice/src/cspice/hx2dp_c.c @@ -0,0 +1,293 @@ +/* + +-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 new file mode 100644 index 0000000000..04c90995ea --- /dev/null +++ b/ext/spice/src/cspice/hx2int.c @@ -0,0 +1,552 @@ +/* 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 new file mode 100644 index 0000000000..3eae421611 --- /dev/null +++ b/ext/spice/src/cspice/hyptof.c @@ -0,0 +1,426 @@ +/* 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 new file mode 100644 index 0000000000..be21295aaa --- /dev/null +++ b/ext/spice/src/cspice/i_abs.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..6e1b1707b5 --- /dev/null +++ b/ext/spice/src/cspice/i_dim.c @@ -0,0 +1,10 @@ +#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 new file mode 100644 index 0000000000..b5d5006f66 --- /dev/null +++ b/ext/spice/src/cspice/i_dnnt.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..96e7bc51ba --- /dev/null +++ b/ext/spice/src/cspice/i_indx.c @@ -0,0 +1,26 @@ +#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 new file mode 100644 index 0000000000..4020fee461 --- /dev/null +++ b/ext/spice/src/cspice/i_len.c @@ -0,0 +1,10 @@ +#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 new file mode 100644 index 0000000000..6937c42135 --- /dev/null +++ b/ext/spice/src/cspice/i_mod.c @@ -0,0 +1,10 @@ +#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 new file mode 100644 index 0000000000..676f9b3474 --- /dev/null +++ b/ext/spice/src/cspice/i_nint.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..94009b86e6 --- /dev/null +++ b/ext/spice/src/cspice/i_sign.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..914d9334d4 --- /dev/null +++ b/ext/spice/src/cspice/ident.c @@ -0,0 +1,139 @@ +/* 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 new file mode 100644 index 0000000000..71a36f9e8f --- /dev/null +++ b/ext/spice/src/cspice/ident_c.c @@ -0,0 +1,149 @@ +/* + +-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 new file mode 100644 index 0000000000..7d581d4a24 --- /dev/null +++ b/ext/spice/src/cspice/idw2at.c @@ -0,0 +1,385 @@ +/* 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 new file mode 100644 index 0000000000..58b2a75cdd --- /dev/null +++ b/ext/spice/src/cspice/iio.c @@ -0,0 +1,148 @@ +#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 new file mode 100644 index 0000000000..603b93ee58 --- /dev/null +++ b/ext/spice/src/cspice/illum.c @@ -0,0 +1,748 @@ +/* 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 new file mode 100644 index 0000000000..5e73751d79 --- /dev/null +++ b/ext/spice/src/cspice/illum_c.c @@ -0,0 +1,625 @@ +/* + +-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 new file mode 100644 index 0000000000..aff3831534 --- /dev/null +++ b/ext/spice/src/cspice/ilnw.c @@ -0,0 +1,77 @@ +#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 new file mode 100644 index 0000000000..85147773d4 --- /dev/null +++ b/ext/spice/src/cspice/ilumin.c @@ -0,0 +1,1396 @@ +/* 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 new file mode 100644 index 0000000000..1d5e9cc974 --- /dev/null +++ b/ext/spice/src/cspice/ilumin_c.c @@ -0,0 +1,800 @@ +/* + +-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 new file mode 100644 index 0000000000..913c6b023b --- /dev/null +++ b/ext/spice/src/cspice/inedpl.c @@ -0,0 +1,521 @@ +/* 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 new file mode 100644 index 0000000000..c18a3938a8 --- /dev/null +++ b/ext/spice/src/cspice/inedpl_c.c @@ -0,0 +1,459 @@ +/* + +-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 new file mode 100644 index 0000000000..f59373f1d6 --- /dev/null +++ b/ext/spice/src/cspice/inelpl.c @@ -0,0 +1,565 @@ +/* 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 new file mode 100644 index 0000000000..7919079d03 --- /dev/null +++ b/ext/spice/src/cspice/inelpl_c.c @@ -0,0 +1,585 @@ +/* + +-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 new file mode 100644 index 0000000000..29491659a6 --- /dev/null +++ b/ext/spice/src/cspice/inquire.c @@ -0,0 +1,106 @@ +#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 new file mode 100644 index 0000000000..6913825940 --- /dev/null +++ b/ext/spice/src/cspice/inrypl.c @@ -0,0 +1,791 @@ +/* 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 new file mode 100644 index 0000000000..cb6ebd004e --- /dev/null +++ b/ext/spice/src/cspice/inrypl_c.c @@ -0,0 +1,838 @@ +/* + +-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 new file mode 100644 index 0000000000..1722affc06 --- /dev/null +++ b/ext/spice/src/cspice/inslac.c @@ -0,0 +1,267 @@ +/* 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 new file mode 100644 index 0000000000..26437fef3c --- /dev/null +++ b/ext/spice/src/cspice/inslad.c @@ -0,0 +1,259 @@ +/* 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 new file mode 100644 index 0000000000..ec64abd0c3 --- /dev/null +++ b/ext/spice/src/cspice/inslai.c @@ -0,0 +1,259 @@ +/* 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 new file mode 100644 index 0000000000..b86749e6db --- /dev/null +++ b/ext/spice/src/cspice/insrtc.c @@ -0,0 +1,270 @@ +/* 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 new file mode 100644 index 0000000000..cde781fa8e --- /dev/null +++ b/ext/spice/src/cspice/insrtc_c.c @@ -0,0 +1,307 @@ +/* + +-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 new file mode 100644 index 0000000000..c7c78e0099 --- /dev/null +++ b/ext/spice/src/cspice/insrtd.c @@ -0,0 +1,236 @@ +/* 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 new file mode 100644 index 0000000000..ca51b983ff --- /dev/null +++ b/ext/spice/src/cspice/insrtd_c.c @@ -0,0 +1,261 @@ +/* + +-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 new file mode 100644 index 0000000000..fc0d10d829 --- /dev/null +++ b/ext/spice/src/cspice/insrti.c @@ -0,0 +1,236 @@ +/* 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 new file mode 100644 index 0000000000..5b45c5aa9f --- /dev/null +++ b/ext/spice/src/cspice/insrti_c.c @@ -0,0 +1,242 @@ +/* + +-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 new file mode 100644 index 0000000000..e246ebed9b --- /dev/null +++ b/ext/spice/src/cspice/inssub.c @@ -0,0 +1,303 @@ +/* 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 new file mode 100644 index 0000000000..6c06971793 --- /dev/null +++ b/ext/spice/src/cspice/int2hx.c @@ -0,0 +1,334 @@ +/* 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 new file mode 100644 index 0000000000..54bb1c813c --- /dev/null +++ b/ext/spice/src/cspice/inter_c.c @@ -0,0 +1,350 @@ +/* + +-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 new file mode 100644 index 0000000000..2752522b38 --- /dev/null +++ b/ext/spice/src/cspice/interc.c @@ -0,0 +1,297 @@ +/* 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 new file mode 100644 index 0000000000..32cc292a84 --- /dev/null +++ b/ext/spice/src/cspice/interd.c @@ -0,0 +1,252 @@ +/* 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 new file mode 100644 index 0000000000..380ccf86c3 --- /dev/null +++ b/ext/spice/src/cspice/interi.c @@ -0,0 +1,252 @@ +/* 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 new file mode 100644 index 0000000000..b2e9b44d89 --- /dev/null +++ b/ext/spice/src/cspice/intmax.c @@ -0,0 +1,255 @@ +/* + +-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 new file mode 100644 index 0000000000..bc2dfc8804 --- /dev/null +++ b/ext/spice/src/cspice/intmax_c.c @@ -0,0 +1,209 @@ +/* + +-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 new file mode 100644 index 0000000000..c145dcddb9 --- /dev/null +++ b/ext/spice/src/cspice/intmin.c @@ -0,0 +1,257 @@ +/* + +-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 new file mode 100644 index 0000000000..350136c41b --- /dev/null +++ b/ext/spice/src/cspice/intmin_c.c @@ -0,0 +1,204 @@ +/* + +-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 new file mode 100644 index 0000000000..6e10cf1357 --- /dev/null +++ b/ext/spice/src/cspice/intord.c @@ -0,0 +1,229 @@ +/* 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 new file mode 100644 index 0000000000..a3149c3c15 --- /dev/null +++ b/ext/spice/src/cspice/intstr.c @@ -0,0 +1,262 @@ +/* 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 new file mode 100644 index 0000000000..57221d1daa --- /dev/null +++ b/ext/spice/src/cspice/inttxt.c @@ -0,0 +1,291 @@ +/* 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 new file mode 100644 index 0000000000..98d324a7ab --- /dev/null +++ b/ext/spice/src/cspice/invert.c @@ -0,0 +1,195 @@ +/* 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 new file mode 100644 index 0000000000..94493079a6 --- /dev/null +++ b/ext/spice/src/cspice/invert_c.c @@ -0,0 +1,212 @@ +/* + +-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 new file mode 100644 index 0000000000..2d370ea260 --- /dev/null +++ b/ext/spice/src/cspice/invort.c @@ -0,0 +1,257 @@ +/* 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 new file mode 100644 index 0000000000..abb560fe21 --- /dev/null +++ b/ext/spice/src/cspice/invort_c.c @@ -0,0 +1,194 @@ +/* + +-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 new file mode 100644 index 0000000000..6429828478 --- /dev/null +++ b/ext/spice/src/cspice/invstm.c @@ -0,0 +1,219 @@ +/* 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 new file mode 100644 index 0000000000..6c468e872d --- /dev/null +++ b/ext/spice/src/cspice/ioerr.c @@ -0,0 +1,250 @@ +/* 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 new file mode 100644 index 0000000000..ccd786654c --- /dev/null +++ b/ext/spice/src/cspice/irftrn.c @@ -0,0 +1,206 @@ +/* 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 new file mode 100644 index 0000000000..94c19e93ab --- /dev/null +++ b/ext/spice/src/cspice/iso2utc.c @@ -0,0 +1,446 @@ +/* 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 new file mode 100644 index 0000000000..211c271b2b --- /dev/null +++ b/ext/spice/src/cspice/isopen.c @@ -0,0 +1,213 @@ +/* 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 new file mode 100644 index 0000000000..617d8bc6d7 --- /dev/null +++ b/ext/spice/src/cspice/isordv.c @@ -0,0 +1,297 @@ +/* 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 new file mode 100644 index 0000000000..bfcd813de8 --- /dev/null +++ b/ext/spice/src/cspice/isordv_c.c @@ -0,0 +1,245 @@ +/* + +-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 new file mode 100644 index 0000000000..3dd5221209 --- /dev/null +++ b/ext/spice/src/cspice/isrchc.c @@ -0,0 +1,155 @@ +/* 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 new file mode 100644 index 0000000000..02a2a44a78 --- /dev/null +++ b/ext/spice/src/cspice/isrchc_c.c @@ -0,0 +1,239 @@ +/* + +-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 new file mode 100644 index 0000000000..67f40700b0 --- /dev/null +++ b/ext/spice/src/cspice/isrchd.c @@ -0,0 +1,155 @@ +/* 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 new file mode 100644 index 0000000000..fa6b54ea86 --- /dev/null +++ b/ext/spice/src/cspice/isrchd_c.c @@ -0,0 +1,157 @@ +/* + +-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 new file mode 100644 index 0000000000..6b5d9caadd --- /dev/null +++ b/ext/spice/src/cspice/isrchi.c @@ -0,0 +1,150 @@ +/* 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 new file mode 100644 index 0000000000..c9c87fe899 --- /dev/null +++ b/ext/spice/src/cspice/isrchi_c.c @@ -0,0 +1,156 @@ +/* + +-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 new file mode 100644 index 0000000000..420bcae955 --- /dev/null +++ b/ext/spice/src/cspice/isrot.c @@ -0,0 +1,296 @@ +/* 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 new file mode 100644 index 0000000000..9a2faee576 --- /dev/null +++ b/ext/spice/src/cspice/isrot_c.c @@ -0,0 +1,285 @@ +/* + +-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 new file mode 100644 index 0000000000..9612ca9377 --- /dev/null +++ b/ext/spice/src/cspice/iswhsp_c.c @@ -0,0 +1,205 @@ +/* + +-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 new file mode 100644 index 0000000000..e718b5a74d --- /dev/null +++ b/ext/spice/src/cspice/j1900.c @@ -0,0 +1,126 @@ +/* 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 new file mode 100644 index 0000000000..93b5621949 --- /dev/null +++ b/ext/spice/src/cspice/j1900_c.c @@ -0,0 +1,120 @@ +/* + +-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 new file mode 100644 index 0000000000..c9a0e52499 --- /dev/null +++ b/ext/spice/src/cspice/j1950.c @@ -0,0 +1,126 @@ +/* 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 new file mode 100644 index 0000000000..db3773d4a3 --- /dev/null +++ b/ext/spice/src/cspice/j1950_c.c @@ -0,0 +1,120 @@ +/* + +-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 new file mode 100644 index 0000000000..cc6d97dad6 --- /dev/null +++ b/ext/spice/src/cspice/j2000.c @@ -0,0 +1,126 @@ +/* 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 new file mode 100644 index 0000000000..639667551a --- /dev/null +++ b/ext/spice/src/cspice/j2000_c.c @@ -0,0 +1,134 @@ +/* + +-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 new file mode 100644 index 0000000000..e8f0d03892 --- /dev/null +++ b/ext/spice/src/cspice/j2100.c @@ -0,0 +1,126 @@ +/* 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 new file mode 100644 index 0000000000..d678df7e50 --- /dev/null +++ b/ext/spice/src/cspice/j2100_c.c @@ -0,0 +1,122 @@ +/* + +-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 new file mode 100644 index 0000000000..85b9d85c13 --- /dev/null +++ b/ext/spice/src/cspice/jul2gr.c @@ -0,0 +1,796 @@ +/* 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 new file mode 100644 index 0000000000..0744aa8677 --- /dev/null +++ b/ext/spice/src/cspice/jyear.c @@ -0,0 +1,128 @@ +/* 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 new file mode 100644 index 0000000000..53a14c79f4 --- /dev/null +++ b/ext/spice/src/cspice/jyear_c.c @@ -0,0 +1,126 @@ +/* + +-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 new file mode 100644 index 0000000000..06849a183e --- /dev/null +++ b/ext/spice/src/cspice/kclear_c.c @@ -0,0 +1,163 @@ +/* + +-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 new file mode 100644 index 0000000000..8fa7937057 --- /dev/null +++ b/ext/spice/src/cspice/kdata_c.c @@ -0,0 +1,355 @@ +/* + +-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 new file mode 100644 index 0000000000..c554ba136d --- /dev/null +++ b/ext/spice/src/cspice/keeper.c @@ -0,0 +1,2812 @@ +/* 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 new file mode 100644 index 0000000000..68f0f21757 --- /dev/null +++ b/ext/spice/src/cspice/kepleq.c @@ -0,0 +1,234 @@ +/* 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 new file mode 100644 index 0000000000..a3dd328d4a --- /dev/null +++ b/ext/spice/src/cspice/kinfo_c.c @@ -0,0 +1,314 @@ +/* + +-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 new file mode 100644 index 0000000000..70200497d9 --- /dev/null +++ b/ext/spice/src/cspice/kpsolv.c @@ -0,0 +1,292 @@ +/* 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 new file mode 100644 index 0000000000..7aab4974eb --- /dev/null +++ b/ext/spice/src/cspice/ktotal_c.c @@ -0,0 +1,196 @@ +/* + +-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 new file mode 100644 index 0000000000..f05f975fe5 --- /dev/null +++ b/ext/spice/src/cspice/kxtrct.c @@ -0,0 +1,335 @@ +/* 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 new file mode 100644 index 0000000000..1ef41d66c4 --- /dev/null +++ b/ext/spice/src/cspice/kxtrct_c.c @@ -0,0 +1,385 @@ +/* + +-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 new file mode 100644 index 0000000000..86b4a1f5a7 --- /dev/null +++ b/ext/spice/src/cspice/l_ge.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..c4b52f5bf7 --- /dev/null +++ b/ext/spice/src/cspice/l_gt.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..f2740a2381 --- /dev/null +++ b/ext/spice/src/cspice/l_le.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..c48dc946f9 --- /dev/null +++ b/ext/spice/src/cspice/l_lt.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..72a9032b3d --- /dev/null +++ b/ext/spice/src/cspice/lastnb.c @@ -0,0 +1,162 @@ +/* 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 new file mode 100644 index 0000000000..0a071eb0d2 --- /dev/null +++ b/ext/spice/src/cspice/lastnb_c.c @@ -0,0 +1,173 @@ +/* + +-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 new file mode 100644 index 0000000000..c6561d9a43 --- /dev/null +++ b/ext/spice/src/cspice/lastpc.c @@ -0,0 +1,184 @@ +/* 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 new file mode 100644 index 0000000000..e1a955d28f --- /dev/null +++ b/ext/spice/src/cspice/latcyl.c @@ -0,0 +1,173 @@ +/* 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 new file mode 100644 index 0000000000..227b81e9b4 --- /dev/null +++ b/ext/spice/src/cspice/latcyl_c.c @@ -0,0 +1,170 @@ +/* + +-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 new file mode 100644 index 0000000000..a1e006bbde --- /dev/null +++ b/ext/spice/src/cspice/latrec.c @@ -0,0 +1,208 @@ +/* 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 new file mode 100644 index 0000000000..0551a9b2d7 --- /dev/null +++ b/ext/spice/src/cspice/latrec_c.c @@ -0,0 +1,188 @@ +/* + +-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 new file mode 100644 index 0000000000..5c19345764 --- /dev/null +++ b/ext/spice/src/cspice/latsph.c @@ -0,0 +1,178 @@ +/* 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 new file mode 100644 index 0000000000..5df1487d03 --- /dev/null +++ b/ext/spice/src/cspice/latsph_c.c @@ -0,0 +1,180 @@ +/* + +-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 new file mode 100644 index 0000000000..75e9f9c603 --- /dev/null +++ b/ext/spice/src/cspice/lbitbits.c @@ -0,0 +1,62 @@ +#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 new file mode 100644 index 0000000000..81b0fdbeab --- /dev/null +++ b/ext/spice/src/cspice/lbitshft.c @@ -0,0 +1,11 @@ +#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 new file mode 100644 index 0000000000..e3ab3f8efd --- /dev/null +++ b/ext/spice/src/cspice/lbuild.c @@ -0,0 +1,235 @@ +/* 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 new file mode 100644 index 0000000000..91b40fc4bb --- /dev/null +++ b/ext/spice/src/cspice/lcase.c @@ -0,0 +1,184 @@ +/* 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 new file mode 100644 index 0000000000..66cd69f70c --- /dev/null +++ b/ext/spice/src/cspice/lcase_c.c @@ -0,0 +1,218 @@ +/* + +-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 new file mode 100644 index 0000000000..a4f71f739f --- /dev/null +++ b/ext/spice/src/cspice/ldpool_c.c @@ -0,0 +1,203 @@ +/* + +-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 new file mode 100644 index 0000000000..a1f6674f2a --- /dev/null +++ b/ext/spice/src/cspice/lgresp.c @@ -0,0 +1,427 @@ +/* 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 new file mode 100644 index 0000000000..82e4b3925d --- /dev/null +++ b/ext/spice/src/cspice/lgrind.c @@ -0,0 +1,455 @@ +/* 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 new file mode 100644 index 0000000000..fcabf7c588 --- /dev/null +++ b/ext/spice/src/cspice/lgrint.c @@ -0,0 +1,392 @@ +/* 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 new file mode 100644 index 0000000000..012317206a --- /dev/null +++ b/ext/spice/src/cspice/lio.h @@ -0,0 +1,74 @@ +/* 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 new file mode 100644 index 0000000000..569acf869d --- /dev/null +++ b/ext/spice/src/cspice/ljust.c @@ -0,0 +1,173 @@ +/* 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 new file mode 100644 index 0000000000..8af64b2505 --- /dev/null +++ b/ext/spice/src/cspice/lmpool_c.c @@ -0,0 +1,260 @@ +/* + +-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 new file mode 100644 index 0000000000..85755a0686 --- /dev/null +++ b/ext/spice/src/cspice/lnkan.c @@ -0,0 +1,239 @@ +/* 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 new file mode 100644 index 0000000000..386d9d6b54 --- /dev/null +++ b/ext/spice/src/cspice/lnkfsl.c @@ -0,0 +1,376 @@ +/* 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 new file mode 100644 index 0000000000..59a662e69d --- /dev/null +++ b/ext/spice/src/cspice/lnkhl.c @@ -0,0 +1,255 @@ +/* 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 new file mode 100644 index 0000000000..ac0c019947 --- /dev/null +++ b/ext/spice/src/cspice/lnkila.c @@ -0,0 +1,317 @@ +/* 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 new file mode 100644 index 0000000000..e73fb723ba --- /dev/null +++ b/ext/spice/src/cspice/lnkilb.c @@ -0,0 +1,318 @@ +/* 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 new file mode 100644 index 0000000000..00179b05b3 --- /dev/null +++ b/ext/spice/src/cspice/lnkini.c @@ -0,0 +1,242 @@ +/* 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 new file mode 100644 index 0000000000..1245c17720 --- /dev/null +++ b/ext/spice/src/cspice/lnknfn.c @@ -0,0 +1,179 @@ +/* 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 new file mode 100644 index 0000000000..506dfbe0cb --- /dev/null +++ b/ext/spice/src/cspice/lnknxt.c @@ -0,0 +1,255 @@ +/* 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 new file mode 100644 index 0000000000..22a3f97f02 --- /dev/null +++ b/ext/spice/src/cspice/lnkprv.c @@ -0,0 +1,255 @@ +/* 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 new file mode 100644 index 0000000000..8965f84c6f --- /dev/null +++ b/ext/spice/src/cspice/lnksiz.c @@ -0,0 +1,170 @@ +/* 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 new file mode 100644 index 0000000000..227a235513 --- /dev/null +++ b/ext/spice/src/cspice/lnktl.c @@ -0,0 +1,267 @@ +/* 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 new file mode 100644 index 0000000000..c683b21ffa --- /dev/null +++ b/ext/spice/src/cspice/lnkxsl.c @@ -0,0 +1,366 @@ +/* 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 new file mode 100644 index 0000000000..2a834cfbdf --- /dev/null +++ b/ext/spice/src/cspice/locati.c @@ -0,0 +1,498 @@ +/* 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 new file mode 100644 index 0000000000..a233b3db1d --- /dev/null +++ b/ext/spice/src/cspice/locln.c @@ -0,0 +1,606 @@ +/* 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 new file mode 100644 index 0000000000..14490eb461 --- /dev/null +++ b/ext/spice/src/cspice/lparse.c @@ -0,0 +1,332 @@ +/* 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 new file mode 100644 index 0000000000..62052d24e7 --- /dev/null +++ b/ext/spice/src/cspice/lparse_c.c @@ -0,0 +1,300 @@ +/* + +-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 new file mode 100644 index 0000000000..21c838fb8d --- /dev/null +++ b/ext/spice/src/cspice/lparsm.c @@ -0,0 +1,350 @@ +/* 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 new file mode 100644 index 0000000000..afe570575a --- /dev/null +++ b/ext/spice/src/cspice/lparsm_c.c @@ -0,0 +1,295 @@ +/* + +-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 new file mode 100644 index 0000000000..63b0277052 --- /dev/null +++ b/ext/spice/src/cspice/lparss.c @@ -0,0 +1,487 @@ +/* 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 new file mode 100644 index 0000000000..91b2702f50 --- /dev/null +++ b/ext/spice/src/cspice/lparss_c.c @@ -0,0 +1,299 @@ +/* + +-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 new file mode 100644 index 0000000000..6f537a7ebf --- /dev/null +++ b/ext/spice/src/cspice/lread.c @@ -0,0 +1,700 @@ +#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 new file mode 100644 index 0000000000..7bd1f0d08a --- /dev/null +++ b/ext/spice/src/cspice/lspcn.c @@ -0,0 +1,404 @@ +/* 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 new file mode 100644 index 0000000000..d61d78f1e5 --- /dev/null +++ b/ext/spice/src/cspice/lspcn_c.c @@ -0,0 +1,314 @@ +/* + +-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 new file mode 100644 index 0000000000..8799efcf0f --- /dev/null +++ b/ext/spice/src/cspice/lstcld.c @@ -0,0 +1,247 @@ +/* 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 new file mode 100644 index 0000000000..514f7a8136 --- /dev/null +++ b/ext/spice/src/cspice/lstcli.c @@ -0,0 +1,232 @@ +/* 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 new file mode 100644 index 0000000000..31841d8a5a --- /dev/null +++ b/ext/spice/src/cspice/lstlec.c @@ -0,0 +1,267 @@ +/* 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 new file mode 100644 index 0000000000..42b7d613a5 --- /dev/null +++ b/ext/spice/src/cspice/lstlec_c.c @@ -0,0 +1,322 @@ +/* + +-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 new file mode 100644 index 0000000000..c3d83a615a --- /dev/null +++ b/ext/spice/src/cspice/lstled.c @@ -0,0 +1,227 @@ +/* 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 new file mode 100644 index 0000000000..3fe7cd5152 --- /dev/null +++ b/ext/spice/src/cspice/lstled_c.c @@ -0,0 +1,178 @@ +/* + +-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 new file mode 100644 index 0000000000..b788911e83 --- /dev/null +++ b/ext/spice/src/cspice/lstlei.c @@ -0,0 +1,307 @@ +/* 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 new file mode 100644 index 0000000000..51ee6b3c3a --- /dev/null +++ b/ext/spice/src/cspice/lstlei_c.c @@ -0,0 +1,178 @@ +/* + +-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 new file mode 100644 index 0000000000..24d70a1b8a --- /dev/null +++ b/ext/spice/src/cspice/lstltc.c @@ -0,0 +1,264 @@ +/* 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 new file mode 100644 index 0000000000..207a581a03 --- /dev/null +++ b/ext/spice/src/cspice/lstltc_c.c @@ -0,0 +1,325 @@ +/* + +-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 new file mode 100644 index 0000000000..a12f7cb122 --- /dev/null +++ b/ext/spice/src/cspice/lstltd.c @@ -0,0 +1,224 @@ +/* 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 new file mode 100644 index 0000000000..d84364e5ce --- /dev/null +++ b/ext/spice/src/cspice/lstltd_c.c @@ -0,0 +1,178 @@ +/* + +-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 new file mode 100644 index 0000000000..6bb5abe475 --- /dev/null +++ b/ext/spice/src/cspice/lstlti.c @@ -0,0 +1,305 @@ +/* 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 new file mode 100644 index 0000000000..61e9a374d4 --- /dev/null +++ b/ext/spice/src/cspice/lstlti_c.c @@ -0,0 +1,179 @@ +/* + +-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 new file mode 100644 index 0000000000..d4e0c389f0 --- /dev/null +++ b/ext/spice/src/cspice/ltime.c @@ -0,0 +1,367 @@ +/* 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 new file mode 100644 index 0000000000..71e9bd1060 --- /dev/null +++ b/ext/spice/src/cspice/ltime_c.c @@ -0,0 +1,318 @@ +/* + +-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 new file mode 100644 index 0000000000..1b525d1e07 --- /dev/null +++ b/ext/spice/src/cspice/ltrim.c @@ -0,0 +1,164 @@ +/* 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 new file mode 100644 index 0000000000..63d7d7ab4a --- /dev/null +++ b/ext/spice/src/cspice/lun2fn.c @@ -0,0 +1,214 @@ +/* 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 new file mode 100644 index 0000000000..bf209f47ed --- /dev/null +++ b/ext/spice/src/cspice/lwrite.c @@ -0,0 +1,302 @@ +#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 new file mode 100644 index 0000000000..b1847f0864 --- /dev/null +++ b/ext/spice/src/cspice/lx4dec.c @@ -0,0 +1,281 @@ +/* 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 new file mode 100644 index 0000000000..7e575c3d82 --- /dev/null +++ b/ext/spice/src/cspice/lx4dec_c.c @@ -0,0 +1,254 @@ +/* + +-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 new file mode 100644 index 0000000000..b843a38f5b --- /dev/null +++ b/ext/spice/src/cspice/lx4num.c @@ -0,0 +1,219 @@ +/* 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 new file mode 100644 index 0000000000..f6ad752bc0 --- /dev/null +++ b/ext/spice/src/cspice/lx4num_c.c @@ -0,0 +1,243 @@ +/* + +-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 new file mode 100644 index 0000000000..3733ce204a --- /dev/null +++ b/ext/spice/src/cspice/lx4sgn.c @@ -0,0 +1,210 @@ +/* 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 new file mode 100644 index 0000000000..3ade124232 --- /dev/null +++ b/ext/spice/src/cspice/lx4sgn_c.c @@ -0,0 +1,242 @@ +/* + +-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 new file mode 100644 index 0000000000..07f9b213ca --- /dev/null +++ b/ext/spice/src/cspice/lx4uns.c @@ -0,0 +1,256 @@ +/* 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 new file mode 100644 index 0000000000..e147c7dbc2 --- /dev/null +++ b/ext/spice/src/cspice/lx4uns_c.c @@ -0,0 +1,237 @@ +/* + +-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 new file mode 100644 index 0000000000..9f20111c9d --- /dev/null +++ b/ext/spice/src/cspice/lxname.c @@ -0,0 +1,1002 @@ +/* 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 new file mode 100644 index 0000000000..b9b56fe2e3 --- /dev/null +++ b/ext/spice/src/cspice/lxqstr.c @@ -0,0 +1,329 @@ +/* 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 new file mode 100644 index 0000000000..c3490d9f2d --- /dev/null +++ b/ext/spice/src/cspice/lxqstr_c.c @@ -0,0 +1,293 @@ +/* + +-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 new file mode 100644 index 0000000000..348e6fc131 --- /dev/null +++ b/ext/spice/src/cspice/m2eul.c @@ -0,0 +1,954 @@ +/* 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 new file mode 100644 index 0000000000..b81dfd7e40 --- /dev/null +++ b/ext/spice/src/cspice/m2eul_c.c @@ -0,0 +1,501 @@ +/* + +-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 new file mode 100644 index 0000000000..5d69feb4ac --- /dev/null +++ b/ext/spice/src/cspice/m2q.c @@ -0,0 +1,632 @@ +/* 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 new file mode 100644 index 0000000000..7544417fc2 --- /dev/null +++ b/ext/spice/src/cspice/m2q_c.c @@ -0,0 +1,486 @@ +/* + +-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 new file mode 100644 index 0000000000..0b7549389d --- /dev/null +++ b/ext/spice/src/cspice/matchi.c @@ -0,0 +1,405 @@ +/* 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 new file mode 100644 index 0000000000..ce86f6862d --- /dev/null +++ b/ext/spice/src/cspice/matchi_c.c @@ -0,0 +1,204 @@ +/* + +-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 new file mode 100644 index 0000000000..a2c34aa4bf --- /dev/null +++ b/ext/spice/src/cspice/matchw.c @@ -0,0 +1,431 @@ +/* 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 new file mode 100644 index 0000000000..c9d83bc4ea --- /dev/null +++ b/ext/spice/src/cspice/matchw_c.c @@ -0,0 +1,204 @@ +/* + +-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 new file mode 100644 index 0000000000..a45f1b561b --- /dev/null +++ b/ext/spice/src/cspice/maxac.c @@ -0,0 +1,182 @@ +/* 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 new file mode 100644 index 0000000000..a81e103319 --- /dev/null +++ b/ext/spice/src/cspice/maxad.c @@ -0,0 +1,172 @@ +/* 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 new file mode 100644 index 0000000000..6dab0c2407 --- /dev/null +++ b/ext/spice/src/cspice/maxai.c @@ -0,0 +1,172 @@ +/* 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 new file mode 100644 index 0000000000..4ebc2abde4 --- /dev/null +++ b/ext/spice/src/cspice/maxd_c.c @@ -0,0 +1,234 @@ +/* + +-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 new file mode 100644 index 0000000000..7c7af65146 --- /dev/null +++ b/ext/spice/src/cspice/maxi_c.c @@ -0,0 +1,233 @@ +/* + +-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 new file mode 100644 index 0000000000..f7da20a211 --- /dev/null +++ b/ext/spice/src/cspice/mequ.c @@ -0,0 +1,139 @@ +/* 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 new file mode 100644 index 0000000000..2d44d7287c --- /dev/null +++ b/ext/spice/src/cspice/mequ_c.c @@ -0,0 +1,137 @@ +/* + +-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 new file mode 100644 index 0000000000..4f0cfbda7b --- /dev/null +++ b/ext/spice/src/cspice/mequg.c @@ -0,0 +1,157 @@ +/* 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 new file mode 100644 index 0000000000..82a17b884b --- /dev/null +++ b/ext/spice/src/cspice/mequg_c.c @@ -0,0 +1,154 @@ +/* + +-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 new file mode 100644 index 0000000000..86f970dc1a --- /dev/null +++ b/ext/spice/src/cspice/minac.c @@ -0,0 +1,182 @@ +/* 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 new file mode 100644 index 0000000000..7ae0b07984 --- /dev/null +++ b/ext/spice/src/cspice/minad.c @@ -0,0 +1,169 @@ +/* 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 new file mode 100644 index 0000000000..6a3da42eda --- /dev/null +++ b/ext/spice/src/cspice/minai.c @@ -0,0 +1,169 @@ +/* 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 new file mode 100644 index 0000000000..299cbb0c42 --- /dev/null +++ b/ext/spice/src/cspice/mind_c.c @@ -0,0 +1,234 @@ +/* + +-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 new file mode 100644 index 0000000000..7c1996f508 --- /dev/null +++ b/ext/spice/src/cspice/mini_c.c @@ -0,0 +1,233 @@ +/* + +-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 new file mode 100644 index 0000000000..e08a643dad --- /dev/null +++ b/ext/spice/src/cspice/mkprodct.csh @@ -0,0 +1,318 @@ +#! /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 new file mode 100644 index 0000000000..98b4335ce9 --- /dev/null +++ b/ext/spice/src/cspice/movec.c @@ -0,0 +1,169 @@ +/* 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 new file mode 100644 index 0000000000..c34fafd85d --- /dev/null +++ b/ext/spice/src/cspice/moved.c @@ -0,0 +1,152 @@ +/* + +-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 new file mode 100644 index 0000000000..89c0b106d3 --- /dev/null +++ b/ext/spice/src/cspice/movei.c @@ -0,0 +1,164 @@ +/* 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 new file mode 100644 index 0000000000..1c32d5e6ed --- /dev/null +++ b/ext/spice/src/cspice/mtxm.c @@ -0,0 +1,203 @@ +/* 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 new file mode 100644 index 0000000000..4c3cb723db --- /dev/null +++ b/ext/spice/src/cspice/mtxm_c.c @@ -0,0 +1,200 @@ +/* + +-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 new file mode 100644 index 0000000000..8696eac091 --- /dev/null +++ b/ext/spice/src/cspice/mtxmg.c @@ -0,0 +1,232 @@ +/* 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 new file mode 100644 index 0000000000..ead1bd2ad6 --- /dev/null +++ b/ext/spice/src/cspice/mtxmg_c.c @@ -0,0 +1,299 @@ +/* + +-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 new file mode 100644 index 0000000000..1ec3c7eafe --- /dev/null +++ b/ext/spice/src/cspice/mtxv.c @@ -0,0 +1,199 @@ +/* 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 new file mode 100644 index 0000000000..f744c094a0 --- /dev/null +++ b/ext/spice/src/cspice/mtxv_c.c @@ -0,0 +1,186 @@ +/* + +-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 new file mode 100644 index 0000000000..ac304d74af --- /dev/null +++ b/ext/spice/src/cspice/mtxvg.c @@ -0,0 +1,204 @@ +/* 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 new file mode 100644 index 0000000000..0ee741eb15 --- /dev/null +++ b/ext/spice/src/cspice/mtxvg_c.c @@ -0,0 +1,277 @@ +/* + +-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 new file mode 100644 index 0000000000..0008cb90f9 --- /dev/null +++ b/ext/spice/src/cspice/mxm.c @@ -0,0 +1,191 @@ +/* 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 new file mode 100644 index 0000000000..428cd16bea --- /dev/null +++ b/ext/spice/src/cspice/mxm_c.c @@ -0,0 +1,183 @@ +/* + +-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 new file mode 100644 index 0000000000..5dc64c4b3a --- /dev/null +++ b/ext/spice/src/cspice/mxmg.c @@ -0,0 +1,216 @@ +/* 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 new file mode 100644 index 0000000000..fc006d484b --- /dev/null +++ b/ext/spice/src/cspice/mxmg_c.c @@ -0,0 +1,305 @@ +/* + +-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 new file mode 100644 index 0000000000..c2f731e0b0 --- /dev/null +++ b/ext/spice/src/cspice/mxmt.c @@ -0,0 +1,203 @@ +/* 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 new file mode 100644 index 0000000000..bb3dfb8e5b --- /dev/null +++ b/ext/spice/src/cspice/mxmt_c.c @@ -0,0 +1,201 @@ +/* + +-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 new file mode 100644 index 0000000000..dfca9f4596 --- /dev/null +++ b/ext/spice/src/cspice/mxmtg.c @@ -0,0 +1,233 @@ +/* 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 new file mode 100644 index 0000000000..4693b24508 --- /dev/null +++ b/ext/spice/src/cspice/mxmtg_c.c @@ -0,0 +1,323 @@ +/* + +-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 new file mode 100644 index 0000000000..9da5c7b191 --- /dev/null +++ b/ext/spice/src/cspice/mxv.c @@ -0,0 +1,179 @@ +/* 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 new file mode 100644 index 0000000000..891d358e83 --- /dev/null +++ b/ext/spice/src/cspice/mxv_c.c @@ -0,0 +1,167 @@ +/* + +-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 new file mode 100644 index 0000000000..19a7fe7fe0 --- /dev/null +++ b/ext/spice/src/cspice/mxvg.c @@ -0,0 +1,187 @@ +/* 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 new file mode 100644 index 0000000000..c0b768b1ac --- /dev/null +++ b/ext/spice/src/cspice/mxvg_c.c @@ -0,0 +1,276 @@ +/* + +-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 new file mode 100644 index 0000000000..edd94bd608 --- /dev/null +++ b/ext/spice/src/cspice/namfrm_c.c @@ -0,0 +1,190 @@ +/* + +-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 new file mode 100644 index 0000000000..6f8f7475fa --- /dev/null +++ b/ext/spice/src/cspice/nblen.c @@ -0,0 +1,145 @@ +/* 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 new file mode 100644 index 0000000000..f44e3ea813 --- /dev/null +++ b/ext/spice/src/cspice/nbwid.c @@ -0,0 +1,191 @@ +/* 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 new file mode 100644 index 0000000000..3589cb32e1 --- /dev/null +++ b/ext/spice/src/cspice/ncpos.c @@ -0,0 +1,217 @@ +/* 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 new file mode 100644 index 0000000000..9af50cd446 --- /dev/null +++ b/ext/spice/src/cspice/ncpos_c.c @@ -0,0 +1,229 @@ +/* + +-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 new file mode 100644 index 0000000000..f8687d41be --- /dev/null +++ b/ext/spice/src/cspice/ncposr.c @@ -0,0 +1,216 @@ +/* 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 new file mode 100644 index 0000000000..5fb38b3c81 --- /dev/null +++ b/ext/spice/src/cspice/ncposr_c.c @@ -0,0 +1,231 @@ +/* + +-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 new file mode 100644 index 0000000000..a23290f4fc --- /dev/null +++ b/ext/spice/src/cspice/nearpt.c @@ -0,0 +1,1794 @@ +/* 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 new file mode 100644 index 0000000000..5d61c9cb72 --- /dev/null +++ b/ext/spice/src/cspice/nearpt_c.c @@ -0,0 +1,295 @@ +/* + +-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 new file mode 100644 index 0000000000..25e436f6b9 --- /dev/null +++ b/ext/spice/src/cspice/nextwd.c @@ -0,0 +1,259 @@ +/* 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 new file mode 100644 index 0000000000..a4fb67fdd1 --- /dev/null +++ b/ext/spice/src/cspice/notru.c @@ -0,0 +1,152 @@ +/* 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 new file mode 100644 index 0000000000..e6b8d8d1e8 --- /dev/null +++ b/ext/spice/src/cspice/nparsd.c @@ -0,0 +1,1072 @@ +/* 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 new file mode 100644 index 0000000000..840f6997c7 --- /dev/null +++ b/ext/spice/src/cspice/nparsi.c @@ -0,0 +1,341 @@ +/* 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 new file mode 100644 index 0000000000..35608381a5 --- /dev/null +++ b/ext/spice/src/cspice/npedln.c @@ -0,0 +1,597 @@ +/* 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 new file mode 100644 index 0000000000..f42bb35143 --- /dev/null +++ b/ext/spice/src/cspice/npedln_c.c @@ -0,0 +1,564 @@ +/* + +-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 new file mode 100644 index 0000000000..b291309a49 --- /dev/null +++ b/ext/spice/src/cspice/npelpt.c @@ -0,0 +1,367 @@ +/* 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 new file mode 100644 index 0000000000..b8780c1313 --- /dev/null +++ b/ext/spice/src/cspice/npelpt_c.c @@ -0,0 +1,352 @@ +/* + +-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 new file mode 100644 index 0000000000..6ffe69a84e --- /dev/null +++ b/ext/spice/src/cspice/nplnpt.c @@ -0,0 +1,221 @@ +/* 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 new file mode 100644 index 0000000000..aca1b41e6e --- /dev/null +++ b/ext/spice/src/cspice/nplnpt_c.c @@ -0,0 +1,202 @@ +/* + +-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 new file mode 100644 index 0000000000..4b50e54810 --- /dev/null +++ b/ext/spice/src/cspice/nthwd.c @@ -0,0 +1,258 @@ +/* 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 new file mode 100644 index 0000000000..3ad2dabb5a --- /dev/null +++ b/ext/spice/src/cspice/nvc2pl.c @@ -0,0 +1,273 @@ +/* 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 new file mode 100644 index 0000000000..890d9e1f8f --- /dev/null +++ b/ext/spice/src/cspice/nvc2pl_c.c @@ -0,0 +1,254 @@ +/* + +-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 new file mode 100644 index 0000000000..1b0b008db2 --- /dev/null +++ b/ext/spice/src/cspice/nvp2pl.c @@ -0,0 +1,242 @@ +/* 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 new file mode 100644 index 0000000000..7c01d2ed70 --- /dev/null +++ b/ext/spice/src/cspice/nvp2pl_c.c @@ -0,0 +1,210 @@ +/* + +-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 new file mode 100644 index 0000000000..6e60f6d992 --- /dev/null +++ b/ext/spice/src/cspice/odd.c @@ -0,0 +1,150 @@ +/* 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 new file mode 100644 index 0000000000..fcff7da016 --- /dev/null +++ b/ext/spice/src/cspice/open.c @@ -0,0 +1,449 @@ +/* + +-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 new file mode 100644 index 0000000000..3c13a0be13 --- /dev/null +++ b/ext/spice/src/cspice/opsgnd.c @@ -0,0 +1,145 @@ +/* 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 new file mode 100644 index 0000000000..ceac711dbf --- /dev/null +++ b/ext/spice/src/cspice/opsgni.c @@ -0,0 +1,150 @@ +/* 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 new file mode 100644 index 0000000000..a0849214ba --- /dev/null +++ b/ext/spice/src/cspice/ordc.c @@ -0,0 +1,221 @@ +/* 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 new file mode 100644 index 0000000000..8dee6496e2 --- /dev/null +++ b/ext/spice/src/cspice/ordc_c.c @@ -0,0 +1,269 @@ +/* + +-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 new file mode 100644 index 0000000000..e2bfb4bb8f --- /dev/null +++ b/ext/spice/src/cspice/ordd.c @@ -0,0 +1,222 @@ +/* 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 new file mode 100644 index 0000000000..f0fb3c41ed --- /dev/null +++ b/ext/spice/src/cspice/ordd_c.c @@ -0,0 +1,255 @@ +/* + +-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 new file mode 100644 index 0000000000..b7dbad17b6 --- /dev/null +++ b/ext/spice/src/cspice/orderc.c @@ -0,0 +1,186 @@ +/* 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 new file mode 100644 index 0000000000..791bc37212 --- /dev/null +++ b/ext/spice/src/cspice/orderc_c.c @@ -0,0 +1,245 @@ +/* + +-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 new file mode 100644 index 0000000000..e29eb64594 --- /dev/null +++ b/ext/spice/src/cspice/orderd.c @@ -0,0 +1,189 @@ +/* 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 new file mode 100644 index 0000000000..57fac9c91b --- /dev/null +++ b/ext/spice/src/cspice/orderd_c.c @@ -0,0 +1,178 @@ +/* + +-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 new file mode 100644 index 0000000000..83f84a157e --- /dev/null +++ b/ext/spice/src/cspice/orderi.c @@ -0,0 +1,188 @@ +/* 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 new file mode 100644 index 0000000000..df3b0e5a51 --- /dev/null +++ b/ext/spice/src/cspice/orderi_c.c @@ -0,0 +1,181 @@ +/* + +-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 new file mode 100644 index 0000000000..0e9fdcf05f --- /dev/null +++ b/ext/spice/src/cspice/ordi.c @@ -0,0 +1,221 @@ +/* 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 new file mode 100644 index 0000000000..924dc377d8 --- /dev/null +++ b/ext/spice/src/cspice/ordi_c.c @@ -0,0 +1,253 @@ +/* + +-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 new file mode 100644 index 0000000000..19dd186b05 --- /dev/null +++ b/ext/spice/src/cspice/oscelt.c @@ -0,0 +1,674 @@ +/* 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 new file mode 100644 index 0000000000..a6a5d7c346 --- /dev/null +++ b/ext/spice/src/cspice/oscelt_c.c @@ -0,0 +1,281 @@ +/* + +-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 new file mode 100644 index 0000000000..21b3c0e559 --- /dev/null +++ b/ext/spice/src/cspice/outmsg.c @@ -0,0 +1,944 @@ +/* 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 new file mode 100644 index 0000000000..c04b64eb1c --- /dev/null +++ b/ext/spice/src/cspice/packac.c @@ -0,0 +1,254 @@ +/* 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 new file mode 100644 index 0000000000..dd29d8bae2 --- /dev/null +++ b/ext/spice/src/cspice/packad.c @@ -0,0 +1,248 @@ +/* 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 new file mode 100644 index 0000000000..815af4aa26 --- /dev/null +++ b/ext/spice/src/cspice/packai.c @@ -0,0 +1,250 @@ +/* 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 new file mode 100644 index 0000000000..2aa993e768 --- /dev/null +++ b/ext/spice/src/cspice/parsqs.c @@ -0,0 +1,413 @@ +/* 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 new file mode 100644 index 0000000000..efb4e6197d --- /dev/null +++ b/ext/spice/src/cspice/partof.c @@ -0,0 +1,227 @@ +/* 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 new file mode 100644 index 0000000000..4354441129 --- /dev/null +++ b/ext/spice/src/cspice/pck03a.c @@ -0,0 +1,374 @@ +/* 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 new file mode 100644 index 0000000000..ceed7e7bf6 --- /dev/null +++ b/ext/spice/src/cspice/pck03b.c @@ -0,0 +1,827 @@ +/* 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 new file mode 100644 index 0000000000..8d99147ba2 --- /dev/null +++ b/ext/spice/src/cspice/pck03e.c @@ -0,0 +1,334 @@ +/* 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 new file mode 100644 index 0000000000..6df5957f00 --- /dev/null +++ b/ext/spice/src/cspice/pckbsr.c @@ -0,0 +1,3012 @@ +/* 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 new file mode 100644 index 0000000000..4e3afb044c --- /dev/null +++ b/ext/spice/src/cspice/pckcls.c @@ -0,0 +1,203 @@ +/* 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 new file mode 100644 index 0000000000..f2c4f829d2 --- /dev/null +++ b/ext/spice/src/cspice/pckcov.c @@ -0,0 +1,574 @@ +/* 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 new file mode 100644 index 0000000000..74565c5298 --- /dev/null +++ b/ext/spice/src/cspice/pckcov_c.c @@ -0,0 +1,473 @@ +/* + +-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 new file mode 100644 index 0000000000..cc60779d49 --- /dev/null +++ b/ext/spice/src/cspice/pcke02.c @@ -0,0 +1,219 @@ +/* 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 new file mode 100644 index 0000000000..91cc1640dd --- /dev/null +++ b/ext/spice/src/cspice/pcke03.c @@ -0,0 +1,408 @@ +/* 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 new file mode 100644 index 0000000000..cca170761a --- /dev/null +++ b/ext/spice/src/cspice/pckeul.c @@ -0,0 +1,254 @@ +/* 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 new file mode 100644 index 0000000000..66cf72bcff --- /dev/null +++ b/ext/spice/src/cspice/pckfrm.c @@ -0,0 +1,415 @@ +/* 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 new file mode 100644 index 0000000000..22a98073ba --- /dev/null +++ b/ext/spice/src/cspice/pckfrm_c.c @@ -0,0 +1,328 @@ +/* + +-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 new file mode 100644 index 0000000000..bb13352847 --- /dev/null +++ b/ext/spice/src/cspice/pcklof_c.c @@ -0,0 +1,181 @@ +/* + +-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 new file mode 100644 index 0000000000..a7f1ab3e48 --- /dev/null +++ b/ext/spice/src/cspice/pckmat.c @@ -0,0 +1,393 @@ +/* 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 new file mode 100644 index 0000000000..c717a605a6 --- /dev/null +++ b/ext/spice/src/cspice/pckopn.c @@ -0,0 +1,213 @@ +/* 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 new file mode 100644 index 0000000000..c06a12d558 --- /dev/null +++ b/ext/spice/src/cspice/pckpds.c @@ -0,0 +1,260 @@ +/* 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 new file mode 100644 index 0000000000..186ceceaa1 --- /dev/null +++ b/ext/spice/src/cspice/pckr02.c @@ -0,0 +1,227 @@ +/* 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 new file mode 100644 index 0000000000..48fb2716d9 --- /dev/null +++ b/ext/spice/src/cspice/pckr03.c @@ -0,0 +1,236 @@ +/* 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 new file mode 100644 index 0000000000..741442b3c5 --- /dev/null +++ b/ext/spice/src/cspice/pckuds.c @@ -0,0 +1,203 @@ +/* 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 new file mode 100644 index 0000000000..cc9e1a226e --- /dev/null +++ b/ext/spice/src/cspice/pckuof_c.c @@ -0,0 +1,150 @@ +/* + +-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 new file mode 100644 index 0000000000..ab00a97cd2 --- /dev/null +++ b/ext/spice/src/cspice/pckw02.c @@ -0,0 +1,487 @@ +/* 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 new file mode 100644 index 0000000000..aaf33a0938 --- /dev/null +++ b/ext/spice/src/cspice/pcpool_c.c @@ -0,0 +1,326 @@ +/* + +-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 new file mode 100644 index 0000000000..33455883ca --- /dev/null +++ b/ext/spice/src/cspice/pcwid.c @@ -0,0 +1,197 @@ +/* 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 new file mode 100644 index 0000000000..9fff32ce03 --- /dev/null +++ b/ext/spice/src/cspice/pdpool_c.c @@ -0,0 +1,270 @@ +/* + +-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 new file mode 100644 index 0000000000..7ee4fd1184 --- /dev/null +++ b/ext/spice/src/cspice/pgrrec.c @@ -0,0 +1,614 @@ +/* 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 new file mode 100644 index 0000000000..9e29135a9e --- /dev/null +++ b/ext/spice/src/cspice/pgrrec_c.c @@ -0,0 +1,521 @@ +/* + +-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 new file mode 100644 index 0000000000..8959ba4cf5 --- /dev/null +++ b/ext/spice/src/cspice/pi.c @@ -0,0 +1,159 @@ +/* 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 new file mode 100644 index 0000000000..bf10fc6d73 --- /dev/null +++ b/ext/spice/src/cspice/pi_c.c @@ -0,0 +1,148 @@ +/* + +-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 new file mode 100644 index 0000000000..0ffb95091b --- /dev/null +++ b/ext/spice/src/cspice/pipool_c.c @@ -0,0 +1,269 @@ +/* + +-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 new file mode 100644 index 0000000000..c378ecf100 --- /dev/null +++ b/ext/spice/src/cspice/pjelpl.c @@ -0,0 +1,367 @@ +/* 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 new file mode 100644 index 0000000000..923f0e17c5 --- /dev/null +++ b/ext/spice/src/cspice/pjelpl_c.c @@ -0,0 +1,386 @@ +/* + +-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 new file mode 100644 index 0000000000..47afff3974 --- /dev/null +++ b/ext/spice/src/cspice/pl2nvc.c @@ -0,0 +1,228 @@ +/* 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 new file mode 100644 index 0000000000..cb16451f66 --- /dev/null +++ b/ext/spice/src/cspice/pl2nvc_c.c @@ -0,0 +1,224 @@ +/* + +-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 new file mode 100644 index 0000000000..cd4a25f865 --- /dev/null +++ b/ext/spice/src/cspice/pl2nvp.c @@ -0,0 +1,175 @@ +/* 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 new file mode 100644 index 0000000000..b5c68d693e --- /dev/null +++ b/ext/spice/src/cspice/pl2nvp_c.c @@ -0,0 +1,173 @@ +/* + +-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 new file mode 100644 index 0000000000..5556febd62 --- /dev/null +++ b/ext/spice/src/cspice/pl2psv.c @@ -0,0 +1,294 @@ +/* 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 new file mode 100644 index 0000000000..60db83bff5 --- /dev/null +++ b/ext/spice/src/cspice/pl2psv_c.c @@ -0,0 +1,288 @@ +/* + +-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 new file mode 100644 index 0000000000..035dfb78c2 --- /dev/null +++ b/ext/spice/src/cspice/plnsns.c @@ -0,0 +1,241 @@ +/* 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 new file mode 100644 index 0000000000..f628f5772d --- /dev/null +++ b/ext/spice/src/cspice/polyds.c @@ -0,0 +1,311 @@ +/* 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 new file mode 100644 index 0000000000..ccebe1716c --- /dev/null +++ b/ext/spice/src/cspice/pool.c @@ -0,0 +1,8085 @@ +/* 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 new file mode 100644 index 0000000000..820e1532be --- /dev/null +++ b/ext/spice/src/cspice/pos.c @@ -0,0 +1,220 @@ +/* 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 new file mode 100644 index 0000000000..4b43662723 --- /dev/null +++ b/ext/spice/src/cspice/pos_c.c @@ -0,0 +1,228 @@ +/* + +-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 new file mode 100644 index 0000000000..89cf00589d --- /dev/null +++ b/ext/spice/src/cspice/posr.c @@ -0,0 +1,227 @@ +/* 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 new file mode 100644 index 0000000000..912511d01f --- /dev/null +++ b/ext/spice/src/cspice/posr_c.c @@ -0,0 +1,228 @@ +/* + +-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 new file mode 100644 index 0000000000..37e2ce0f2e --- /dev/null +++ b/ext/spice/src/cspice/pow_ci.c @@ -0,0 +1,20 @@ +#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 new file mode 100644 index 0000000000..d2bb0e39bf --- /dev/null +++ b/ext/spice/src/cspice/pow_dd.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..affed625a9 --- /dev/null +++ b/ext/spice/src/cspice/pow_di.c @@ -0,0 +1,35 @@ +#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 new file mode 100644 index 0000000000..24a019734d --- /dev/null +++ b/ext/spice/src/cspice/pow_hh.c @@ -0,0 +1,33 @@ +#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 new file mode 100644 index 0000000000..84d1c7e0b5 --- /dev/null +++ b/ext/spice/src/cspice/pow_ii.c @@ -0,0 +1,33 @@ +#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 new file mode 100644 index 0000000000..6e5816bbf1 --- /dev/null +++ b/ext/spice/src/cspice/pow_ri.c @@ -0,0 +1,35 @@ +#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 new file mode 100644 index 0000000000..abb3cb2b53 --- /dev/null +++ b/ext/spice/src/cspice/pow_zi.c @@ -0,0 +1,54 @@ +#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 new file mode 100644 index 0000000000..55785dffbe --- /dev/null +++ b/ext/spice/src/cspice/pow_zz.c @@ -0,0 +1,23 @@ +#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 new file mode 100644 index 0000000000..2af88f6b20 --- /dev/null +++ b/ext/spice/src/cspice/prefix.c @@ -0,0 +1,203 @@ +/* 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 new file mode 100644 index 0000000000..8640ffd200 --- /dev/null +++ b/ext/spice/src/cspice/prodad.c @@ -0,0 +1,165 @@ +/* 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 new file mode 100644 index 0000000000..69676dabaa --- /dev/null +++ b/ext/spice/src/cspice/prodai.c @@ -0,0 +1,164 @@ +/* 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 new file mode 100644 index 0000000000..bd7c727cdc --- /dev/null +++ b/ext/spice/src/cspice/prompt.c @@ -0,0 +1,397 @@ +/* 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 new file mode 100644 index 0000000000..d1279615e7 --- /dev/null +++ b/ext/spice/src/cspice/prompt_c.c @@ -0,0 +1,285 @@ +/* + +-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 new file mode 100644 index 0000000000..bd79691311 --- /dev/null +++ b/ext/spice/src/cspice/prop2b.c @@ -0,0 +1,1076 @@ +/* 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 new file mode 100644 index 0000000000..b307d6c34c --- /dev/null +++ b/ext/spice/src/cspice/prop2b_c.c @@ -0,0 +1,220 @@ +/* + +-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 new file mode 100644 index 0000000000..981a018145 --- /dev/null +++ b/ext/spice/src/cspice/prsdp.c @@ -0,0 +1,150 @@ +/* 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 new file mode 100644 index 0000000000..6be42ac61c --- /dev/null +++ b/ext/spice/src/cspice/prsdp_c.c @@ -0,0 +1,165 @@ +/* + +-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 new file mode 100644 index 0000000000..43d44cc422 --- /dev/null +++ b/ext/spice/src/cspice/prsint.c @@ -0,0 +1,142 @@ +/* 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 new file mode 100644 index 0000000000..2b1f8425a3 --- /dev/null +++ b/ext/spice/src/cspice/prsint_c.c @@ -0,0 +1,157 @@ +/* + +-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 new file mode 100644 index 0000000000..1a3fb5b5ba --- /dev/null +++ b/ext/spice/src/cspice/prtenc.c @@ -0,0 +1,361 @@ +/* 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 new file mode 100644 index 0000000000..7dea92e6b2 --- /dev/null +++ b/ext/spice/src/cspice/prtpkg.c @@ -0,0 +1,808 @@ +/* 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 new file mode 100644 index 0000000000..1a6444d831 --- /dev/null +++ b/ext/spice/src/cspice/psv2pl.c @@ -0,0 +1,254 @@ +/* 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 new file mode 100644 index 0000000000..abd15f2864 --- /dev/null +++ b/ext/spice/src/cspice/psv2pl_c.c @@ -0,0 +1,222 @@ +/* + +-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 new file mode 100644 index 0000000000..778ff71058 --- /dev/null +++ b/ext/spice/src/cspice/putact.c @@ -0,0 +1,355 @@ +/* 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 new file mode 100644 index 0000000000..198d93c50b --- /dev/null +++ b/ext/spice/src/cspice/putcml_c.c @@ -0,0 +1,177 @@ +/* + +-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 new file mode 100644 index 0000000000..7a666069c0 --- /dev/null +++ b/ext/spice/src/cspice/putdev.c @@ -0,0 +1,472 @@ +/* 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 new file mode 100644 index 0000000000..36c4f41451 --- /dev/null +++ b/ext/spice/src/cspice/putlms.c @@ -0,0 +1,391 @@ +/* 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 new file mode 100644 index 0000000000..f4f90a9b6c --- /dev/null +++ b/ext/spice/src/cspice/putsms.c @@ -0,0 +1,361 @@ +/* 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 new file mode 100644 index 0000000000..0874d514b5 --- /dev/null +++ b/ext/spice/src/cspice/pxform.c @@ -0,0 +1,226 @@ +/* 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 new file mode 100644 index 0000000000..960d4b238e --- /dev/null +++ b/ext/spice/src/cspice/pxform_c.c @@ -0,0 +1,225 @@ +/* + +-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 new file mode 100644 index 0000000000..d6ac5076e4 --- /dev/null +++ b/ext/spice/src/cspice/q2m.c @@ -0,0 +1,592 @@ +/* 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 new file mode 100644 index 0000000000..1024a5711f --- /dev/null +++ b/ext/spice/src/cspice/q2m_c.c @@ -0,0 +1,468 @@ +/* + +-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 new file mode 100644 index 0000000000..ed1ffbf1dd --- /dev/null +++ b/ext/spice/src/cspice/qderiv.c @@ -0,0 +1,225 @@ +/* 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 new file mode 100644 index 0000000000..8c4625ba58 --- /dev/null +++ b/ext/spice/src/cspice/qdq2av.c @@ -0,0 +1,722 @@ +/* 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 new file mode 100644 index 0000000000..d926c0547f --- /dev/null +++ b/ext/spice/src/cspice/qdq2av_c.c @@ -0,0 +1,717 @@ +/* + +-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 new file mode 100644 index 0000000000..381855f3e4 --- /dev/null +++ b/ext/spice/src/cspice/quote.c @@ -0,0 +1,183 @@ +/* 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 new file mode 100644 index 0000000000..c379a9bce5 --- /dev/null +++ b/ext/spice/src/cspice/qxq.c @@ -0,0 +1,441 @@ +/* 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 new file mode 100644 index 0000000000..7436670ada --- /dev/null +++ b/ext/spice/src/cspice/qxq_c.c @@ -0,0 +1,449 @@ +/* + +-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 new file mode 100644 index 0000000000..7b222961d1 --- /dev/null +++ b/ext/spice/src/cspice/r_abs.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..328812ab6a --- /dev/null +++ b/ext/spice/src/cspice/r_acos.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..a30c6706b0 --- /dev/null +++ b/ext/spice/src/cspice/r_asin.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..1e3817bdf6 --- /dev/null +++ b/ext/spice/src/cspice/r_atan.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..3832a27f3e --- /dev/null +++ b/ext/spice/src/cspice/r_atn2.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..e127ca969c --- /dev/null +++ b/ext/spice/src/cspice/r_cnjg.c @@ -0,0 +1,11 @@ +#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 new file mode 100644 index 0000000000..cf5c8eb4af --- /dev/null +++ b/ext/spice/src/cspice/r_cos.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..5756c17242 --- /dev/null +++ b/ext/spice/src/cspice/r_cosh.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..baca95cd9e --- /dev/null +++ b/ext/spice/src/cspice/r_dim.c @@ -0,0 +1,10 @@ +#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 new file mode 100644 index 0000000000..a95f4bc7f2 --- /dev/null +++ b/ext/spice/src/cspice/r_exp.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..d51252bbb7 --- /dev/null +++ b/ext/spice/src/cspice/r_imag.c @@ -0,0 +1,10 @@ +#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 new file mode 100644 index 0000000000..11264bf192 --- /dev/null +++ b/ext/spice/src/cspice/r_int.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..4ea02f4510 --- /dev/null +++ b/ext/spice/src/cspice/r_lg10.c @@ -0,0 +1,15 @@ +#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 new file mode 100644 index 0000000000..aec6726ef5 --- /dev/null +++ b/ext/spice/src/cspice/r_log.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..7adb44cdbe --- /dev/null +++ b/ext/spice/src/cspice/r_mod.c @@ -0,0 +1,40 @@ +#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 new file mode 100644 index 0000000000..c45bac6458 --- /dev/null +++ b/ext/spice/src/cspice/r_nint.c @@ -0,0 +1,14 @@ +#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 new file mode 100644 index 0000000000..df6d02af00 --- /dev/null +++ b/ext/spice/src/cspice/r_sign.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..d2a3dac858 --- /dev/null +++ b/ext/spice/src/cspice/r_sin.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..00cba0cb07 --- /dev/null +++ b/ext/spice/src/cspice/r_sinh.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..26b45458aa --- /dev/null +++ b/ext/spice/src/cspice/r_sqrt.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..736b37893c --- /dev/null +++ b/ext/spice/src/cspice/r_tan.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..044255a08c --- /dev/null +++ b/ext/spice/src/cspice/r_tanh.c @@ -0,0 +1,13 @@ +#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 new file mode 100644 index 0000000000..4fdb965e96 --- /dev/null +++ b/ext/spice/src/cspice/radrec.c @@ -0,0 +1,197 @@ +/* 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 new file mode 100644 index 0000000000..aa6ebaba75 --- /dev/null +++ b/ext/spice/src/cspice/radrec_c.c @@ -0,0 +1,170 @@ +/* + +-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 new file mode 100644 index 0000000000..ccfe8a7651 --- /dev/null +++ b/ext/spice/src/cspice/rav2xf.c @@ -0,0 +1,267 @@ +/* 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 new file mode 100644 index 0000000000..19fceb52d5 --- /dev/null +++ b/ext/spice/src/cspice/rav2xf_c.c @@ -0,0 +1,295 @@ +/* + +-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 new file mode 100644 index 0000000000..fd36a48260 --- /dev/null +++ b/ext/spice/src/cspice/rawio.h @@ -0,0 +1,41 @@ +#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 new file mode 100644 index 0000000000..21feecda6c --- /dev/null +++ b/ext/spice/src/cspice/raxisa.c @@ -0,0 +1,349 @@ +/* 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 new file mode 100644 index 0000000000..5ed9a02b6a --- /dev/null +++ b/ext/spice/src/cspice/raxisa_c.c @@ -0,0 +1,243 @@ +/* + +-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 new file mode 100644 index 0000000000..00c457f689 --- /dev/null +++ b/ext/spice/src/cspice/rdencc.c @@ -0,0 +1,538 @@ +/* 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 new file mode 100644 index 0000000000..a3532edb40 --- /dev/null +++ b/ext/spice/src/cspice/rdencd.c @@ -0,0 +1,338 @@ +/* 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 new file mode 100644 index 0000000000..73281fe165 --- /dev/null +++ b/ext/spice/src/cspice/rdenci.c @@ -0,0 +1,326 @@ +/* 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 new file mode 100644 index 0000000000..3de3e494ca --- /dev/null +++ b/ext/spice/src/cspice/rdfmt.c @@ -0,0 +1,476 @@ +#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 new file mode 100644 index 0000000000..1c398875da --- /dev/null +++ b/ext/spice/src/cspice/rdker.c @@ -0,0 +1,1084 @@ +/* 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 new file mode 100644 index 0000000000..4e5e2e265d --- /dev/null +++ b/ext/spice/src/cspice/rdkvar.c @@ -0,0 +1,391 @@ +/* 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 new file mode 100644 index 0000000000..adb9175aa8 --- /dev/null +++ b/ext/spice/src/cspice/rdnbl.c @@ -0,0 +1,214 @@ +/* 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 new file mode 100644 index 0000000000..ffe64f118b --- /dev/null +++ b/ext/spice/src/cspice/rdtext.c @@ -0,0 +1,989 @@ +/* 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 new file mode 100644 index 0000000000..4d06871d83 --- /dev/null +++ b/ext/spice/src/cspice/rdtext_c.c @@ -0,0 +1,251 @@ +/* + +-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 new file mode 100644 index 0000000000..0bc82287cd --- /dev/null +++ b/ext/spice/src/cspice/readla.c @@ -0,0 +1,334 @@ +/* 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 new file mode 100644 index 0000000000..dbf8ae3a0b --- /dev/null +++ b/ext/spice/src/cspice/readln.c @@ -0,0 +1,217 @@ +/* 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 new file mode 100644 index 0000000000..33c80b55ff --- /dev/null +++ b/ext/spice/src/cspice/reccyl.c @@ -0,0 +1,199 @@ +/* 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 new file mode 100644 index 0000000000..8a2a0fa94e --- /dev/null +++ b/ext/spice/src/cspice/reccyl_c.c @@ -0,0 +1,204 @@ +/* + +-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 new file mode 100644 index 0000000000..3c2e5224f6 --- /dev/null +++ b/ext/spice/src/cspice/recgeo.c @@ -0,0 +1,320 @@ +/* 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 new file mode 100644 index 0000000000..8054e53580 --- /dev/null +++ b/ext/spice/src/cspice/recgeo_c.c @@ -0,0 +1,272 @@ +/* + +-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 new file mode 100644 index 0000000000..d4aef0d718 --- /dev/null +++ b/ext/spice/src/cspice/reclat.c @@ -0,0 +1,228 @@ +/* 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 new file mode 100644 index 0000000000..c98c0ca130 --- /dev/null +++ b/ext/spice/src/cspice/reclat_c.c @@ -0,0 +1,239 @@ +/* + +-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 new file mode 100644 index 0000000000..c10f9c8d90 --- /dev/null +++ b/ext/spice/src/cspice/recpgr.c @@ -0,0 +1,657 @@ +/* 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 new file mode 100644 index 0000000000..5f56b5fadc --- /dev/null +++ b/ext/spice/src/cspice/recpgr_c.c @@ -0,0 +1,548 @@ +/* + +-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 new file mode 100644 index 0000000000..d7b83c4f9b --- /dev/null +++ b/ext/spice/src/cspice/recrad.c @@ -0,0 +1,201 @@ +/* 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 new file mode 100644 index 0000000000..9cd3bf7db6 --- /dev/null +++ b/ext/spice/src/cspice/recrad_c.c @@ -0,0 +1,209 @@ +/* + +-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 new file mode 100644 index 0000000000..82ce4112a5 --- /dev/null +++ b/ext/spice/src/cspice/recsph.c @@ -0,0 +1,208 @@ +/* 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 new file mode 100644 index 0000000000..dfbf164278 --- /dev/null +++ b/ext/spice/src/cspice/recsph_c.c @@ -0,0 +1,220 @@ +/* + +-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 new file mode 100644 index 0000000000..1bc5d47a88 --- /dev/null +++ b/ext/spice/src/cspice/refchg.c @@ -0,0 +1,679 @@ +/* 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 new file mode 100644 index 0000000000..f641c71f5d --- /dev/null +++ b/ext/spice/src/cspice/remlac.c @@ -0,0 +1,255 @@ +/* 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 new file mode 100644 index 0000000000..8b253cd8a5 --- /dev/null +++ b/ext/spice/src/cspice/remlad.c @@ -0,0 +1,251 @@ +/* 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 new file mode 100644 index 0000000000..047cec8c1d --- /dev/null +++ b/ext/spice/src/cspice/remlai.c @@ -0,0 +1,251 @@ +/* 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 new file mode 100644 index 0000000000..f73f59dbce --- /dev/null +++ b/ext/spice/src/cspice/removc.c @@ -0,0 +1,210 @@ +/* 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 new file mode 100644 index 0000000000..3089443989 --- /dev/null +++ b/ext/spice/src/cspice/removc_c.c @@ -0,0 +1,257 @@ +/* + +-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 new file mode 100644 index 0000000000..a4a93cb2f0 --- /dev/null +++ b/ext/spice/src/cspice/removd.c @@ -0,0 +1,205 @@ +/* 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 new file mode 100644 index 0000000000..3a98ffb43f --- /dev/null +++ b/ext/spice/src/cspice/removd_c.c @@ -0,0 +1,244 @@ +/* + +-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 new file mode 100644 index 0000000000..48f9072890 --- /dev/null +++ b/ext/spice/src/cspice/removi.c @@ -0,0 +1,205 @@ +/* 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 new file mode 100644 index 0000000000..29f2638409 --- /dev/null +++ b/ext/spice/src/cspice/removi_c.c @@ -0,0 +1,222 @@ +/* + +-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 new file mode 100644 index 0000000000..3dc202a15f --- /dev/null +++ b/ext/spice/src/cspice/remsub.c @@ -0,0 +1,241 @@ +/* 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 new file mode 100644 index 0000000000..5d5f3719ac --- /dev/null +++ b/ext/spice/src/cspice/reordc.c @@ -0,0 +1,248 @@ +/* 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 new file mode 100644 index 0000000000..5644b08ab9 --- /dev/null +++ b/ext/spice/src/cspice/reordc_c.c @@ -0,0 +1,270 @@ +/* + +-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 new file mode 100644 index 0000000000..d427e4dc04 --- /dev/null +++ b/ext/spice/src/cspice/reordd.c @@ -0,0 +1,227 @@ +/* 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 new file mode 100644 index 0000000000..37005637ce --- /dev/null +++ b/ext/spice/src/cspice/reordd_c.c @@ -0,0 +1,223 @@ +/* + +-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 new file mode 100644 index 0000000000..7dbb97fa1f --- /dev/null +++ b/ext/spice/src/cspice/reordi.c @@ -0,0 +1,224 @@ +/* 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 new file mode 100644 index 0000000000..ef7d249eae --- /dev/null +++ b/ext/spice/src/cspice/reordi_c.c @@ -0,0 +1,221 @@ +/* + +-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 new file mode 100644 index 0000000000..e7865e2220 --- /dev/null +++ b/ext/spice/src/cspice/reordl.c @@ -0,0 +1,221 @@ +/* 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 new file mode 100644 index 0000000000..4ac56bcf6e --- /dev/null +++ b/ext/spice/src/cspice/reordl_c.c @@ -0,0 +1,265 @@ +/* + +-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 new file mode 100644 index 0000000000..7257ef1a68 --- /dev/null +++ b/ext/spice/src/cspice/replch.c @@ -0,0 +1,172 @@ +/* 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 new file mode 100644 index 0000000000..65b5869522 --- /dev/null +++ b/ext/spice/src/cspice/replwd.c @@ -0,0 +1,301 @@ +/* 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 new file mode 100644 index 0000000000..8716205d48 --- /dev/null +++ b/ext/spice/src/cspice/repmc.c @@ -0,0 +1,292 @@ +/* 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 new file mode 100644 index 0000000000..b6dd8ad74f --- /dev/null +++ b/ext/spice/src/cspice/repmc_c.c @@ -0,0 +1,395 @@ +/* + +-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 new file mode 100644 index 0000000000..a63cf80320 --- /dev/null +++ b/ext/spice/src/cspice/repmct.c @@ -0,0 +1,343 @@ +/* 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 new file mode 100644 index 0000000000..dda0f0db9c --- /dev/null +++ b/ext/spice/src/cspice/repmct_c.c @@ -0,0 +1,378 @@ +/* + +-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 new file mode 100644 index 0000000000..8283c57ef7 --- /dev/null +++ b/ext/spice/src/cspice/repmd.c @@ -0,0 +1,313 @@ +/* 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 new file mode 100644 index 0000000000..af69de1a6e --- /dev/null +++ b/ext/spice/src/cspice/repmd_c.c @@ -0,0 +1,381 @@ +/* + +-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 new file mode 100644 index 0000000000..63ddfb9ef5 --- /dev/null +++ b/ext/spice/src/cspice/repmf.c @@ -0,0 +1,352 @@ +/* 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 new file mode 100644 index 0000000000..58df8473b8 --- /dev/null +++ b/ext/spice/src/cspice/repmf_c.c @@ -0,0 +1,440 @@ +/* + +-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 new file mode 100644 index 0000000000..6d29adae46 --- /dev/null +++ b/ext/spice/src/cspice/repmi.c @@ -0,0 +1,274 @@ +/* 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 new file mode 100644 index 0000000000..be22c91cb6 --- /dev/null +++ b/ext/spice/src/cspice/repmi_c.c @@ -0,0 +1,364 @@ +/* + +-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 new file mode 100644 index 0000000000..5ff2bff5ec --- /dev/null +++ b/ext/spice/src/cspice/repmot.c @@ -0,0 +1,344 @@ +/* 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 new file mode 100644 index 0000000000..bba7746f11 --- /dev/null +++ b/ext/spice/src/cspice/repmot_c.c @@ -0,0 +1,366 @@ +/* + +-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 new file mode 100644 index 0000000000..fc715c506b --- /dev/null +++ b/ext/spice/src/cspice/repsub.c @@ -0,0 +1,333 @@ +/* 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 new file mode 100644 index 0000000000..d29d3e13d0 --- /dev/null +++ b/ext/spice/src/cspice/reset.c @@ -0,0 +1,239 @@ +/* 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 new file mode 100644 index 0000000000..32310ddd87 --- /dev/null +++ b/ext/spice/src/cspice/reset_c.c @@ -0,0 +1,196 @@ +/* + +-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 new file mode 100644 index 0000000000..d9d01f9a31 --- /dev/null +++ b/ext/spice/src/cspice/return.c @@ -0,0 +1,274 @@ +/* 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 new file mode 100644 index 0000000000..d28e12da7b --- /dev/null +++ b/ext/spice/src/cspice/return_c.c @@ -0,0 +1,237 @@ +/* + +-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 new file mode 100644 index 0000000000..e58daad7b8 --- /dev/null +++ b/ext/spice/src/cspice/rewind.c @@ -0,0 +1,24 @@ +#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 new file mode 100644 index 0000000000..283dbada23 --- /dev/null +++ b/ext/spice/src/cspice/rjust.c @@ -0,0 +1,195 @@ +/* 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 new file mode 100644 index 0000000000..2fc3606a56 --- /dev/null +++ b/ext/spice/src/cspice/rmaind.c @@ -0,0 +1,171 @@ +/* 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 new file mode 100644 index 0000000000..c2c87b2b29 --- /dev/null +++ b/ext/spice/src/cspice/rmaini.c @@ -0,0 +1,155 @@ +/* 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 new file mode 100644 index 0000000000..d8a4444a98 --- /dev/null +++ b/ext/spice/src/cspice/rmdupc.c @@ -0,0 +1,185 @@ +/* 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 new file mode 100644 index 0000000000..46fbc30506 --- /dev/null +++ b/ext/spice/src/cspice/rmdupd.c @@ -0,0 +1,179 @@ +/* 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 new file mode 100644 index 0000000000..4ad3e1761c --- /dev/null +++ b/ext/spice/src/cspice/rmdupi.c @@ -0,0 +1,179 @@ +/* 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 new file mode 100644 index 0000000000..d01b2f4a08 --- /dev/null +++ b/ext/spice/src/cspice/rotate.c @@ -0,0 +1,222 @@ +/* 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 new file mode 100644 index 0000000000..e6ad751128 --- /dev/null +++ b/ext/spice/src/cspice/rotate_c.c @@ -0,0 +1,183 @@ +/* + +-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 new file mode 100644 index 0000000000..e785630a4d --- /dev/null +++ b/ext/spice/src/cspice/rotget.c @@ -0,0 +1,343 @@ +/* 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 new file mode 100644 index 0000000000..d5874780ff --- /dev/null +++ b/ext/spice/src/cspice/rotmat.c @@ -0,0 +1,238 @@ +/* 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 new file mode 100644 index 0000000000..a369fb5209 --- /dev/null +++ b/ext/spice/src/cspice/rotmat_c.c @@ -0,0 +1,194 @@ +/* + +-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 new file mode 100644 index 0000000000..6244f524ce --- /dev/null +++ b/ext/spice/src/cspice/rotvec.c @@ -0,0 +1,242 @@ +/* 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 new file mode 100644 index 0000000000..c4bec2de97 --- /dev/null +++ b/ext/spice/src/cspice/rotvec_c.c @@ -0,0 +1,228 @@ +/* + +-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 new file mode 100644 index 0000000000..9dfe3abc27 --- /dev/null +++ b/ext/spice/src/cspice/rpd.c @@ -0,0 +1,158 @@ +/* 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 new file mode 100644 index 0000000000..1a3f1fce79 --- /dev/null +++ b/ext/spice/src/cspice/rpd_c.c @@ -0,0 +1,137 @@ +/* + +-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 new file mode 100644 index 0000000000..06aeaf8f3a --- /dev/null +++ b/ext/spice/src/cspice/rquad.c @@ -0,0 +1,350 @@ +/* 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 new file mode 100644 index 0000000000..847de233bd --- /dev/null +++ b/ext/spice/src/cspice/rquad_c.c @@ -0,0 +1,380 @@ +/* + +-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 new file mode 100644 index 0000000000..f95d4e45d7 --- /dev/null +++ b/ext/spice/src/cspice/rsfe.c @@ -0,0 +1,428 @@ +/* +-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 new file mode 100644 index 0000000000..a081cd589a --- /dev/null +++ b/ext/spice/src/cspice/rsli.c @@ -0,0 +1,103 @@ +#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 new file mode 100644 index 0000000000..cc679c7608 --- /dev/null +++ b/ext/spice/src/cspice/rsne.c @@ -0,0 +1,609 @@ +#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 new file mode 100644 index 0000000000..1518f03402 --- /dev/null +++ b/ext/spice/src/cspice/rtrim.c @@ -0,0 +1,164 @@ +/* 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 new file mode 100644 index 0000000000..038f0ecfbe --- /dev/null +++ b/ext/spice/src/cspice/s_cat.c @@ -0,0 +1,75 @@ +/* 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 new file mode 100644 index 0000000000..1e052f2864 --- /dev/null +++ b/ext/spice/src/cspice/s_cmp.c @@ -0,0 +1,44 @@ +#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 new file mode 100644 index 0000000000..d1673510c6 --- /dev/null +++ b/ext/spice/src/cspice/s_copy.c @@ -0,0 +1,51 @@ +/* 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 new file mode 100644 index 0000000000..796300bf7c --- /dev/null +++ b/ext/spice/src/cspice/s_paus.c @@ -0,0 +1,88 @@ +#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 new file mode 100644 index 0000000000..cdbb143e74 --- /dev/null +++ b/ext/spice/src/cspice/s_rnge.c @@ -0,0 +1,288 @@ +/* +-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 new file mode 100644 index 0000000000..6e858d497a --- /dev/null +++ b/ext/spice/src/cspice/s_stop.c @@ -0,0 +1,52 @@ +/* + 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 new file mode 100644 index 0000000000..7d581bbb1b --- /dev/null +++ b/ext/spice/src/cspice/saelgv_c.c @@ -0,0 +1,489 @@ +/* + +-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 new file mode 100644 index 0000000000..6fd24468e3 --- /dev/null +++ b/ext/spice/src/cspice/samch.c @@ -0,0 +1,197 @@ +/* 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 new file mode 100644 index 0000000000..b61809b624 --- /dev/null +++ b/ext/spice/src/cspice/samchi.c @@ -0,0 +1,204 @@ +/* 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 new file mode 100644 index 0000000000..ea8287e0f2 --- /dev/null +++ b/ext/spice/src/cspice/sameai.c @@ -0,0 +1,155 @@ +/* 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 new file mode 100644 index 0000000000..c0efd689cc --- /dev/null +++ b/ext/spice/src/cspice/samsbi.c @@ -0,0 +1,238 @@ +/* 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 new file mode 100644 index 0000000000..315a39724b --- /dev/null +++ b/ext/spice/src/cspice/samsub.c @@ -0,0 +1,222 @@ +/* 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 new file mode 100644 index 0000000000..ce2f849b27 --- /dev/null +++ b/ext/spice/src/cspice/sc01.c @@ -0,0 +1,3244 @@ +/* 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 new file mode 100644 index 0000000000..0ea3f3d0cd --- /dev/null +++ b/ext/spice/src/cspice/scanit.c @@ -0,0 +1,1580 @@ +/* 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 new file mode 100644 index 0000000000..0695936bbd --- /dev/null +++ b/ext/spice/src/cspice/scanrj.c @@ -0,0 +1,202 @@ +/* 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 new file mode 100644 index 0000000000..a0bd041c8e --- /dev/null +++ b/ext/spice/src/cspice/scard_c.c @@ -0,0 +1,219 @@ +/* + +-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 new file mode 100644 index 0000000000..1e122e6b1b --- /dev/null +++ b/ext/spice/src/cspice/scardc.c @@ -0,0 +1,217 @@ +/* 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 new file mode 100644 index 0000000000..4e19413294 --- /dev/null +++ b/ext/spice/src/cspice/scardd.c @@ -0,0 +1,211 @@ +/* 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 new file mode 100644 index 0000000000..7dc2993a6f --- /dev/null +++ b/ext/spice/src/cspice/scardi.c @@ -0,0 +1,210 @@ +/* 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 new file mode 100644 index 0000000000..8eb09380dc --- /dev/null +++ b/ext/spice/src/cspice/scdecd.c @@ -0,0 +1,671 @@ +/* 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 new file mode 100644 index 0000000000..c05939a1f5 --- /dev/null +++ b/ext/spice/src/cspice/scdecd_c.c @@ -0,0 +1,473 @@ +/* + +-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 new file mode 100644 index 0000000000..935b126997 --- /dev/null +++ b/ext/spice/src/cspice/sce2c.c @@ -0,0 +1,294 @@ +/* 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 new file mode 100644 index 0000000000..9676321883 --- /dev/null +++ b/ext/spice/src/cspice/sce2c_c.c @@ -0,0 +1,275 @@ +/* + +-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 new file mode 100644 index 0000000000..ca7b9edb5a --- /dev/null +++ b/ext/spice/src/cspice/sce2s.c @@ -0,0 +1,354 @@ +/* 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 new file mode 100644 index 0000000000..464b7291b5 --- /dev/null +++ b/ext/spice/src/cspice/sce2s_c.c @@ -0,0 +1,379 @@ +/* + +-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 new file mode 100644 index 0000000000..df7a0c5e22 --- /dev/null +++ b/ext/spice/src/cspice/sce2t.c @@ -0,0 +1,324 @@ +/* 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 new file mode 100644 index 0000000000..52790da819 --- /dev/null +++ b/ext/spice/src/cspice/sce2t_c.c @@ -0,0 +1,285 @@ +/* + +-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 new file mode 100644 index 0000000000..642992472c --- /dev/null +++ b/ext/spice/src/cspice/scencd.c @@ -0,0 +1,699 @@ +/* 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 new file mode 100644 index 0000000000..e2d5345af7 --- /dev/null +++ b/ext/spice/src/cspice/scencd_c.c @@ -0,0 +1,473 @@ +/* + +-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 new file mode 100644 index 0000000000..4d53b7a543 --- /dev/null +++ b/ext/spice/src/cspice/scfmt.c @@ -0,0 +1,324 @@ +/* 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 new file mode 100644 index 0000000000..9b255c24c5 --- /dev/null +++ b/ext/spice/src/cspice/scfmt_c.c @@ -0,0 +1,359 @@ +/* + +-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 new file mode 100644 index 0000000000..82f890df61 --- /dev/null +++ b/ext/spice/src/cspice/sclu01.c @@ -0,0 +1,1205 @@ +/* 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 new file mode 100644 index 0000000000..6d5791f01f --- /dev/null +++ b/ext/spice/src/cspice/scpars.c @@ -0,0 +1,800 @@ +/* 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 new file mode 100644 index 0000000000..244ad87c6a --- /dev/null +++ b/ext/spice/src/cspice/scpart.c @@ -0,0 +1,447 @@ +/* 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 new file mode 100644 index 0000000000..839196f3c5 --- /dev/null +++ b/ext/spice/src/cspice/scpart_c.c @@ -0,0 +1,228 @@ +/* + +-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 new file mode 100644 index 0000000000..c264142ad1 --- /dev/null +++ b/ext/spice/src/cspice/scps01.c @@ -0,0 +1,627 @@ +/* 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 new file mode 100644 index 0000000000..8a9385c0ee --- /dev/null +++ b/ext/spice/src/cspice/scs2e.c @@ -0,0 +1,296 @@ +/* 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 new file mode 100644 index 0000000000..2a9b4f2a64 --- /dev/null +++ b/ext/spice/src/cspice/scs2e_c.c @@ -0,0 +1,268 @@ +/* + +-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 new file mode 100644 index 0000000000..62464056cd --- /dev/null +++ b/ext/spice/src/cspice/sct2e.c @@ -0,0 +1,334 @@ +/* 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 new file mode 100644 index 0000000000..abe0a1a064 --- /dev/null +++ b/ext/spice/src/cspice/sct2e_c.c @@ -0,0 +1,295 @@ +/* + +-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 new file mode 100644 index 0000000000..c5de309bdd --- /dev/null +++ b/ext/spice/src/cspice/sctiks.c @@ -0,0 +1,346 @@ +/* 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 new file mode 100644 index 0000000000..5acf4b8599 --- /dev/null +++ b/ext/spice/src/cspice/sctiks_c.c @@ -0,0 +1,328 @@ +/* + +-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 new file mode 100644 index 0000000000..7abfd5b6d8 --- /dev/null +++ b/ext/spice/src/cspice/sctran.c @@ -0,0 +1,539 @@ +/* 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 new file mode 100644 index 0000000000..f4d074140a --- /dev/null +++ b/ext/spice/src/cspice/sctype.c @@ -0,0 +1,282 @@ +/* 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 new file mode 100644 index 0000000000..5c1485122c --- /dev/null +++ b/ext/spice/src/cspice/sdiff_c.c @@ -0,0 +1,359 @@ +/* + +-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 new file mode 100644 index 0000000000..df777584af --- /dev/null +++ b/ext/spice/src/cspice/sdiffc.c @@ -0,0 +1,322 @@ +/* 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 new file mode 100644 index 0000000000..5397a4bf5c --- /dev/null +++ b/ext/spice/src/cspice/sdiffd.c @@ -0,0 +1,272 @@ +/* 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 new file mode 100644 index 0000000000..1304257a7f --- /dev/null +++ b/ext/spice/src/cspice/sdiffi.c @@ -0,0 +1,272 @@ +/* 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 new file mode 100644 index 0000000000..e4ef5447e4 --- /dev/null +++ b/ext/spice/src/cspice/set_c.c @@ -0,0 +1,354 @@ +/* + +-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 new file mode 100644 index 0000000000..e03878e2b6 --- /dev/null +++ b/ext/spice/src/cspice/setc.c @@ -0,0 +1,602 @@ +/* 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 new file mode 100644 index 0000000000..49af97c110 --- /dev/null +++ b/ext/spice/src/cspice/setd.c @@ -0,0 +1,599 @@ +/* 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 new file mode 100644 index 0000000000..3c736fc5e8 --- /dev/null +++ b/ext/spice/src/cspice/seterr.c @@ -0,0 +1,428 @@ +/* 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 new file mode 100644 index 0000000000..6aebccf209 --- /dev/null +++ b/ext/spice/src/cspice/seti.c @@ -0,0 +1,599 @@ +/* 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 new file mode 100644 index 0000000000..c3e4a1a163 --- /dev/null +++ b/ext/spice/src/cspice/setmsg.c @@ -0,0 +1,207 @@ +/* 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 new file mode 100644 index 0000000000..46e1cdbcdd --- /dev/null +++ b/ext/spice/src/cspice/setmsg_c.c @@ -0,0 +1,198 @@ +/* + +-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 new file mode 100644 index 0000000000..cade56a488 --- /dev/null +++ b/ext/spice/src/cspice/sfe.c @@ -0,0 +1,31 @@ +/* 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 new file mode 100644 index 0000000000..66868a8156 --- /dev/null +++ b/ext/spice/src/cspice/sgfcon.c @@ -0,0 +1,625 @@ +/* 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 new file mode 100644 index 0000000000..2f700d0bd6 --- /dev/null +++ b/ext/spice/src/cspice/sgfpkt.c @@ -0,0 +1,807 @@ +/* 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 new file mode 100644 index 0000000000..6152d7c458 --- /dev/null +++ b/ext/spice/src/cspice/sgfref.c @@ -0,0 +1,698 @@ +/* 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 new file mode 100644 index 0000000000..6721de2fa9 --- /dev/null +++ b/ext/spice/src/cspice/sgfrvi.c @@ -0,0 +1,1272 @@ +/* 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 new file mode 100644 index 0000000000..993424a9e8 --- /dev/null +++ b/ext/spice/src/cspice/sgmeta.c @@ -0,0 +1,910 @@ +/* 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 new file mode 100644 index 0000000000..d67f68cf71 --- /dev/null +++ b/ext/spice/src/cspice/sgseqw.c @@ -0,0 +1,4341 @@ +/* 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 new file mode 100644 index 0000000000..0dc5809c31 --- /dev/null +++ b/ext/spice/src/cspice/sharpr.c @@ -0,0 +1,164 @@ +/* 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 new file mode 100644 index 0000000000..bee199aef0 --- /dev/null +++ b/ext/spice/src/cspice/shellc.c @@ -0,0 +1,172 @@ +/* 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 new file mode 100644 index 0000000000..ac9390b1af --- /dev/null +++ b/ext/spice/src/cspice/shellc_c.c @@ -0,0 +1,227 @@ +/* + +-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 new file mode 100644 index 0000000000..cd88101000 --- /dev/null +++ b/ext/spice/src/cspice/shelld.c @@ -0,0 +1,166 @@ +/* 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 new file mode 100644 index 0000000000..785056a670 --- /dev/null +++ b/ext/spice/src/cspice/shelld_c.c @@ -0,0 +1,141 @@ +/* + +-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 new file mode 100644 index 0000000000..25ca73e7c3 --- /dev/null +++ b/ext/spice/src/cspice/shelli.c @@ -0,0 +1,166 @@ +/* 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 new file mode 100644 index 0000000000..607aac7cec --- /dev/null +++ b/ext/spice/src/cspice/shelli_c.c @@ -0,0 +1,139 @@ +/* + +-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 new file mode 100644 index 0000000000..f7a242a520 --- /dev/null +++ b/ext/spice/src/cspice/shiftc.c @@ -0,0 +1,209 @@ +/* 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 new file mode 100644 index 0000000000..3321c4412a --- /dev/null +++ b/ext/spice/src/cspice/shiftl.c @@ -0,0 +1,237 @@ +/* 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 new file mode 100644 index 0000000000..8d1a6d0d63 --- /dev/null +++ b/ext/spice/src/cspice/shiftr.c @@ -0,0 +1,234 @@ +/* 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 new file mode 100644 index 0000000000..6c470ecb5f --- /dev/null +++ b/ext/spice/src/cspice/sig_die.c @@ -0,0 +1,120 @@ +/* + +-Disclaimer + + THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE + CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. + GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE + ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE + PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" + TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY + WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A + PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC + SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE + SOFTWARE AND RELATED MATERIALS, HOWEVER USED. + + IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA + BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT + LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, + INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, + REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE + REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. + + RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF + THE SOFTWARE AND ANY RELATED MATERIALS, 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 new file mode 100644 index 0000000000..7c857010c2 --- /dev/null +++ b/ext/spice/src/cspice/sigdgt.c @@ -0,0 +1,358 @@ +/* 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 new file mode 100644 index 0000000000..8996e6493a --- /dev/null +++ b/ext/spice/src/cspice/sigerr.c @@ -0,0 +1,372 @@ +/* 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 new file mode 100644 index 0000000000..b479e85523 --- /dev/null +++ b/ext/spice/src/cspice/sigerr_c.c @@ -0,0 +1,229 @@ +/* + +-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 new file mode 100644 index 0000000000..360d8d0118 --- /dev/null +++ b/ext/spice/src/cspice/signal1.h @@ -0,0 +1,118 @@ +/* + +-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 new file mode 100644 index 0000000000..9f243d86e6 --- /dev/null +++ b/ext/spice/src/cspice/signal_.c @@ -0,0 +1,15 @@ +#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 new file mode 100644 index 0000000000..5b7f34b966 --- /dev/null +++ b/ext/spice/src/cspice/sincpt.c @@ -0,0 +1,2256 @@ +/* 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 new file mode 100644 index 0000000000..1f264ff5ea --- /dev/null +++ b/ext/spice/src/cspice/sincpt_c.c @@ -0,0 +1,1266 @@ +/* + +-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 new file mode 100644 index 0000000000..82148cd893 --- /dev/null +++ b/ext/spice/src/cspice/size_c.c @@ -0,0 +1,224 @@ +/* + +-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 new file mode 100644 index 0000000000..a34307122a --- /dev/null +++ b/ext/spice/src/cspice/sizec.c @@ -0,0 +1,212 @@ +/* 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 new file mode 100644 index 0000000000..b58d1f1fd6 --- /dev/null +++ b/ext/spice/src/cspice/sized.c @@ -0,0 +1,209 @@ +/* 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 new file mode 100644 index 0000000000..b2c58cd50b --- /dev/null +++ b/ext/spice/src/cspice/sizei.c @@ -0,0 +1,204 @@ +/* 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 new file mode 100644 index 0000000000..78a87792be --- /dev/null +++ b/ext/spice/src/cspice/smsgnd.c @@ -0,0 +1,146 @@ +/* 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 new file mode 100644 index 0000000000..309db0076e --- /dev/null +++ b/ext/spice/src/cspice/smsgni.c @@ -0,0 +1,146 @@ +/* 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 new file mode 100644 index 0000000000..3e604e5abc --- /dev/null +++ b/ext/spice/src/cspice/somfls.c @@ -0,0 +1,155 @@ +/* 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 new file mode 100644 index 0000000000..bcb8bd2e6d --- /dev/null +++ b/ext/spice/src/cspice/somtru.c @@ -0,0 +1,155 @@ +/* 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 new file mode 100644 index 0000000000..ee181ee798 --- /dev/null +++ b/ext/spice/src/cspice/spca2b.c @@ -0,0 +1,225 @@ +/* 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 new file mode 100644 index 0000000000..e5fc31df19 --- /dev/null +++ b/ext/spice/src/cspice/spcac.c @@ -0,0 +1,776 @@ +/* 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 new file mode 100644 index 0000000000..5c1a89203f --- /dev/null +++ b/ext/spice/src/cspice/spcb2a.c @@ -0,0 +1,215 @@ +/* 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 new file mode 100644 index 0000000000..24277d3ec4 --- /dev/null +++ b/ext/spice/src/cspice/spcb2t.c @@ -0,0 +1,297 @@ +/* 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 new file mode 100644 index 0000000000..7e84e75733 --- /dev/null +++ b/ext/spice/src/cspice/spcdc.c @@ -0,0 +1,219 @@ +/* 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 new file mode 100644 index 0000000000..17b963f35d --- /dev/null +++ b/ext/spice/src/cspice/spcec.c @@ -0,0 +1,394 @@ +/* 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 new file mode 100644 index 0000000000..b8cd7c959e --- /dev/null +++ b/ext/spice/src/cspice/spcopn.c @@ -0,0 +1,210 @@ +/* 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 new file mode 100644 index 0000000000..ecf950ac91 --- /dev/null +++ b/ext/spice/src/cspice/spcrfl.c @@ -0,0 +1,829 @@ +/* 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 new file mode 100644 index 0000000000..b6163ff9fb --- /dev/null +++ b/ext/spice/src/cspice/spct2b.c @@ -0,0 +1,455 @@ +/* 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 new file mode 100644 index 0000000000..eae877c28e --- /dev/null +++ b/ext/spice/src/cspice/spd.c @@ -0,0 +1,127 @@ +/* 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 new file mode 100644 index 0000000000..b6b545b14e --- /dev/null +++ b/ext/spice/src/cspice/spd_c.c @@ -0,0 +1,133 @@ +/* + +-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 new file mode 100644 index 0000000000..44fbca820e --- /dev/null +++ b/ext/spice/src/cspice/sphcyl.c @@ -0,0 +1,171 @@ +/* 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 new file mode 100644 index 0000000000..6e66fc8aff --- /dev/null +++ b/ext/spice/src/cspice/sphcyl_c.c @@ -0,0 +1,169 @@ +/* + +-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 new file mode 100644 index 0000000000..7773914e17 --- /dev/null +++ b/ext/spice/src/cspice/sphlat.c @@ -0,0 +1,178 @@ +/* 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 new file mode 100644 index 0000000000..19f16a12ea --- /dev/null +++ b/ext/spice/src/cspice/sphlat_c.c @@ -0,0 +1,170 @@ +/* + +-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 new file mode 100644 index 0000000000..885a4340a0 --- /dev/null +++ b/ext/spice/src/cspice/sphrec.c @@ -0,0 +1,201 @@ +/* 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 new file mode 100644 index 0000000000..24289543cc --- /dev/null +++ b/ext/spice/src/cspice/sphrec_c.c @@ -0,0 +1,186 @@ +/* + +-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 new file mode 100644 index 0000000000..ce0dc3b16d --- /dev/null +++ b/ext/spice/src/cspice/sphsd.c @@ -0,0 +1,254 @@ +/* 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 new file mode 100644 index 0000000000..ec48882393 --- /dev/null +++ b/ext/spice/src/cspice/spk14a.c @@ -0,0 +1,377 @@ +/* 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 new file mode 100644 index 0000000000..70a65d1232 --- /dev/null +++ b/ext/spice/src/cspice/spk14a_c.c @@ -0,0 +1,410 @@ +/* + +-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 new file mode 100644 index 0000000000..d2e6d148df --- /dev/null +++ b/ext/spice/src/cspice/spk14b.c @@ -0,0 +1,843 @@ +/* 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 new file mode 100644 index 0000000000..802e87b265 --- /dev/null +++ b/ext/spice/src/cspice/spk14b_c.c @@ -0,0 +1,455 @@ +/* + +-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 new file mode 100644 index 0000000000..71f19ab590 --- /dev/null +++ b/ext/spice/src/cspice/spk14e.c @@ -0,0 +1,335 @@ +/* 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 new file mode 100644 index 0000000000..f7377cdcd4 --- /dev/null +++ b/ext/spice/src/cspice/spk14e_c.c @@ -0,0 +1,382 @@ +/* + +-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 new file mode 100644 index 0000000000..e416e891ed --- /dev/null +++ b/ext/spice/src/cspice/spkacs.c @@ -0,0 +1,733 @@ +/* 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 new file mode 100644 index 0000000000..83df651ff2 --- /dev/null +++ b/ext/spice/src/cspice/spkacs_c.c @@ -0,0 +1,523 @@ +/* + +-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 new file mode 100644 index 0000000000..b13a77b9d8 --- /dev/null +++ b/ext/spice/src/cspice/spkapo.c @@ -0,0 +1,834 @@ +/* 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 new file mode 100644 index 0000000000..fc3bab4dcc --- /dev/null +++ b/ext/spice/src/cspice/spkapo_c.c @@ -0,0 +1,663 @@ +/* + +-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 new file mode 100644 index 0000000000..928c81761a --- /dev/null +++ b/ext/spice/src/cspice/spkapp.c @@ -0,0 +1,914 @@ +/* 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 new file mode 100644 index 0000000000..588d4b7258 --- /dev/null +++ b/ext/spice/src/cspice/spkapp_c.c @@ -0,0 +1,706 @@ +/* + +-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 new file mode 100644 index 0000000000..cebfd41455 --- /dev/null +++ b/ext/spice/src/cspice/spkaps.c @@ -0,0 +1,828 @@ +/* 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 new file mode 100644 index 0000000000..2f92ab500c --- /dev/null +++ b/ext/spice/src/cspice/spkaps_c.c @@ -0,0 +1,595 @@ +/* + +-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 new file mode 100644 index 0000000000..0a0b2e7416 --- /dev/null +++ b/ext/spice/src/cspice/spkbsr.c @@ -0,0 +1,3259 @@ +/* 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 new file mode 100644 index 0000000000..339fbbfa5b --- /dev/null +++ b/ext/spice/src/cspice/spkcls.c @@ -0,0 +1,212 @@ +/* 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 new file mode 100644 index 0000000000..567b610997 --- /dev/null +++ b/ext/spice/src/cspice/spkcls_c.c @@ -0,0 +1,139 @@ +/* + +-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 new file mode 100644 index 0000000000..177cdf7800 --- /dev/null +++ b/ext/spice/src/cspice/spkcov.c @@ -0,0 +1,579 @@ +/* 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 new file mode 100644 index 0000000000..bca7aa8c91 --- /dev/null +++ b/ext/spice/src/cspice/spkcov_c.c @@ -0,0 +1,478 @@ +/* + +-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 new file mode 100644 index 0000000000..e60a87998f --- /dev/null +++ b/ext/spice/src/cspice/spke01.c @@ -0,0 +1,362 @@ +/* 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 new file mode 100644 index 0000000000..c07077b46f --- /dev/null +++ b/ext/spice/src/cspice/spke02.c @@ -0,0 +1,248 @@ +/* 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 new file mode 100644 index 0000000000..aca7a4bfc0 --- /dev/null +++ b/ext/spice/src/cspice/spke03.c @@ -0,0 +1,239 @@ +/* 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 new file mode 100644 index 0000000000..7f438983db --- /dev/null +++ b/ext/spice/src/cspice/spke05.c @@ -0,0 +1,328 @@ +/* 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 new file mode 100644 index 0000000000..e7b3f5dfbe --- /dev/null +++ b/ext/spice/src/cspice/spke08.c @@ -0,0 +1,327 @@ +/* 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 new file mode 100644 index 0000000000..2385e9bec8 --- /dev/null +++ b/ext/spice/src/cspice/spke09.c @@ -0,0 +1,323 @@ +/* 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 new file mode 100644 index 0000000000..171c1f3de7 --- /dev/null +++ b/ext/spice/src/cspice/spke10.c @@ -0,0 +1,485 @@ +/* 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 new file mode 100644 index 0000000000..f4bfd8cf88 --- /dev/null +++ b/ext/spice/src/cspice/spke12.c @@ -0,0 +1,245 @@ +/* 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 new file mode 100644 index 0000000000..c189d7d6e2 --- /dev/null +++ b/ext/spice/src/cspice/spke13.c @@ -0,0 +1,242 @@ +/* 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 new file mode 100644 index 0000000000..3d89abf343 --- /dev/null +++ b/ext/spice/src/cspice/spke14.c @@ -0,0 +1,226 @@ +/* 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 new file mode 100644 index 0000000000..0b84329c3f --- /dev/null +++ b/ext/spice/src/cspice/spke15.c @@ -0,0 +1,589 @@ +/* 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 new file mode 100644 index 0000000000..66096e8312 --- /dev/null +++ b/ext/spice/src/cspice/spke17.c @@ -0,0 +1,278 @@ +/* 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 new file mode 100644 index 0000000000..ce978c9689 --- /dev/null +++ b/ext/spice/src/cspice/spke18.c @@ -0,0 +1,492 @@ +/* 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 new file mode 100644 index 0000000000..fe6c176977 --- /dev/null +++ b/ext/spice/src/cspice/spkez.c @@ -0,0 +1,1417 @@ +/* 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 new file mode 100644 index 0000000000..3f8e183449 --- /dev/null +++ b/ext/spice/src/cspice/spkez_c.c @@ -0,0 +1,865 @@ +/* + +-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 new file mode 100644 index 0000000000..21e0ff5d1e --- /dev/null +++ b/ext/spice/src/cspice/spkezp.c @@ -0,0 +1,1030 @@ +/* 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 new file mode 100644 index 0000000000..856e214b6f --- /dev/null +++ b/ext/spice/src/cspice/spkezp_c.c @@ -0,0 +1,803 @@ +/* + +-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 new file mode 100644 index 0000000000..155d98c25d --- /dev/null +++ b/ext/spice/src/cspice/spkezr.c @@ -0,0 +1,1021 @@ +/* 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 new file mode 100644 index 0000000000..7f992b9aaa --- /dev/null +++ b/ext/spice/src/cspice/spkezr_c.c @@ -0,0 +1,866 @@ +/* + +-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 new file mode 100644 index 0000000000..0f6417fdc9 --- /dev/null +++ b/ext/spice/src/cspice/spkgeo.c @@ -0,0 +1,1063 @@ +/* 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 new file mode 100644 index 0000000000..b740077d22 --- /dev/null +++ b/ext/spice/src/cspice/spkgeo_c.c @@ -0,0 +1,292 @@ +/* + +-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 new file mode 100644 index 0000000000..380d22094d --- /dev/null +++ b/ext/spice/src/cspice/spkgps.c @@ -0,0 +1,1016 @@ +/* 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 new file mode 100644 index 0000000000..c9efd0375b --- /dev/null +++ b/ext/spice/src/cspice/spkgps_c.c @@ -0,0 +1,282 @@ +/* + +-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 new file mode 100644 index 0000000000..819cd34cea --- /dev/null +++ b/ext/spice/src/cspice/spklef_c.c @@ -0,0 +1,237 @@ +/* + +-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 new file mode 100644 index 0000000000..1c31dedba9 --- /dev/null +++ b/ext/spice/src/cspice/spkltc.c @@ -0,0 +1,919 @@ +/* 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 new file mode 100644 index 0000000000..c6fe3cbdba --- /dev/null +++ b/ext/spice/src/cspice/spkltc_c.c @@ -0,0 +1,526 @@ +/* + +-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 new file mode 100644 index 0000000000..45e3844c0c --- /dev/null +++ b/ext/spice/src/cspice/spkobj.c @@ -0,0 +1,422 @@ +/* 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 new file mode 100644 index 0000000000..97faa195f9 --- /dev/null +++ b/ext/spice/src/cspice/spkobj_c.c @@ -0,0 +1,337 @@ +/* + +-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 new file mode 100644 index 0000000000..4e5b8c4331 --- /dev/null +++ b/ext/spice/src/cspice/spkopa.c @@ -0,0 +1,225 @@ +/* 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 new file mode 100644 index 0000000000..08f6c5427b --- /dev/null +++ b/ext/spice/src/cspice/spkopa_c.c @@ -0,0 +1,199 @@ +/* + +-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 new file mode 100644 index 0000000000..c38d5ad19f --- /dev/null +++ b/ext/spice/src/cspice/spkopn.c @@ -0,0 +1,216 @@ +/* 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 new file mode 100644 index 0000000000..162003bc01 --- /dev/null +++ b/ext/spice/src/cspice/spkopn_c.c @@ -0,0 +1,204 @@ +/* + +-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 new file mode 100644 index 0000000000..e6a644109e --- /dev/null +++ b/ext/spice/src/cspice/spkpds.c @@ -0,0 +1,287 @@ +/* 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 new file mode 100644 index 0000000000..d6167a40a3 --- /dev/null +++ b/ext/spice/src/cspice/spkpds_c.c @@ -0,0 +1,201 @@ +/* + +-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 new file mode 100644 index 0000000000..64d19ff006 --- /dev/null +++ b/ext/spice/src/cspice/spkpos.c @@ -0,0 +1,958 @@ +/* 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 new file mode 100644 index 0000000000..3c85be4875 --- /dev/null +++ b/ext/spice/src/cspice/spkpos_c.c @@ -0,0 +1,811 @@ +/* + +-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 new file mode 100644 index 0000000000..a4a289ef48 --- /dev/null +++ b/ext/spice/src/cspice/spkpv.c @@ -0,0 +1,288 @@ +/* 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 new file mode 100644 index 0000000000..2a207a9ba1 --- /dev/null +++ b/ext/spice/src/cspice/spkpvn.c @@ -0,0 +1,473 @@ +/* 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 new file mode 100644 index 0000000000..dc4cab2c72 --- /dev/null +++ b/ext/spice/src/cspice/spkr01.c @@ -0,0 +1,291 @@ +/* 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 new file mode 100644 index 0000000000..abd4b1ec5c --- /dev/null +++ b/ext/spice/src/cspice/spkr02.c @@ -0,0 +1,243 @@ +/* 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 new file mode 100644 index 0000000000..9baf41d137 --- /dev/null +++ b/ext/spice/src/cspice/spkr03.c @@ -0,0 +1,247 @@ +/* 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 new file mode 100644 index 0000000000..51d005ead5 --- /dev/null +++ b/ext/spice/src/cspice/spkr05.c @@ -0,0 +1,476 @@ +/* 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 new file mode 100644 index 0000000000..f599409d09 --- /dev/null +++ b/ext/spice/src/cspice/spkr08.c @@ -0,0 +1,368 @@ +/* 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 new file mode 100644 index 0000000000..110e332615 --- /dev/null +++ b/ext/spice/src/cspice/spkr09.c @@ -0,0 +1,485 @@ +/* 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 new file mode 100644 index 0000000000..6a43d69356 --- /dev/null +++ b/ext/spice/src/cspice/spkr10.c @@ -0,0 +1,667 @@ +/* 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 new file mode 100644 index 0000000000..693f375d80 --- /dev/null +++ b/ext/spice/src/cspice/spkr12.c @@ -0,0 +1,200 @@ +/* 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 new file mode 100644 index 0000000000..9e2a5b6850 --- /dev/null +++ b/ext/spice/src/cspice/spkr13.c @@ -0,0 +1,205 @@ +/* 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 new file mode 100644 index 0000000000..f119e34b80 --- /dev/null +++ b/ext/spice/src/cspice/spkr14.c @@ -0,0 +1,238 @@ +/* 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 new file mode 100644 index 0000000000..409938f910 --- /dev/null +++ b/ext/spice/src/cspice/spkr15.c @@ -0,0 +1,266 @@ +/* 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 new file mode 100644 index 0000000000..aaf8a8b995 --- /dev/null +++ b/ext/spice/src/cspice/spkr17.c @@ -0,0 +1,279 @@ +/* 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 new file mode 100644 index 0000000000..212178cb6c --- /dev/null +++ b/ext/spice/src/cspice/spkr18.c @@ -0,0 +1,617 @@ +/* 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 new file mode 100644 index 0000000000..ecc8ac1a9e --- /dev/null +++ b/ext/spice/src/cspice/spks01.c @@ -0,0 +1,266 @@ +/* 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 new file mode 100644 index 0000000000..5b6099fa7d --- /dev/null +++ b/ext/spice/src/cspice/spks02.c @@ -0,0 +1,240 @@ +/* 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 new file mode 100644 index 0000000000..72be2b5f4c --- /dev/null +++ b/ext/spice/src/cspice/spks03.c @@ -0,0 +1,244 @@ +/* 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 new file mode 100644 index 0000000000..882faa2c26 --- /dev/null +++ b/ext/spice/src/cspice/spks05.c @@ -0,0 +1,294 @@ +/* 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 new file mode 100644 index 0000000000..46d2406177 --- /dev/null +++ b/ext/spice/src/cspice/spks08.c @@ -0,0 +1,327 @@ +/* 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 new file mode 100644 index 0000000000..99527328ba --- /dev/null +++ b/ext/spice/src/cspice/spks09.c @@ -0,0 +1,351 @@ +/* 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 new file mode 100644 index 0000000000..a4ee07322f --- /dev/null +++ b/ext/spice/src/cspice/spks10.c @@ -0,0 +1,664 @@ +/* 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 new file mode 100644 index 0000000000..9a1fb716ab --- /dev/null +++ b/ext/spice/src/cspice/spks12.c @@ -0,0 +1,183 @@ +/* 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 new file mode 100644 index 0000000000..7d6577a7a0 --- /dev/null +++ b/ext/spice/src/cspice/spks13.c @@ -0,0 +1,183 @@ +/* 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 new file mode 100644 index 0000000000..316ce629e4 --- /dev/null +++ b/ext/spice/src/cspice/spks14.c @@ -0,0 +1,285 @@ +/* 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 new file mode 100644 index 0000000000..0ad441d4de --- /dev/null +++ b/ext/spice/src/cspice/spks15.c @@ -0,0 +1,205 @@ +/* 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 new file mode 100644 index 0000000000..06d4ed93d3 --- /dev/null +++ b/ext/spice/src/cspice/spks17.c @@ -0,0 +1,205 @@ +/* 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 new file mode 100644 index 0000000000..03d06b4cc5 --- /dev/null +++ b/ext/spice/src/cspice/spks18.c @@ -0,0 +1,438 @@ +/* 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 new file mode 100644 index 0000000000..01e66219d4 --- /dev/null +++ b/ext/spice/src/cspice/spkssb.c @@ -0,0 +1,220 @@ +/* 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 new file mode 100644 index 0000000000..a482e77cff --- /dev/null +++ b/ext/spice/src/cspice/spkssb_c.c @@ -0,0 +1,213 @@ +/* + +-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 new file mode 100644 index 0000000000..f21eaca546 --- /dev/null +++ b/ext/spice/src/cspice/spksub.c @@ -0,0 +1,408 @@ +/* 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 new file mode 100644 index 0000000000..1c1763b9f3 --- /dev/null +++ b/ext/spice/src/cspice/spksub_c.c @@ -0,0 +1,236 @@ +/* + +-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 new file mode 100644 index 0000000000..7db418186f --- /dev/null +++ b/ext/spice/src/cspice/spkuds.c @@ -0,0 +1,212 @@ +/* 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 new file mode 100644 index 0000000000..6114a75ea8 --- /dev/null +++ b/ext/spice/src/cspice/spkuds_c.c @@ -0,0 +1,215 @@ +/* + +-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 new file mode 100644 index 0000000000..d83ced1124 --- /dev/null +++ b/ext/spice/src/cspice/spkuef_c.c @@ -0,0 +1,149 @@ +/* + +-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 new file mode 100644 index 0000000000..a0161fd37a --- /dev/null +++ b/ext/spice/src/cspice/spkw01.c @@ -0,0 +1,451 @@ +/* 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 new file mode 100644 index 0000000000..076c02e189 --- /dev/null +++ b/ext/spice/src/cspice/spkw02.c @@ -0,0 +1,490 @@ +/* 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 new file mode 100644 index 0000000000..a03499a4e2 --- /dev/null +++ b/ext/spice/src/cspice/spkw02_c.c @@ -0,0 +1,301 @@ +/* + +-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 new file mode 100644 index 0000000000..cc95689e44 --- /dev/null +++ b/ext/spice/src/cspice/spkw03.c @@ -0,0 +1,494 @@ +/* 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 new file mode 100644 index 0000000000..25b929e52a --- /dev/null +++ b/ext/spice/src/cspice/spkw03_c.c @@ -0,0 +1,312 @@ +/* + +-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 new file mode 100644 index 0000000000..e011efe016 --- /dev/null +++ b/ext/spice/src/cspice/spkw05.c @@ -0,0 +1,442 @@ +/* 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 new file mode 100644 index 0000000000..73e644ee91 --- /dev/null +++ b/ext/spice/src/cspice/spkw05_c.c @@ -0,0 +1,267 @@ +/* + +-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 new file mode 100644 index 0000000000..4d84b3f8a9 --- /dev/null +++ b/ext/spice/src/cspice/spkw08.c @@ -0,0 +1,507 @@ +/* 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 new file mode 100644 index 0000000000..8243dc8122 --- /dev/null +++ b/ext/spice/src/cspice/spkw08_c.c @@ -0,0 +1,309 @@ +/* + +-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 new file mode 100644 index 0000000000..76076cc160 --- /dev/null +++ b/ext/spice/src/cspice/spkw09.c @@ -0,0 +1,522 @@ +/* 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 new file mode 100644 index 0000000000..95ff006aa6 --- /dev/null +++ b/ext/spice/src/cspice/spkw09_c.c @@ -0,0 +1,286 @@ +/* + +-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 new file mode 100644 index 0000000000..703f8a42c8 --- /dev/null +++ b/ext/spice/src/cspice/spkw10.c @@ -0,0 +1,710 @@ +/* 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 new file mode 100644 index 0000000000..b105301e83 --- /dev/null +++ b/ext/spice/src/cspice/spkw10_c.c @@ -0,0 +1,287 @@ +/* + +-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 new file mode 100644 index 0000000000..6e1296a6d8 --- /dev/null +++ b/ext/spice/src/cspice/spkw12.c @@ -0,0 +1,472 @@ +/* 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 new file mode 100644 index 0000000000..7b7ee36a0f --- /dev/null +++ b/ext/spice/src/cspice/spkw12_c.c @@ -0,0 +1,296 @@ +/* + +-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 new file mode 100644 index 0000000000..3cf30febc1 --- /dev/null +++ b/ext/spice/src/cspice/spkw13.c @@ -0,0 +1,476 @@ +/* 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 new file mode 100644 index 0000000000..6cf88f2f7e --- /dev/null +++ b/ext/spice/src/cspice/spkw13_c.c @@ -0,0 +1,284 @@ +/* + +-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 new file mode 100644 index 0000000000..a2acdd8808 --- /dev/null +++ b/ext/spice/src/cspice/spkw15.c @@ -0,0 +1,501 @@ +/* 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 new file mode 100644 index 0000000000..a1af8fe0a8 --- /dev/null +++ b/ext/spice/src/cspice/spkw15_c.c @@ -0,0 +1,373 @@ +/* + +-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 new file mode 100644 index 0000000000..872b14135f --- /dev/null +++ b/ext/spice/src/cspice/spkw17.c @@ -0,0 +1,416 @@ +/* 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 new file mode 100644 index 0000000000..c806938fc9 --- /dev/null +++ b/ext/spice/src/cspice/spkw17_c.c @@ -0,0 +1,328 @@ +/* + +-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 new file mode 100644 index 0000000000..06e6f15b49 --- /dev/null +++ b/ext/spice/src/cspice/spkw18.c @@ -0,0 +1,640 @@ +/* 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 new file mode 100644 index 0000000000..bd02370fd0 --- /dev/null +++ b/ext/spice/src/cspice/spkw18_c.c @@ -0,0 +1,338 @@ +/* + +-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 new file mode 100644 index 0000000000..fd6ea25bfa --- /dev/null +++ b/ext/spice/src/cspice/srfrec.c @@ -0,0 +1,335 @@ +/* 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 new file mode 100644 index 0000000000..de9050d08e --- /dev/null +++ b/ext/spice/src/cspice/srfrec_c.c @@ -0,0 +1,288 @@ +/* + +-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 new file mode 100644 index 0000000000..a671495fbe --- /dev/null +++ b/ext/spice/src/cspice/srfxpt.c @@ -0,0 +1,1757 @@ +/* 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 new file mode 100644 index 0000000000..0c57004e4b --- /dev/null +++ b/ext/spice/src/cspice/srfxpt_c.c @@ -0,0 +1,996 @@ +/* + +-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 new file mode 100644 index 0000000000..6d245898c4 --- /dev/null +++ b/ext/spice/src/cspice/ssize_c.c @@ -0,0 +1,218 @@ +/* + +-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 new file mode 100644 index 0000000000..d103a9fc17 --- /dev/null +++ b/ext/spice/src/cspice/ssizec.c @@ -0,0 +1,222 @@ +/* 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 new file mode 100644 index 0000000000..b368d4dd76 --- /dev/null +++ b/ext/spice/src/cspice/ssized.c @@ -0,0 +1,218 @@ +/* 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 new file mode 100644 index 0000000000..975c3006b2 --- /dev/null +++ b/ext/spice/src/cspice/ssizei.c @@ -0,0 +1,218 @@ +/* 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 new file mode 100644 index 0000000000..c1e57bfce5 --- /dev/null +++ b/ext/spice/src/cspice/stcc01.c @@ -0,0 +1,452 @@ +/* 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 new file mode 100644 index 0000000000..b2159bc868 --- /dev/null +++ b/ext/spice/src/cspice/stcf01.c @@ -0,0 +1,338 @@ +/* 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 new file mode 100644 index 0000000000..d9fef498c0 --- /dev/null +++ b/ext/spice/src/cspice/stcg01.c @@ -0,0 +1,321 @@ +/* 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 new file mode 100644 index 0000000000..9acfa27c7a --- /dev/null +++ b/ext/spice/src/cspice/stcl01.c @@ -0,0 +1,245 @@ +/* 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 new file mode 100644 index 0000000000..3475933ec4 --- /dev/null +++ b/ext/spice/src/cspice/stdio.c @@ -0,0 +1,163 @@ +/* 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 new file mode 100644 index 0000000000..340080f820 --- /dev/null +++ b/ext/spice/src/cspice/stelab.c @@ -0,0 +1,316 @@ +/* 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 new file mode 100644 index 0000000000..b1354ef827 --- /dev/null +++ b/ext/spice/src/cspice/stelab_c.c @@ -0,0 +1,215 @@ +/* + +-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 new file mode 100644 index 0000000000..654db9d31c --- /dev/null +++ b/ext/spice/src/cspice/stlabx.c @@ -0,0 +1,240 @@ +/* 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 new file mode 100644 index 0000000000..e0917a43df --- /dev/null +++ b/ext/spice/src/cspice/stmp03.c @@ -0,0 +1,698 @@ +/* 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 new file mode 100644 index 0000000000..42da977ad2 --- /dev/null +++ b/ext/spice/src/cspice/stpool.c @@ -0,0 +1,450 @@ +/* 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 new file mode 100644 index 0000000000..4283c9268e --- /dev/null +++ b/ext/spice/src/cspice/stpool_c.c @@ -0,0 +1,474 @@ +/* + +-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 new file mode 100644 index 0000000000..366d7e75d2 --- /dev/null +++ b/ext/spice/src/cspice/str2et.c @@ -0,0 +1,1335 @@ +/* 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 new file mode 100644 index 0000000000..a2bcde2f16 --- /dev/null +++ b/ext/spice/src/cspice/str2et_c.c @@ -0,0 +1,643 @@ +/* + +-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 new file mode 100644 index 0000000000..72614244a5 --- /dev/null +++ b/ext/spice/src/cspice/subpnt.c @@ -0,0 +1,1881 @@ +/* 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 new file mode 100644 index 0000000000..fdaf3eb993 --- /dev/null +++ b/ext/spice/src/cspice/subpnt_c.c @@ -0,0 +1,1100 @@ +/* + +-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 new file mode 100644 index 0000000000..ef1a1a46ed --- /dev/null +++ b/ext/spice/src/cspice/subpt.c @@ -0,0 +1,649 @@ +/* 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 new file mode 100644 index 0000000000..eac35c16fe --- /dev/null +++ b/ext/spice/src/cspice/subpt_c.c @@ -0,0 +1,514 @@ +/* + +-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 new file mode 100644 index 0000000000..4207d36396 --- /dev/null +++ b/ext/spice/src/cspice/subslr.c @@ -0,0 +1,1586 @@ +/* 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 new file mode 100644 index 0000000000..895a98ed8e --- /dev/null +++ b/ext/spice/src/cspice/subslr_c.c @@ -0,0 +1,792 @@ +/* + +-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 new file mode 100644 index 0000000000..022547dd59 --- /dev/null +++ b/ext/spice/src/cspice/subsol.c @@ -0,0 +1,617 @@ +/* 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 new file mode 100644 index 0000000000..b3f63b7bb0 --- /dev/null +++ b/ext/spice/src/cspice/subsol_c.c @@ -0,0 +1,489 @@ +/* + +-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 new file mode 100644 index 0000000000..d2a7c34f12 --- /dev/null +++ b/ext/spice/src/cspice/sue.c @@ -0,0 +1,83 @@ +#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 new file mode 100644 index 0000000000..d855ce118c --- /dev/null +++ b/ext/spice/src/cspice/suffix.c @@ -0,0 +1,181 @@ +/* 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 new file mode 100644 index 0000000000..b6928efa2e --- /dev/null +++ b/ext/spice/src/cspice/sumad.c @@ -0,0 +1,165 @@ +/* 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 new file mode 100644 index 0000000000..261c0d0ba4 --- /dev/null +++ b/ext/spice/src/cspice/sumad_c.c @@ -0,0 +1,160 @@ +/* + +-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 new file mode 100644 index 0000000000..9fe41482b4 --- /dev/null +++ b/ext/spice/src/cspice/sumai.c @@ -0,0 +1,163 @@ +/* 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 new file mode 100644 index 0000000000..52c5689dda --- /dev/null +++ b/ext/spice/src/cspice/sumai_c.c @@ -0,0 +1,160 @@ +/* + +-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 new file mode 100644 index 0000000000..40af905db8 --- /dev/null +++ b/ext/spice/src/cspice/surfnm.c @@ -0,0 +1,294 @@ +/* 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 new file mode 100644 index 0000000000..b598561897 --- /dev/null +++ b/ext/spice/src/cspice/surfnm_c.c @@ -0,0 +1,190 @@ +/* + +-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 new file mode 100644 index 0000000000..eb4d5467b3 --- /dev/null +++ b/ext/spice/src/cspice/surfpt.c @@ -0,0 +1,487 @@ +/* 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 new file mode 100644 index 0000000000..2ea10037b8 --- /dev/null +++ b/ext/spice/src/cspice/surfpt_c.c @@ -0,0 +1,270 @@ +/* + +-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 new file mode 100644 index 0000000000..d524ce81e1 --- /dev/null +++ b/ext/spice/src/cspice/surfpv.c @@ -0,0 +1,682 @@ +/* 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 new file mode 100644 index 0000000000..d77981b802 --- /dev/null +++ b/ext/spice/src/cspice/surfpv_c.c @@ -0,0 +1,516 @@ +/* + +-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 new file mode 100644 index 0000000000..57fc8fa7c5 --- /dev/null +++ b/ext/spice/src/cspice/swapac.c @@ -0,0 +1,442 @@ +/* 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 new file mode 100644 index 0000000000..5b3b93e9c9 --- /dev/null +++ b/ext/spice/src/cspice/swapad.c @@ -0,0 +1,440 @@ +/* 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 new file mode 100644 index 0000000000..97b03cbb46 --- /dev/null +++ b/ext/spice/src/cspice/swapai.c @@ -0,0 +1,438 @@ +/* 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 new file mode 100644 index 0000000000..471dcde59e --- /dev/null +++ b/ext/spice/src/cspice/swapc.c @@ -0,0 +1,173 @@ +/* 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 new file mode 100644 index 0000000000..ab3a78905b --- /dev/null +++ b/ext/spice/src/cspice/swapd.c @@ -0,0 +1,139 @@ +/* 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 new file mode 100644 index 0000000000..8dd10d037b --- /dev/null +++ b/ext/spice/src/cspice/swapi.c @@ -0,0 +1,139 @@ +/* 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 new file mode 100644 index 0000000000..078a422feb --- /dev/null +++ b/ext/spice/src/cspice/swpool_c.c @@ -0,0 +1,290 @@ +/* + +-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 new file mode 100644 index 0000000000..a538d8873a --- /dev/null +++ b/ext/spice/src/cspice/sxform.c @@ -0,0 +1,233 @@ +/* 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 new file mode 100644 index 0000000000..e1daace462 --- /dev/null +++ b/ext/spice/src/cspice/sxform_c.c @@ -0,0 +1,236 @@ +/* + +-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 new file mode 100644 index 0000000000..ac483a73d7 --- /dev/null +++ b/ext/spice/src/cspice/sydelc.c @@ -0,0 +1,217 @@ +/* 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 new file mode 100644 index 0000000000..49d69996ca --- /dev/null +++ b/ext/spice/src/cspice/sydeld.c @@ -0,0 +1,220 @@ +/* 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 new file mode 100644 index 0000000000..f00ea4406e --- /dev/null +++ b/ext/spice/src/cspice/sydeli.c @@ -0,0 +1,217 @@ +/* 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 new file mode 100644 index 0000000000..5249e0270a --- /dev/null +++ b/ext/spice/src/cspice/sydimc.c @@ -0,0 +1,210 @@ +/* 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 new file mode 100644 index 0000000000..5cb7c5c598 --- /dev/null +++ b/ext/spice/src/cspice/sydimd.c @@ -0,0 +1,211 @@ +/* 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 new file mode 100644 index 0000000000..19e8adc033 --- /dev/null +++ b/ext/spice/src/cspice/sydimi.c @@ -0,0 +1,216 @@ +/* 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 new file mode 100644 index 0000000000..a6ddb756fd --- /dev/null +++ b/ext/spice/src/cspice/sydupc.c @@ -0,0 +1,342 @@ +/* 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 new file mode 100644 index 0000000000..278e429007 --- /dev/null +++ b/ext/spice/src/cspice/sydupd.c @@ -0,0 +1,339 @@ +/* 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 new file mode 100644 index 0000000000..cf517903eb --- /dev/null +++ b/ext/spice/src/cspice/sydupi.c @@ -0,0 +1,339 @@ +/* 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 new file mode 100644 index 0000000000..5853340c67 --- /dev/null +++ b/ext/spice/src/cspice/syenqc.c @@ -0,0 +1,260 @@ +/* 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 new file mode 100644 index 0000000000..73c7742135 --- /dev/null +++ b/ext/spice/src/cspice/syenqd.c @@ -0,0 +1,262 @@ +/* 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 new file mode 100644 index 0000000000..bd9f24ad62 --- /dev/null +++ b/ext/spice/src/cspice/syenqi.c @@ -0,0 +1,259 @@ +/* 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 new file mode 100644 index 0000000000..417b882d88 --- /dev/null +++ b/ext/spice/src/cspice/syfetc.c @@ -0,0 +1,205 @@ +/* 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 new file mode 100644 index 0000000000..6f438efed0 --- /dev/null +++ b/ext/spice/src/cspice/syfetd.c @@ -0,0 +1,204 @@ +/* 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 new file mode 100644 index 0000000000..0aa2841e8f --- /dev/null +++ b/ext/spice/src/cspice/syfeti.c @@ -0,0 +1,206 @@ +/* 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 new file mode 100644 index 0000000000..4e1bb09d93 --- /dev/null +++ b/ext/spice/src/cspice/sygetc.c @@ -0,0 +1,244 @@ +/* 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 new file mode 100644 index 0000000000..cd8b94e7f8 --- /dev/null +++ b/ext/spice/src/cspice/sygetd.c @@ -0,0 +1,247 @@ +/* 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 new file mode 100644 index 0000000000..1c6f2f1788 --- /dev/null +++ b/ext/spice/src/cspice/sygeti.c @@ -0,0 +1,245 @@ +/* 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 new file mode 100644 index 0000000000..95aa2c9f1e --- /dev/null +++ b/ext/spice/src/cspice/synthc.c @@ -0,0 +1,235 @@ +/* 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 new file mode 100644 index 0000000000..a991010773 --- /dev/null +++ b/ext/spice/src/cspice/synthd.c @@ -0,0 +1,231 @@ +/* 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 new file mode 100644 index 0000000000..27c6f0bc32 --- /dev/null +++ b/ext/spice/src/cspice/synthi.c @@ -0,0 +1,230 @@ +/* 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 new file mode 100644 index 0000000000..4efb50ae42 --- /dev/null +++ b/ext/spice/src/cspice/syordc.c @@ -0,0 +1,207 @@ +/* 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 new file mode 100644 index 0000000000..d923299ad5 --- /dev/null +++ b/ext/spice/src/cspice/syordd.c @@ -0,0 +1,210 @@ +/* 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 new file mode 100644 index 0000000000..dbe52ddb08 --- /dev/null +++ b/ext/spice/src/cspice/syordi.c @@ -0,0 +1,212 @@ +/* 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 new file mode 100644 index 0000000000..7fc742fb22 --- /dev/null +++ b/ext/spice/src/cspice/sypopc.c @@ -0,0 +1,268 @@ +/* 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 new file mode 100644 index 0000000000..4b9ec0b584 --- /dev/null +++ b/ext/spice/src/cspice/sypopd.c @@ -0,0 +1,275 @@ +/* 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 new file mode 100644 index 0000000000..889591043c --- /dev/null +++ b/ext/spice/src/cspice/sypopi.c @@ -0,0 +1,273 @@ +/* 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 new file mode 100644 index 0000000000..2bb102d2af --- /dev/null +++ b/ext/spice/src/cspice/sypshc.c @@ -0,0 +1,261 @@ +/* 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 new file mode 100644 index 0000000000..ee01813dc5 --- /dev/null +++ b/ext/spice/src/cspice/sypshd.c @@ -0,0 +1,263 @@ +/* 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 new file mode 100644 index 0000000000..786b82203c --- /dev/null +++ b/ext/spice/src/cspice/sypshi.c @@ -0,0 +1,260 @@ +/* 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 new file mode 100644 index 0000000000..59236ae0e9 --- /dev/null +++ b/ext/spice/src/cspice/syputc.c @@ -0,0 +1,345 @@ +/* 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 new file mode 100644 index 0000000000..dccd92ef01 --- /dev/null +++ b/ext/spice/src/cspice/syputd.c @@ -0,0 +1,361 @@ +/* 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 new file mode 100644 index 0000000000..e7e3066215 --- /dev/null +++ b/ext/spice/src/cspice/syputi.c @@ -0,0 +1,352 @@ +/* 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 new file mode 100644 index 0000000000..e6656d4036 --- /dev/null +++ b/ext/spice/src/cspice/syrenc.c @@ -0,0 +1,303 @@ +/* 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 new file mode 100644 index 0000000000..2e0b47a3ca --- /dev/null +++ b/ext/spice/src/cspice/syrend.c @@ -0,0 +1,300 @@ +/* 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 new file mode 100644 index 0000000000..83e9aefa8d --- /dev/null +++ b/ext/spice/src/cspice/syreni.c @@ -0,0 +1,299 @@ +/* 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 new file mode 100644 index 0000000000..3e717abb6c --- /dev/null +++ b/ext/spice/src/cspice/syselc.c @@ -0,0 +1,275 @@ +/* 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 new file mode 100644 index 0000000000..d2930cb128 --- /dev/null +++ b/ext/spice/src/cspice/syseld.c @@ -0,0 +1,271 @@ +/* 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 new file mode 100644 index 0000000000..df83ccf1b8 --- /dev/null +++ b/ext/spice/src/cspice/syseli.c @@ -0,0 +1,273 @@ +/* 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 new file mode 100644 index 0000000000..96355cc052 --- /dev/null +++ b/ext/spice/src/cspice/sysetc.c @@ -0,0 +1,312 @@ +/* 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 new file mode 100644 index 0000000000..984b92218f --- /dev/null +++ b/ext/spice/src/cspice/sysetd.c @@ -0,0 +1,307 @@ +/* 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 new file mode 100644 index 0000000000..d6ee44a597 --- /dev/null +++ b/ext/spice/src/cspice/syseti.c @@ -0,0 +1,305 @@ +/* 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 new file mode 100644 index 0000000000..18fdce9215 --- /dev/null +++ b/ext/spice/src/cspice/system_.c @@ -0,0 +1,122 @@ +/* + +-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 new file mode 100644 index 0000000000..de10a4a026 --- /dev/null +++ b/ext/spice/src/cspice/sytrnc.c @@ -0,0 +1,260 @@ +/* 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 new file mode 100644 index 0000000000..da6434679c --- /dev/null +++ b/ext/spice/src/cspice/sytrnd.c @@ -0,0 +1,265 @@ +/* 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 new file mode 100644 index 0000000000..e046a93f9e --- /dev/null +++ b/ext/spice/src/cspice/sytrni.c @@ -0,0 +1,263 @@ +/* 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 new file mode 100644 index 0000000000..b20b282d10 --- /dev/null +++ b/ext/spice/src/cspice/szpool_c.c @@ -0,0 +1,238 @@ +/* + +-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 new file mode 100644 index 0000000000..dc664675ea --- /dev/null +++ b/ext/spice/src/cspice/tcheck.c @@ -0,0 +1,905 @@ +/* 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 new file mode 100644 index 0000000000..c35be5b0ca --- /dev/null +++ b/ext/spice/src/cspice/texpyr.c @@ -0,0 +1,318 @@ +/* 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 new file mode 100644 index 0000000000..82b30c3e8f --- /dev/null +++ b/ext/spice/src/cspice/timdef.c @@ -0,0 +1,438 @@ +/* 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 new file mode 100644 index 0000000000..244a0ae585 --- /dev/null +++ b/ext/spice/src/cspice/timdef_c.c @@ -0,0 +1,352 @@ +/* + +-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 new file mode 100644 index 0000000000..471c943c89 --- /dev/null +++ b/ext/spice/src/cspice/timout.c @@ -0,0 +1,2099 @@ +/* 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 new file mode 100644 index 0000000000..567b40c732 --- /dev/null +++ b/ext/spice/src/cspice/timout_c.c @@ -0,0 +1,526 @@ +/* + +-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 new file mode 100644 index 0000000000..1462303d33 --- /dev/null +++ b/ext/spice/src/cspice/tipbod.c @@ -0,0 +1,393 @@ +/* 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 new file mode 100644 index 0000000000..4795dfbd81 --- /dev/null +++ b/ext/spice/src/cspice/tipbod_c.c @@ -0,0 +1,350 @@ +/* + +-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 new file mode 100644 index 0000000000..f622cd7629 --- /dev/null +++ b/ext/spice/src/cspice/tisbod.c @@ -0,0 +1,1229 @@ +/* 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 new file mode 100644 index 0000000000..5f0b69cebc --- /dev/null +++ b/ext/spice/src/cspice/tisbod_c.c @@ -0,0 +1,505 @@ +/* + +-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 new file mode 100644 index 0000000000..68bd12a304 --- /dev/null +++ b/ext/spice/src/cspice/tkfram.c @@ -0,0 +1,881 @@ +/* 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 new file mode 100644 index 0000000000..18eb2966fb --- /dev/null +++ b/ext/spice/src/cspice/tkvrsn.c @@ -0,0 +1,279 @@ +/* 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 new file mode 100644 index 0000000000..2fa6fbf6e8 --- /dev/null +++ b/ext/spice/src/cspice/tkvrsn_c.c @@ -0,0 +1,243 @@ +/* + +-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 new file mode 100644 index 0000000000..247ca6189b --- /dev/null +++ b/ext/spice/src/cspice/tostdo.c @@ -0,0 +1,134 @@ +/* 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 new file mode 100644 index 0000000000..4d1de6dc15 --- /dev/null +++ b/ext/spice/src/cspice/touchc.c @@ -0,0 +1,149 @@ +/* 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 new file mode 100644 index 0000000000..6582fc441a --- /dev/null +++ b/ext/spice/src/cspice/touchd.c @@ -0,0 +1,151 @@ +/* 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 new file mode 100644 index 0000000000..31570ae89d --- /dev/null +++ b/ext/spice/src/cspice/touchi.c @@ -0,0 +1,151 @@ +/* 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 new file mode 100644 index 0000000000..172957a4e3 --- /dev/null +++ b/ext/spice/src/cspice/touchl.c @@ -0,0 +1,151 @@ +/* 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 new file mode 100644 index 0000000000..dedb598c61 --- /dev/null +++ b/ext/spice/src/cspice/tparse.c @@ -0,0 +1,599 @@ +/* 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 new file mode 100644 index 0000000000..89fe88e406 --- /dev/null +++ b/ext/spice/src/cspice/tparse_c.c @@ -0,0 +1,383 @@ +/* + +-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 new file mode 100644 index 0000000000..27d33d8b99 --- /dev/null +++ b/ext/spice/src/cspice/tpartv.c @@ -0,0 +1,1291 @@ +/* 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 new file mode 100644 index 0000000000..46a462a3b8 --- /dev/null +++ b/ext/spice/src/cspice/tpictr.c @@ -0,0 +1,209 @@ +/* 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 new file mode 100644 index 0000000000..2f37b92361 --- /dev/null +++ b/ext/spice/src/cspice/tpictr_c.c @@ -0,0 +1,254 @@ +/* + +-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 new file mode 100644 index 0000000000..abca738686 --- /dev/null +++ b/ext/spice/src/cspice/trace.c @@ -0,0 +1,131 @@ +/* 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 new file mode 100644 index 0000000000..2cdf12ad92 --- /dev/null +++ b/ext/spice/src/cspice/trace_c.c @@ -0,0 +1,140 @@ +/* + +-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 new file mode 100644 index 0000000000..65de9925a4 --- /dev/null +++ b/ext/spice/src/cspice/traceg.c @@ -0,0 +1,154 @@ +/* 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 new file mode 100644 index 0000000000..c09c57c556 --- /dev/null +++ b/ext/spice/src/cspice/trcoff_c.c @@ -0,0 +1,145 @@ +/* + +-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 new file mode 100644 index 0000000000..19eaa5d7be --- /dev/null +++ b/ext/spice/src/cspice/trcpkg.c @@ -0,0 +1,2640 @@ +/* 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 new file mode 100644 index 0000000000..71c33648e3 --- /dev/null +++ b/ext/spice/src/cspice/tsetyr_c.c @@ -0,0 +1,177 @@ +/* + +-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 new file mode 100644 index 0000000000..cb8086f0ce --- /dev/null +++ b/ext/spice/src/cspice/ttrans.c @@ -0,0 +1,1556 @@ +/* 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 new file mode 100644 index 0000000000..2553ed1748 --- /dev/null +++ b/ext/spice/src/cspice/twopi.c @@ -0,0 +1,160 @@ +/* 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 new file mode 100644 index 0000000000..f85d0e593b --- /dev/null +++ b/ext/spice/src/cspice/twopi_c.c @@ -0,0 +1,143 @@ +/* + +-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 new file mode 100644 index 0000000000..592154edfa --- /dev/null +++ b/ext/spice/src/cspice/twovec.c @@ -0,0 +1,319 @@ +/* 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 new file mode 100644 index 0000000000..2ba0e19071 --- /dev/null +++ b/ext/spice/src/cspice/twovec_c.c @@ -0,0 +1,208 @@ +/* + +-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 new file mode 100644 index 0000000000..0b328d56ae --- /dev/null +++ b/ext/spice/src/cspice/twovxf.c @@ -0,0 +1,332 @@ +/* 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 new file mode 100644 index 0000000000..65d480a2c1 --- /dev/null +++ b/ext/spice/src/cspice/txtopn.c @@ -0,0 +1,349 @@ +/* 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 new file mode 100644 index 0000000000..67c6e898dc --- /dev/null +++ b/ext/spice/src/cspice/txtopr.c @@ -0,0 +1,374 @@ +/* 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 new file mode 100644 index 0000000000..6ff78113ef --- /dev/null +++ b/ext/spice/src/cspice/tyear.c @@ -0,0 +1,129 @@ +/* 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 new file mode 100644 index 0000000000..096a5d6ec9 --- /dev/null +++ b/ext/spice/src/cspice/tyear_c.c @@ -0,0 +1,127 @@ +/* + +-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 new file mode 100644 index 0000000000..1cb20ff286 --- /dev/null +++ b/ext/spice/src/cspice/typesize.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..3f6216f8e0 --- /dev/null +++ b/ext/spice/src/cspice/ucase.c @@ -0,0 +1,185 @@ +/* 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 new file mode 100644 index 0000000000..5f1bae2d76 --- /dev/null +++ b/ext/spice/src/cspice/ucase_c.c @@ -0,0 +1,226 @@ +/* + +-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 new file mode 100644 index 0000000000..f81a65d637 --- /dev/null +++ b/ext/spice/src/cspice/ucrss.c @@ -0,0 +1,191 @@ +/* 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 new file mode 100644 index 0000000000..9df94a25ee --- /dev/null +++ b/ext/spice/src/cspice/ucrss_c.c @@ -0,0 +1,216 @@ +/* + +-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 new file mode 100644 index 0000000000..0db1c3c236 --- /dev/null +++ b/ext/spice/src/cspice/uddc.c @@ -0,0 +1,201 @@ +/* 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 new file mode 100644 index 0000000000..33e95c24fa --- /dev/null +++ b/ext/spice/src/cspice/uddc_c.c @@ -0,0 +1,206 @@ +/* +-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 new file mode 100644 index 0000000000..7cb4e7304d --- /dev/null +++ b/ext/spice/src/cspice/uddf.c @@ -0,0 +1,311 @@ +/* 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 new file mode 100644 index 0000000000..6c01009eb5 --- /dev/null +++ b/ext/spice/src/cspice/uddf_c.c @@ -0,0 +1,274 @@ +/* + +-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 new file mode 100644 index 0000000000..e40875e0f7 --- /dev/null +++ b/ext/spice/src/cspice/uio.c @@ -0,0 +1,68 @@ +#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 new file mode 100644 index 0000000000..d5fd096618 --- /dev/null +++ b/ext/spice/src/cspice/union_c.c @@ -0,0 +1,377 @@ +/* + +-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 new file mode 100644 index 0000000000..29e0b976ba --- /dev/null +++ b/ext/spice/src/cspice/unionc.c @@ -0,0 +1,324 @@ +/* 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 new file mode 100644 index 0000000000..568ecce784 --- /dev/null +++ b/ext/spice/src/cspice/uniond.c @@ -0,0 +1,272 @@ +/* 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 new file mode 100644 index 0000000000..14d584bfbb --- /dev/null +++ b/ext/spice/src/cspice/unioni.c @@ -0,0 +1,273 @@ +/* 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 new file mode 100644 index 0000000000..9babb9450b --- /dev/null +++ b/ext/spice/src/cspice/unitim.c @@ -0,0 +1,652 @@ +/* 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 new file mode 100644 index 0000000000..67c7339b7f --- /dev/null +++ b/ext/spice/src/cspice/unitim_c.c @@ -0,0 +1,231 @@ +/* + +-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 new file mode 100644 index 0000000000..cc7b1782d2 --- /dev/null +++ b/ext/spice/src/cspice/unload_c.c @@ -0,0 +1,207 @@ +/* + +-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 new file mode 100644 index 0000000000..4a45ccf1e6 --- /dev/null +++ b/ext/spice/src/cspice/unorm.c @@ -0,0 +1,170 @@ +/* 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 new file mode 100644 index 0000000000..89f24decb2 --- /dev/null +++ b/ext/spice/src/cspice/unorm_c.c @@ -0,0 +1,166 @@ +/* + +-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 new file mode 100644 index 0000000000..fd6bafaaff --- /dev/null +++ b/ext/spice/src/cspice/unormg.c @@ -0,0 +1,189 @@ +/* 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 new file mode 100644 index 0000000000..531d7410b8 --- /dev/null +++ b/ext/spice/src/cspice/unormg_c.c @@ -0,0 +1,205 @@ +/* + +-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 new file mode 100644 index 0000000000..9392a88fb1 --- /dev/null +++ b/ext/spice/src/cspice/utc2et.c @@ -0,0 +1,420 @@ +/* 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 new file mode 100644 index 0000000000..d0ea1134df --- /dev/null +++ b/ext/spice/src/cspice/utc2et_c.c @@ -0,0 +1,296 @@ +/* + +-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 new file mode 100644 index 0000000000..6468db0cd2 --- /dev/null +++ b/ext/spice/src/cspice/util.c @@ -0,0 +1,53 @@ +#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 new file mode 100644 index 0000000000..180b713be1 --- /dev/null +++ b/ext/spice/src/cspice/vadd_c.c @@ -0,0 +1,139 @@ +/* + +-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 new file mode 100644 index 0000000000..a45b5d4e7b --- /dev/null +++ b/ext/spice/src/cspice/vaddg.c @@ -0,0 +1,166 @@ +/* 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 new file mode 100644 index 0000000000..df8740dc59 --- /dev/null +++ b/ext/spice/src/cspice/vaddg_c.c @@ -0,0 +1,155 @@ +/* + +-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 new file mode 100644 index 0000000000..7cb9d96d98 --- /dev/null +++ b/ext/spice/src/cspice/valid_c.c @@ -0,0 +1,322 @@ +/* + +-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 new file mode 100644 index 0000000000..a860bfeddd --- /dev/null +++ b/ext/spice/src/cspice/validc.c @@ -0,0 +1,225 @@ +/* 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 new file mode 100644 index 0000000000..8d5043dd5c --- /dev/null +++ b/ext/spice/src/cspice/validd.c @@ -0,0 +1,228 @@ +/* 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 new file mode 100644 index 0000000000..e5a36a2072 --- /dev/null +++ b/ext/spice/src/cspice/validi.c @@ -0,0 +1,224 @@ +/* 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 new file mode 100644 index 0000000000..38d7c2b4f2 --- /dev/null +++ b/ext/spice/src/cspice/vcrss.c @@ -0,0 +1,155 @@ +/* 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 new file mode 100644 index 0000000000..9635fcb3e1 --- /dev/null +++ b/ext/spice/src/cspice/vcrss_c.c @@ -0,0 +1,174 @@ +/* + +-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 new file mode 100644 index 0000000000..ba394730d3 --- /dev/null +++ b/ext/spice/src/cspice/vdist.c @@ -0,0 +1,192 @@ +/* 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 new file mode 100644 index 0000000000..e0cc56f6e2 --- /dev/null +++ b/ext/spice/src/cspice/vdist_c.c @@ -0,0 +1,194 @@ +/* + +-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 new file mode 100644 index 0000000000..25a9f924d6 --- /dev/null +++ b/ext/spice/src/cspice/vdistg.c @@ -0,0 +1,212 @@ +/* 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 new file mode 100644 index 0000000000..9342730df0 --- /dev/null +++ b/ext/spice/src/cspice/vdistg_c.c @@ -0,0 +1,224 @@ +/* + +-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 new file mode 100644 index 0000000000..41460f2cc8 --- /dev/null +++ b/ext/spice/src/cspice/vdot.c @@ -0,0 +1,137 @@ +/* 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 new file mode 100644 index 0000000000..9895b1d1e5 --- /dev/null +++ b/ext/spice/src/cspice/vdot_c.c @@ -0,0 +1,151 @@ +/* + +-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 new file mode 100644 index 0000000000..1f99337580 --- /dev/null +++ b/ext/spice/src/cspice/vdotg.c @@ -0,0 +1,147 @@ +/* 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 new file mode 100644 index 0000000000..d44642a1b6 --- /dev/null +++ b/ext/spice/src/cspice/vdotg_c.c @@ -0,0 +1,191 @@ +/* + +-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 new file mode 100644 index 0000000000..ce5d7e8cf5 --- /dev/null +++ b/ext/spice/src/cspice/vequ.c @@ -0,0 +1,129 @@ +/* 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 new file mode 100644 index 0000000000..730685101a --- /dev/null +++ b/ext/spice/src/cspice/vequ_c.c @@ -0,0 +1,133 @@ +/* + +-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 new file mode 100644 index 0000000000..85615c4cb5 --- /dev/null +++ b/ext/spice/src/cspice/vequg.c @@ -0,0 +1,150 @@ +/* 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 new file mode 100644 index 0000000000..daf91ca52c --- /dev/null +++ b/ext/spice/src/cspice/vequg_c.c @@ -0,0 +1,155 @@ +/* + +-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 new file mode 100644 index 0000000000..b5a80eba30 --- /dev/null +++ b/ext/spice/src/cspice/vhat.c @@ -0,0 +1,165 @@ +/* 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 new file mode 100644 index 0000000000..35ac8eb3c9 --- /dev/null +++ b/ext/spice/src/cspice/vhat_c.c @@ -0,0 +1,177 @@ +/* + +-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 new file mode 100644 index 0000000000..e379f4dbf1 --- /dev/null +++ b/ext/spice/src/cspice/vhatg.c @@ -0,0 +1,179 @@ +/* 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 new file mode 100644 index 0000000000..8b7e63feff --- /dev/null +++ b/ext/spice/src/cspice/vhatg_c.c @@ -0,0 +1,174 @@ +/* + +-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 new file mode 100644 index 0000000000..cff05b0022 --- /dev/null +++ b/ext/spice/src/cspice/vhatip.c @@ -0,0 +1,166 @@ +/* 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 new file mode 100644 index 0000000000..d68350d48d --- /dev/null +++ b/ext/spice/src/cspice/vlcom.c @@ -0,0 +1,164 @@ +/* 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 new file mode 100644 index 0000000000..3b3e965cac --- /dev/null +++ b/ext/spice/src/cspice/vlcom3.c @@ -0,0 +1,143 @@ +/* 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 new file mode 100644 index 0000000000..8a4e1f66b9 --- /dev/null +++ b/ext/spice/src/cspice/vlcom3_c.c @@ -0,0 +1,157 @@ +/* + +-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 new file mode 100644 index 0000000000..66d120420b --- /dev/null +++ b/ext/spice/src/cspice/vlcom_c.c @@ -0,0 +1,166 @@ +/* + +-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 new file mode 100644 index 0000000000..71ba236c2e --- /dev/null +++ b/ext/spice/src/cspice/vlcomg.c @@ -0,0 +1,167 @@ +/* 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 new file mode 100644 index 0000000000..142f9da545 --- /dev/null +++ b/ext/spice/src/cspice/vlcomg_c.c @@ -0,0 +1,152 @@ +/* + +-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 new file mode 100644 index 0000000000..152959d0c2 --- /dev/null +++ b/ext/spice/src/cspice/vminug.c @@ -0,0 +1,158 @@ +/* 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 new file mode 100644 index 0000000000..fabb1ec1a2 --- /dev/null +++ b/ext/spice/src/cspice/vminug_c.c @@ -0,0 +1,146 @@ +/* + +-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 new file mode 100644 index 0000000000..b914aeb244 --- /dev/null +++ b/ext/spice/src/cspice/vminus.c @@ -0,0 +1,134 @@ +/* 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 new file mode 100644 index 0000000000..87f6175878 --- /dev/null +++ b/ext/spice/src/cspice/vminus_c.c @@ -0,0 +1,138 @@ +/* + +-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 new file mode 100644 index 0000000000..e4d5e1190c --- /dev/null +++ b/ext/spice/src/cspice/vnorm.c @@ -0,0 +1,168 @@ +/* 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 new file mode 100644 index 0000000000..73020cf00c --- /dev/null +++ b/ext/spice/src/cspice/vnorm_c.c @@ -0,0 +1,181 @@ +/* + +-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 new file mode 100644 index 0000000000..65d32c58d4 --- /dev/null +++ b/ext/spice/src/cspice/vnormg.c @@ -0,0 +1,187 @@ +/* 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 new file mode 100644 index 0000000000..d785dff1a6 --- /dev/null +++ b/ext/spice/src/cspice/vnormg_c.c @@ -0,0 +1,212 @@ +/* + +-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 new file mode 100644 index 0000000000..fb81ba72a4 --- /dev/null +++ b/ext/spice/src/cspice/vpack.c @@ -0,0 +1,151 @@ +/* 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 new file mode 100644 index 0000000000..a3e6e5e0df --- /dev/null +++ b/ext/spice/src/cspice/vpack_c.c @@ -0,0 +1,155 @@ +/* + +-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 new file mode 100644 index 0000000000..eda62b58fd --- /dev/null +++ b/ext/spice/src/cspice/vperp.c @@ -0,0 +1,204 @@ +/* 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 new file mode 100644 index 0000000000..f808b49c0b --- /dev/null +++ b/ext/spice/src/cspice/vperp_c.c @@ -0,0 +1,187 @@ +/* + +-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 new file mode 100644 index 0000000000..f76f9bbf20 --- /dev/null +++ b/ext/spice/src/cspice/vprjp.c @@ -0,0 +1,199 @@ +/* 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 new file mode 100644 index 0000000000..7c9dbff125 --- /dev/null +++ b/ext/spice/src/cspice/vprjp_c.c @@ -0,0 +1,197 @@ +/* + +-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 new file mode 100644 index 0000000000..d41c849889 --- /dev/null +++ b/ext/spice/src/cspice/vprjpi.c @@ -0,0 +1,352 @@ +/* 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 new file mode 100644 index 0000000000..8151635a21 --- /dev/null +++ b/ext/spice/src/cspice/vprjpi_c.c @@ -0,0 +1,362 @@ +/* + +-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 new file mode 100644 index 0000000000..755211946e --- /dev/null +++ b/ext/spice/src/cspice/vproj.c @@ -0,0 +1,186 @@ +/* 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 new file mode 100644 index 0000000000..0c2d521b41 --- /dev/null +++ b/ext/spice/src/cspice/vproj_c.c @@ -0,0 +1,179 @@ +/* + +-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 new file mode 100644 index 0000000000..3f5495fd6a --- /dev/null +++ b/ext/spice/src/cspice/vprojg.c @@ -0,0 +1,186 @@ +/* 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 new file mode 100644 index 0000000000..0f5f996b6f --- /dev/null +++ b/ext/spice/src/cspice/vrel.c @@ -0,0 +1,220 @@ +/* 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 new file mode 100644 index 0000000000..ecbedce4d1 --- /dev/null +++ b/ext/spice/src/cspice/vrel_c.c @@ -0,0 +1,227 @@ +/* + +-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 new file mode 100644 index 0000000000..3a5c5edc22 --- /dev/null +++ b/ext/spice/src/cspice/vrelg.c @@ -0,0 +1,249 @@ +/* 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 new file mode 100644 index 0000000000..e6b7912e50 --- /dev/null +++ b/ext/spice/src/cspice/vrelg_c.c @@ -0,0 +1,249 @@ +/* + +-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 new file mode 100644 index 0000000000..7cd540c35f --- /dev/null +++ b/ext/spice/src/cspice/vrotv.c @@ -0,0 +1,246 @@ +/* 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 new file mode 100644 index 0000000000..c32373f925 --- /dev/null +++ b/ext/spice/src/cspice/vrotv_c.c @@ -0,0 +1,183 @@ +/* + +-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 new file mode 100644 index 0000000000..0ba1e7bbb5 --- /dev/null +++ b/ext/spice/src/cspice/vscl.c @@ -0,0 +1,137 @@ +/* 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 new file mode 100644 index 0000000000..23143b53a9 --- /dev/null +++ b/ext/spice/src/cspice/vscl_c.c @@ -0,0 +1,140 @@ +/* + +-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 new file mode 100644 index 0000000000..42b947ec6c --- /dev/null +++ b/ext/spice/src/cspice/vsclg.c @@ -0,0 +1,163 @@ +/* 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 new file mode 100644 index 0000000000..78aa34c646 --- /dev/null +++ b/ext/spice/src/cspice/vsclg_c.c @@ -0,0 +1,157 @@ +/* + +-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 new file mode 100644 index 0000000000..6ddb7711c9 --- /dev/null +++ b/ext/spice/src/cspice/vsclip.c @@ -0,0 +1,139 @@ +/* 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 new file mode 100644 index 0000000000..867440ea7d --- /dev/null +++ b/ext/spice/src/cspice/vsep.c @@ -0,0 +1,242 @@ +/* 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 new file mode 100644 index 0000000000..4b828fe8e1 --- /dev/null +++ b/ext/spice/src/cspice/vsep_c.c @@ -0,0 +1,231 @@ +/* + +-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 new file mode 100644 index 0000000000..7ca5d80085 --- /dev/null +++ b/ext/spice/src/cspice/vsepg.c @@ -0,0 +1,268 @@ +/* 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 new file mode 100644 index 0000000000..202ee7b4a7 --- /dev/null +++ b/ext/spice/src/cspice/vsepg_c.c @@ -0,0 +1,230 @@ +/* + +-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 new file mode 100644 index 0000000000..cd47b2728e --- /dev/null +++ b/ext/spice/src/cspice/vsub.c @@ -0,0 +1,143 @@ +/* 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 new file mode 100644 index 0000000000..8920b12f97 --- /dev/null +++ b/ext/spice/src/cspice/vsub_c.c @@ -0,0 +1,147 @@ +/* + +-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 new file mode 100644 index 0000000000..7bbb12f636 --- /dev/null +++ b/ext/spice/src/cspice/vsubg.c @@ -0,0 +1,173 @@ +/* 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 new file mode 100644 index 0000000000..2fdd2e133d --- /dev/null +++ b/ext/spice/src/cspice/vsubg_c.c @@ -0,0 +1,165 @@ +/* + +-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 new file mode 100644 index 0000000000..c367d614b1 --- /dev/null +++ b/ext/spice/src/cspice/vtmv.c @@ -0,0 +1,172 @@ +/* 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 new file mode 100644 index 0000000000..a8ee325557 --- /dev/null +++ b/ext/spice/src/cspice/vtmv_c.c @@ -0,0 +1,171 @@ +/* + +-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 new file mode 100644 index 0000000000..c59dc56090 --- /dev/null +++ b/ext/spice/src/cspice/vtmvg.c @@ -0,0 +1,200 @@ +/* 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 new file mode 100644 index 0000000000..7029b5938d --- /dev/null +++ b/ext/spice/src/cspice/vtmvg_c.c @@ -0,0 +1,219 @@ +/* + +-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 new file mode 100644 index 0000000000..eef106279c --- /dev/null +++ b/ext/spice/src/cspice/vupack.c @@ -0,0 +1,150 @@ +/* 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 new file mode 100644 index 0000000000..4524b2c0ff --- /dev/null +++ b/ext/spice/src/cspice/vupack_c.c @@ -0,0 +1,163 @@ +/* + +-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 new file mode 100644 index 0000000000..702127777b --- /dev/null +++ b/ext/spice/src/cspice/vzero.c @@ -0,0 +1,169 @@ +/* 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 new file mode 100644 index 0000000000..b90cbf6328 --- /dev/null +++ b/ext/spice/src/cspice/vzero_c.c @@ -0,0 +1,170 @@ +/* + +-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 new file mode 100644 index 0000000000..6ceb06724a --- /dev/null +++ b/ext/spice/src/cspice/vzerog.c @@ -0,0 +1,193 @@ +/* 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 new file mode 100644 index 0000000000..5dbfb4bc7b --- /dev/null +++ b/ext/spice/src/cspice/vzerog_c.c @@ -0,0 +1,196 @@ +/* + +-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 new file mode 100644 index 0000000000..02f574ae54 --- /dev/null +++ b/ext/spice/src/cspice/wdcnt.c @@ -0,0 +1,214 @@ +/* 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 new file mode 100644 index 0000000000..23d2acb9cb --- /dev/null +++ b/ext/spice/src/cspice/wdindx.c @@ -0,0 +1,239 @@ +/* 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 new file mode 100644 index 0000000000..6a2d0b1b4a --- /dev/null +++ b/ext/spice/src/cspice/wncard.c @@ -0,0 +1,201 @@ +/* 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 new file mode 100644 index 0000000000..132ce1240a --- /dev/null +++ b/ext/spice/src/cspice/wncard_c.c @@ -0,0 +1,173 @@ +/* + +-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 new file mode 100644 index 0000000000..4df8c2b71b --- /dev/null +++ b/ext/spice/src/cspice/wncomd.c @@ -0,0 +1,287 @@ +/* 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 new file mode 100644 index 0000000000..95cd119546 --- /dev/null +++ b/ext/spice/src/cspice/wncomd_c.c @@ -0,0 +1,225 @@ +/* + +-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 new file mode 100644 index 0000000000..006fb7488b --- /dev/null +++ b/ext/spice/src/cspice/wncond.c @@ -0,0 +1,191 @@ +/* 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 new file mode 100644 index 0000000000..fef7bd97ae --- /dev/null +++ b/ext/spice/src/cspice/wncond_c.c @@ -0,0 +1,188 @@ +/* + +-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 new file mode 100644 index 0000000000..d4853f58e0 --- /dev/null +++ b/ext/spice/src/cspice/wndifd.c @@ -0,0 +1,403 @@ +/* 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 new file mode 100644 index 0000000000..0cb5bb1d21 --- /dev/null +++ b/ext/spice/src/cspice/wndifd_c.c @@ -0,0 +1,195 @@ +/* + +-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 new file mode 100644 index 0000000000..65a2f5c9f3 --- /dev/null +++ b/ext/spice/src/cspice/wnelmd.c @@ -0,0 +1,199 @@ +/* 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 new file mode 100644 index 0000000000..cffb38fc25 --- /dev/null +++ b/ext/spice/src/cspice/wnelmd_c.c @@ -0,0 +1,172 @@ +/* + +-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 new file mode 100644 index 0000000000..88ca269cf3 --- /dev/null +++ b/ext/spice/src/cspice/wnexpd.c @@ -0,0 +1,246 @@ +/* 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 new file mode 100644 index 0000000000..0a6f428819 --- /dev/null +++ b/ext/spice/src/cspice/wnexpd_c.c @@ -0,0 +1,191 @@ +/* + +-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 new file mode 100644 index 0000000000..52cedc50cf --- /dev/null +++ b/ext/spice/src/cspice/wnextd.c @@ -0,0 +1,210 @@ +/* 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 new file mode 100644 index 0000000000..8f2734cba4 --- /dev/null +++ b/ext/spice/src/cspice/wnextd_c.c @@ -0,0 +1,189 @@ +/* + +-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 new file mode 100644 index 0000000000..4e3ec8fbe7 --- /dev/null +++ b/ext/spice/src/cspice/wnfetd.c @@ -0,0 +1,186 @@ +/* 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 new file mode 100644 index 0000000000..b933df65a5 --- /dev/null +++ b/ext/spice/src/cspice/wnfetd_c.c @@ -0,0 +1,200 @@ +/* + +-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 new file mode 100644 index 0000000000..44569035e5 --- /dev/null +++ b/ext/spice/src/cspice/wnfild.c @@ -0,0 +1,205 @@ +/* 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 new file mode 100644 index 0000000000..fe11005c56 --- /dev/null +++ b/ext/spice/src/cspice/wnfild_c.c @@ -0,0 +1,180 @@ +/* + +-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 new file mode 100644 index 0000000000..8b4ff21070 --- /dev/null +++ b/ext/spice/src/cspice/wnfltd.c @@ -0,0 +1,185 @@ +/* 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 new file mode 100644 index 0000000000..961e16127a --- /dev/null +++ b/ext/spice/src/cspice/wnfltd_c.c @@ -0,0 +1,166 @@ +/* + +-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 new file mode 100644 index 0000000000..397a2290f0 --- /dev/null +++ b/ext/spice/src/cspice/wnincd.c @@ -0,0 +1,202 @@ +/* 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 new file mode 100644 index 0000000000..72e3f8e5ea --- /dev/null +++ b/ext/spice/src/cspice/wnincd_c.c @@ -0,0 +1,173 @@ +/* + +-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 new file mode 100644 index 0000000000..ec211f1d65 --- /dev/null +++ b/ext/spice/src/cspice/wninsd.c @@ -0,0 +1,371 @@ +/* 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 new file mode 100644 index 0000000000..2d6df4d365 --- /dev/null +++ b/ext/spice/src/cspice/wninsd_c.c @@ -0,0 +1,200 @@ +/* + +-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 new file mode 100644 index 0000000000..a6f1a1267a --- /dev/null +++ b/ext/spice/src/cspice/wnintd.c @@ -0,0 +1,260 @@ +/* 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 new file mode 100644 index 0000000000..698cf2fefb --- /dev/null +++ b/ext/spice/src/cspice/wnintd_c.c @@ -0,0 +1,185 @@ +/* + +-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 new file mode 100644 index 0000000000..9a8bd38b75 --- /dev/null +++ b/ext/spice/src/cspice/wnreld.c @@ -0,0 +1,364 @@ +/* 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 new file mode 100644 index 0000000000..2754b2c864 --- /dev/null +++ b/ext/spice/src/cspice/wnreld_c.c @@ -0,0 +1,312 @@ +/* + +-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 new file mode 100644 index 0000000000..63d04e9557 --- /dev/null +++ b/ext/spice/src/cspice/wnsumd.c @@ -0,0 +1,292 @@ +/* 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 new file mode 100644 index 0000000000..0342b42aad --- /dev/null +++ b/ext/spice/src/cspice/wnsumd_c.c @@ -0,0 +1,233 @@ +/* + +-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 new file mode 100644 index 0000000000..9776e59f21 --- /dev/null +++ b/ext/spice/src/cspice/wnunid.c @@ -0,0 +1,298 @@ +/* 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 new file mode 100644 index 0000000000..a76e7010d5 --- /dev/null +++ b/ext/spice/src/cspice/wnunid_c.c @@ -0,0 +1,188 @@ +/* + +-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 new file mode 100644 index 0000000000..9039b838e7 --- /dev/null +++ b/ext/spice/src/cspice/wnvald.c @@ -0,0 +1,283 @@ +/* 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 new file mode 100644 index 0000000000..989f298128 --- /dev/null +++ b/ext/spice/src/cspice/wnvald_c.c @@ -0,0 +1,264 @@ +/* + +-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 new file mode 100644 index 0000000000..2f3fce89dd --- /dev/null +++ b/ext/spice/src/cspice/wref.c @@ -0,0 +1,276 @@ +#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 new file mode 100644 index 0000000000..f5db5e776b --- /dev/null +++ b/ext/spice/src/cspice/wrencc.c @@ -0,0 +1,775 @@ +/* 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 new file mode 100644 index 0000000000..fdeaf30d42 --- /dev/null +++ b/ext/spice/src/cspice/wrencd.c @@ -0,0 +1,391 @@ +/* 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 new file mode 100644 index 0000000000..481e1be0b4 --- /dev/null +++ b/ext/spice/src/cspice/wrenci.c @@ -0,0 +1,386 @@ +/* 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 new file mode 100644 index 0000000000..3439597b07 --- /dev/null +++ b/ext/spice/src/cspice/writla.c @@ -0,0 +1,212 @@ +/* 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 new file mode 100644 index 0000000000..b005f7a3b9 --- /dev/null +++ b/ext/spice/src/cspice/writln.c @@ -0,0 +1,397 @@ +/* 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 new file mode 100644 index 0000000000..6c0f87efd3 --- /dev/null +++ b/ext/spice/src/cspice/wrkvar.c @@ -0,0 +1,346 @@ +/* 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 new file mode 100644 index 0000000000..93c9c8766e --- /dev/null +++ b/ext/spice/src/cspice/wrline.c @@ -0,0 +1,965 @@ +/* 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 new file mode 100644 index 0000000000..477c40f5d3 --- /dev/null +++ b/ext/spice/src/cspice/wrtfmt.c @@ -0,0 +1,365 @@ +#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 new file mode 100644 index 0000000000..a74e2d5c2a --- /dev/null +++ b/ext/spice/src/cspice/wsfe.c @@ -0,0 +1,73 @@ +/*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 new file mode 100644 index 0000000000..4bb862f43d --- /dev/null +++ b/ext/spice/src/cspice/wsle.c @@ -0,0 +1,36 @@ +#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 new file mode 100644 index 0000000000..ae3f817894 --- /dev/null +++ b/ext/spice/src/cspice/wsne.c @@ -0,0 +1,26 @@ +#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 new file mode 100644 index 0000000000..8574499431 --- /dev/null +++ b/ext/spice/src/cspice/xf2eul.c @@ -0,0 +1,1234 @@ +/* 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 new file mode 100644 index 0000000000..a788c5d873 --- /dev/null +++ b/ext/spice/src/cspice/xf2eul_c.c @@ -0,0 +1,407 @@ +/* + +-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 new file mode 100644 index 0000000000..22c9f161f5 --- /dev/null +++ b/ext/spice/src/cspice/xf2rav.c @@ -0,0 +1,244 @@ +/* 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 new file mode 100644 index 0000000000..4680b0e0f6 --- /dev/null +++ b/ext/spice/src/cspice/xf2rav_c.c @@ -0,0 +1,255 @@ +/* + +-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 new file mode 100644 index 0000000000..daa9f68b73 --- /dev/null +++ b/ext/spice/src/cspice/xposbl.c @@ -0,0 +1,404 @@ +/* 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 new file mode 100644 index 0000000000..6199249436 --- /dev/null +++ b/ext/spice/src/cspice/xpose.c @@ -0,0 +1,151 @@ +/* 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 new file mode 100644 index 0000000000..cb4debcad7 --- /dev/null +++ b/ext/spice/src/cspice/xpose6_c.c @@ -0,0 +1,171 @@ +/* + +-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 new file mode 100644 index 0000000000..15199203de --- /dev/null +++ b/ext/spice/src/cspice/xpose_c.c @@ -0,0 +1,181 @@ +/* + +-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 new file mode 100644 index 0000000000..7aa35dd017 --- /dev/null +++ b/ext/spice/src/cspice/xposeg.c @@ -0,0 +1,306 @@ +/* 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 new file mode 100644 index 0000000000..7e7359b6e2 --- /dev/null +++ b/ext/spice/src/cspice/xposeg_c.c @@ -0,0 +1,222 @@ +/* + +-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 new file mode 100644 index 0000000000..d1f81d5d13 --- /dev/null +++ b/ext/spice/src/cspice/xpsgip.c @@ -0,0 +1,252 @@ +/* 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 new file mode 100644 index 0000000000..41c929b079 --- /dev/null +++ b/ext/spice/src/cspice/xwsne.c @@ -0,0 +1,72 @@ +#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 new file mode 100644 index 0000000000..7e67ad2957 --- /dev/null +++ b/ext/spice/src/cspice/z_abs.c @@ -0,0 +1,12 @@ +#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 new file mode 100644 index 0000000000..fdd1510db4 --- /dev/null +++ b/ext/spice/src/cspice/z_cos.c @@ -0,0 +1,15 @@ +#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 new file mode 100644 index 0000000000..22153fa451 --- /dev/null +++ b/ext/spice/src/cspice/z_div.c @@ -0,0 +1,36 @@ +#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 new file mode 100644 index 0000000000..56138f3d34 --- /dev/null +++ b/ext/spice/src/cspice/z_exp.c @@ -0,0 +1,17 @@ +#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 new file mode 100644 index 0000000000..2d52b941d6 --- /dev/null +++ b/ext/spice/src/cspice/z_log.c @@ -0,0 +1,16 @@ +#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 new file mode 100644 index 0000000000..577be1d85f --- /dev/null +++ b/ext/spice/src/cspice/z_sin.c @@ -0,0 +1,15 @@ +#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 new file mode 100644 index 0000000000..c04e8f0a1a --- /dev/null +++ b/ext/spice/src/cspice/z_sqrt.c @@ -0,0 +1,29 @@ +#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 new file mode 100644 index 0000000000..dc9380022c --- /dev/null +++ b/ext/spice/src/cspice/zzadbail_c.c @@ -0,0 +1,181 @@ +/* + +-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 new file mode 100644 index 0000000000..e0d1bdf531 --- /dev/null +++ b/ext/spice/src/cspice/zzadfunc_c.c @@ -0,0 +1,170 @@ +/* + +-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 new file mode 100644 index 0000000000..f03a71113d --- /dev/null +++ b/ext/spice/src/cspice/zzadqdec_c.c @@ -0,0 +1,196 @@ +/* + +-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 new file mode 100644 index 0000000000..0c4a7eb85d --- /dev/null +++ b/ext/spice/src/cspice/zzadrefn_c.c @@ -0,0 +1,202 @@ +/* + +-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 new file mode 100644 index 0000000000..e758c53535 --- /dev/null +++ b/ext/spice/src/cspice/zzadrepf_c.c @@ -0,0 +1,174 @@ +/* + +-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 new file mode 100644 index 0000000000..2b77205600 --- /dev/null +++ b/ext/spice/src/cspice/zzadrepi_c.c @@ -0,0 +1,305 @@ +/* + +-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 new file mode 100644 index 0000000000..a335368ab7 --- /dev/null +++ b/ext/spice/src/cspice/zzadrepu_c.c @@ -0,0 +1,197 @@ +/* + +-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 new file mode 100644 index 0000000000..afadab13a1 --- /dev/null +++ b/ext/spice/src/cspice/zzadsave_c.c @@ -0,0 +1,412 @@ +/* + +-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 new file mode 100644 index 0000000000..03adf5b350 --- /dev/null +++ b/ext/spice/src/cspice/zzadstep_c.c @@ -0,0 +1,183 @@ +/* + +-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 new file mode 100644 index 0000000000..e6b2b049a8 --- /dev/null +++ b/ext/spice/src/cspice/zzalloc.c @@ -0,0 +1,1743 @@ +/* + +-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 new file mode 100644 index 0000000000..a1796576de --- /dev/null +++ b/ext/spice/src/cspice/zzasryel.c @@ -0,0 +1,857 @@ +/* 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 new file mode 100644 index 0000000000..27d7a68b73 --- /dev/null +++ b/ext/spice/src/cspice/zzbodblt.c @@ -0,0 +1,943 @@ +/* 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 new file mode 100644 index 0000000000..b0bbfadd26 --- /dev/null +++ b/ext/spice/src/cspice/zzbodbry.c @@ -0,0 +1,226 @@ +/* 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 new file mode 100644 index 0000000000..1156a29f07 --- /dev/null +++ b/ext/spice/src/cspice/zzbodini.c @@ -0,0 +1,305 @@ +/* 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 new file mode 100644 index 0000000000..90c9069028 --- /dev/null +++ b/ext/spice/src/cspice/zzbodker.c @@ -0,0 +1,514 @@ +/* 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 new file mode 100644 index 0000000000..906c9645c2 --- /dev/null +++ b/ext/spice/src/cspice/zzbodtrn.c @@ -0,0 +1,2344 @@ +/* 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 new file mode 100644 index 0000000000..22739e1116 --- /dev/null +++ b/ext/spice/src/cspice/zzbodvcd.c @@ -0,0 +1,282 @@ +/* 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 new file mode 100644 index 0000000000..e4c112c3a0 --- /dev/null +++ b/ext/spice/src/cspice/zzck4d2i.c @@ -0,0 +1,163 @@ +/* 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 new file mode 100644 index 0000000000..43e00a9a8e --- /dev/null +++ b/ext/spice/src/cspice/zzck4i2d.c @@ -0,0 +1,167 @@ +/* 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 new file mode 100644 index 0000000000..5916a5607c --- /dev/null +++ b/ext/spice/src/cspice/zzckcv01.c @@ -0,0 +1,361 @@ +/* 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 new file mode 100644 index 0000000000..56a342a321 --- /dev/null +++ b/ext/spice/src/cspice/zzckcv02.c @@ -0,0 +1,308 @@ +/* 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 new file mode 100644 index 0000000000..e62e513cf7 --- /dev/null +++ b/ext/spice/src/cspice/zzckcv03.c @@ -0,0 +1,427 @@ +/* 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 new file mode 100644 index 0000000000..f3e915204b --- /dev/null +++ b/ext/spice/src/cspice/zzckcv04.c @@ -0,0 +1,462 @@ +/* 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 new file mode 100644 index 0000000000..f70c4e8de0 --- /dev/null +++ b/ext/spice/src/cspice/zzckcv05.c @@ -0,0 +1,549 @@ +/* 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 new file mode 100644 index 0000000000..1ea7331b58 --- /dev/null +++ b/ext/spice/src/cspice/zzckspk.c @@ -0,0 +1,383 @@ +/* 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 new file mode 100644 index 0000000000..f7fff77315 --- /dev/null +++ b/ext/spice/src/cspice/zzcln.c @@ -0,0 +1,202 @@ +/* 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 new file mode 100644 index 0000000000..da2e10accc --- /dev/null +++ b/ext/spice/src/cspice/zzcorepc.c @@ -0,0 +1,335 @@ +/* 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 new file mode 100644 index 0000000000..ab2f551b7b --- /dev/null +++ b/ext/spice/src/cspice/zzcorsxf.c @@ -0,0 +1,456 @@ +/* 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 new file mode 100644 index 0000000000..2141277dce --- /dev/null +++ b/ext/spice/src/cspice/zzcputim.c @@ -0,0 +1,241 @@ +/* + +-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 new file mode 100644 index 0000000000..23bde1a15b --- /dev/null +++ b/ext/spice/src/cspice/zzdafgdr.c @@ -0,0 +1,605 @@ +/* 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 new file mode 100644 index 0000000000..b3237f9a0d --- /dev/null +++ b/ext/spice/src/cspice/zzdafgfr.c @@ -0,0 +1,684 @@ +/* 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 new file mode 100644 index 0000000000..725c70af7d --- /dev/null +++ b/ext/spice/src/cspice/zzdafgsr.c @@ -0,0 +1,736 @@ +/* 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 new file mode 100644 index 0000000000..3852f3c8a9 --- /dev/null +++ b/ext/spice/src/cspice/zzdafnfr.c @@ -0,0 +1,438 @@ +/* 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 new file mode 100644 index 0000000000..5edcd26280 --- /dev/null +++ b/ext/spice/src/cspice/zzdasnfr.c @@ -0,0 +1,424 @@ +/* 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 new file mode 100644 index 0000000000..a2845dece8 --- /dev/null +++ b/ext/spice/src/cspice/zzddhclu.c @@ -0,0 +1,134 @@ +/* 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 new file mode 100644 index 0000000000..77a1fe5466 --- /dev/null +++ b/ext/spice/src/cspice/zzddhf2h.c @@ -0,0 +1,773 @@ +/* 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 new file mode 100644 index 0000000000..94a3879c0a --- /dev/null +++ b/ext/spice/src/cspice/zzddhgtu.c @@ -0,0 +1,539 @@ +/* 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 new file mode 100644 index 0000000000..d220f3d1a0 --- /dev/null +++ b/ext/spice/src/cspice/zzddhini.c @@ -0,0 +1,500 @@ +/* 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 new file mode 100644 index 0000000000..53f9f711cf --- /dev/null +++ b/ext/spice/src/cspice/zzddhivf.c @@ -0,0 +1,642 @@ +/* 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 new file mode 100644 index 0000000000..08f4e83236 --- /dev/null +++ b/ext/spice/src/cspice/zzddhman.c @@ -0,0 +1,3351 @@ +/* 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 new file mode 100644 index 0000000000..bc05af9507 --- /dev/null +++ b/ext/spice/src/cspice/zzddhppf.c @@ -0,0 +1,1084 @@ +/* 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 new file mode 100644 index 0000000000..806371a8ff --- /dev/null +++ b/ext/spice/src/cspice/zzddhrcm.c @@ -0,0 +1,169 @@ +/* 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 new file mode 100644 index 0000000000..27e0eac9b5 --- /dev/null +++ b/ext/spice/src/cspice/zzddhrmu.c @@ -0,0 +1,478 @@ +/* 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 new file mode 100644 index 0000000000..4fea8a76ae --- /dev/null +++ b/ext/spice/src/cspice/zzdynbid.c @@ -0,0 +1,952 @@ +/* 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 new file mode 100644 index 0000000000..f53cd72ba2 --- /dev/null +++ b/ext/spice/src/cspice/zzdynfid.c @@ -0,0 +1,911 @@ +/* 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 new file mode 100644 index 0000000000..48ec2ad6aa --- /dev/null +++ b/ext/spice/src/cspice/zzdynfr0.c @@ -0,0 +1,2631 @@ +/* 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 new file mode 100644 index 0000000000..9daa36c2e0 --- /dev/null +++ b/ext/spice/src/cspice/zzdynfrm.c @@ -0,0 +1,2631 @@ +/* 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 new file mode 100644 index 0000000000..666fb200be --- /dev/null +++ b/ext/spice/src/cspice/zzdynoac.c @@ -0,0 +1,758 @@ +/* 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 new file mode 100644 index 0000000000..dcd917cabe --- /dev/null +++ b/ext/spice/src/cspice/zzdynoad.c @@ -0,0 +1,817 @@ +/* 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 new file mode 100644 index 0000000000..376b688f0a --- /dev/null +++ b/ext/spice/src/cspice/zzdynrot.c @@ -0,0 +1,2443 @@ +/* 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 new file mode 100644 index 0000000000..b225327c1e --- /dev/null +++ b/ext/spice/src/cspice/zzdynrt0.c @@ -0,0 +1,2363 @@ +/* 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 new file mode 100644 index 0000000000..e60068745d --- /dev/null +++ b/ext/spice/src/cspice/zzdynvac.c @@ -0,0 +1,813 @@ +/* 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 new file mode 100644 index 0000000000..02a5e6e7d5 --- /dev/null +++ b/ext/spice/src/cspice/zzdynvad.c @@ -0,0 +1,815 @@ +/* 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 new file mode 100644 index 0000000000..ddd5c6cacc --- /dev/null +++ b/ext/spice/src/cspice/zzdynvai.c @@ -0,0 +1,818 @@ +/* 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 new file mode 100644 index 0000000000..3b9a17c22b --- /dev/null +++ b/ext/spice/src/cspice/zzedterm.c @@ -0,0 +1,598 @@ +/* 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 new file mode 100644 index 0000000000..975ca58d1f --- /dev/null +++ b/ext/spice/src/cspice/zzekac01.c @@ -0,0 +1,1110 @@ +/* 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 new file mode 100644 index 0000000000..a8b770a6e0 --- /dev/null +++ b/ext/spice/src/cspice/zzekac02.c @@ -0,0 +1,1112 @@ +/* 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 new file mode 100644 index 0000000000..e77be157cc --- /dev/null +++ b/ext/spice/src/cspice/zzekac03.c @@ -0,0 +1,1193 @@ +/* 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 new file mode 100644 index 0000000000..9ba0689e1c --- /dev/null +++ b/ext/spice/src/cspice/zzekac04.c @@ -0,0 +1,1179 @@ +/* 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 new file mode 100644 index 0000000000..dcfb1ba69e --- /dev/null +++ b/ext/spice/src/cspice/zzekac05.c @@ -0,0 +1,1182 @@ +/* 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 new file mode 100644 index 0000000000..d57cdd1ffb --- /dev/null +++ b/ext/spice/src/cspice/zzekac06.c @@ -0,0 +1,1290 @@ +/* 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 new file mode 100644 index 0000000000..c204986881 --- /dev/null +++ b/ext/spice/src/cspice/zzekac07.c @@ -0,0 +1,959 @@ +/* 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 new file mode 100644 index 0000000000..6762e4aeb4 --- /dev/null +++ b/ext/spice/src/cspice/zzekac08.c @@ -0,0 +1,959 @@ +/* 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 new file mode 100644 index 0000000000..374ba98ab4 --- /dev/null +++ b/ext/spice/src/cspice/zzekac09.c @@ -0,0 +1,989 @@ +/* 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 new file mode 100644 index 0000000000..0a9d84ae51 --- /dev/null +++ b/ext/spice/src/cspice/zzekacps.c @@ -0,0 +1,392 @@ +/* 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 new file mode 100644 index 0000000000..3e617ad640 --- /dev/null +++ b/ext/spice/src/cspice/zzekad01.c @@ -0,0 +1,890 @@ +/* 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 new file mode 100644 index 0000000000..c065b4c6ca --- /dev/null +++ b/ext/spice/src/cspice/zzekad02.c @@ -0,0 +1,887 @@ +/* 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 new file mode 100644 index 0000000000..7dbd876a71 --- /dev/null +++ b/ext/spice/src/cspice/zzekad03.c @@ -0,0 +1,947 @@ +/* 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 new file mode 100644 index 0000000000..eba5a7e404 --- /dev/null +++ b/ext/spice/src/cspice/zzekad04.c @@ -0,0 +1,927 @@ +/* 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 new file mode 100644 index 0000000000..30b3204bfd --- /dev/null +++ b/ext/spice/src/cspice/zzekad05.c @@ -0,0 +1,934 @@ +/* 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 new file mode 100644 index 0000000000..c520f18bb5 --- /dev/null +++ b/ext/spice/src/cspice/zzekad06.c @@ -0,0 +1,1047 @@ +/* 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 new file mode 100644 index 0000000000..c7d84f8694 --- /dev/null +++ b/ext/spice/src/cspice/zzekaps.c @@ -0,0 +1,374 @@ +/* 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 new file mode 100644 index 0000000000..a905cf99c9 --- /dev/null +++ b/ext/spice/src/cspice/zzekbs01.c @@ -0,0 +1,1285 @@ +/* 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 new file mode 100644 index 0000000000..571157495e --- /dev/null +++ b/ext/spice/src/cspice/zzekbs02.c @@ -0,0 +1,1273 @@ +/* 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 new file mode 100644 index 0000000000..8a32aa1191 --- /dev/null +++ b/ext/spice/src/cspice/zzekcchk.c @@ -0,0 +1,994 @@ +/* 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 new file mode 100644 index 0000000000..5713372dc2 --- /dev/null +++ b/ext/spice/src/cspice/zzekcdsc.c @@ -0,0 +1,457 @@ +/* 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 new file mode 100644 index 0000000000..b6dcdd074c --- /dev/null +++ b/ext/spice/src/cspice/zzekcix1.c @@ -0,0 +1,267 @@ +/* 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 new file mode 100644 index 0000000000..d84bbc7696 --- /dev/null +++ b/ext/spice/src/cspice/zzekcnam.c @@ -0,0 +1,392 @@ +/* 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 new file mode 100644 index 0000000000..f2d05fe273 --- /dev/null +++ b/ext/spice/src/cspice/zzekde01.c @@ -0,0 +1,835 @@ +/* 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 new file mode 100644 index 0000000000..5156ad5014 --- /dev/null +++ b/ext/spice/src/cspice/zzekde02.c @@ -0,0 +1,835 @@ +/* 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 new file mode 100644 index 0000000000..52866b9aaa --- /dev/null +++ b/ext/spice/src/cspice/zzekde03.c @@ -0,0 +1,880 @@ +/* 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 new file mode 100644 index 0000000000..f62a318d78 --- /dev/null +++ b/ext/spice/src/cspice/zzekde04.c @@ -0,0 +1,804 @@ +/* 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 new file mode 100644 index 0000000000..a28e2fdf8e --- /dev/null +++ b/ext/spice/src/cspice/zzekde05.c @@ -0,0 +1,865 @@ +/* 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 new file mode 100644 index 0000000000..ad57cd362a --- /dev/null +++ b/ext/spice/src/cspice/zzekde06.c @@ -0,0 +1,863 @@ +/* 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 new file mode 100644 index 0000000000..ddc3cb0d11 --- /dev/null +++ b/ext/spice/src/cspice/zzekdps.c @@ -0,0 +1,512 @@ +/* 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 new file mode 100644 index 0000000000..b6d128f726 --- /dev/null +++ b/ext/spice/src/cspice/zzekecmp.c @@ -0,0 +1,980 @@ +/* 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 new file mode 100644 index 0000000000..b3a3c677e1 --- /dev/null +++ b/ext/spice/src/cspice/zzekencd.c @@ -0,0 +1,820 @@ +/* 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 new file mode 100644 index 0000000000..003336afa4 --- /dev/null +++ b/ext/spice/src/cspice/zzekerc1.c @@ -0,0 +1,705 @@ +/* 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 new file mode 100644 index 0000000000..c8b8a2c1f9 --- /dev/null +++ b/ext/spice/src/cspice/zzekerd1.c @@ -0,0 +1,705 @@ +/* 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 new file mode 100644 index 0000000000..9e174c6563 --- /dev/null +++ b/ext/spice/src/cspice/zzekeri1.c @@ -0,0 +1,704 @@ +/* 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 new file mode 100644 index 0000000000..f48bd94e0b --- /dev/null +++ b/ext/spice/src/cspice/zzekesiz.c @@ -0,0 +1,453 @@ +/* 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 new file mode 100644 index 0000000000..e5ba8311c5 --- /dev/null +++ b/ext/spice/src/cspice/zzekff01.c @@ -0,0 +1,886 @@ +/* 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 new file mode 100644 index 0000000000..3b63204a4a --- /dev/null +++ b/ext/spice/src/cspice/zzekfrx.c @@ -0,0 +1,661 @@ +/* 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 new file mode 100644 index 0000000000..307350882a --- /dev/null +++ b/ext/spice/src/cspice/zzekgcdp.c @@ -0,0 +1,570 @@ +/* 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 new file mode 100644 index 0000000000..1dfaad9381 --- /dev/null +++ b/ext/spice/src/cspice/zzekgei.c @@ -0,0 +1,274 @@ +/* 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 new file mode 100644 index 0000000000..db45377a15 --- /dev/null +++ b/ext/spice/src/cspice/zzekgfwd.c @@ -0,0 +1,459 @@ +/* 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 new file mode 100644 index 0000000000..f3cdeebfa4 --- /dev/null +++ b/ext/spice/src/cspice/zzekglnk.c @@ -0,0 +1,455 @@ +/* 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 new file mode 100644 index 0000000000..3df7408834 --- /dev/null +++ b/ext/spice/src/cspice/zzekgrcp.c @@ -0,0 +1,375 @@ +/* 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 new file mode 100644 index 0000000000..1c02ba1894 --- /dev/null +++ b/ext/spice/src/cspice/zzekgrs.c @@ -0,0 +1,250 @@ +/* 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 new file mode 100644 index 0000000000..9768f7f2e4 --- /dev/null +++ b/ext/spice/src/cspice/zzekif01.c @@ -0,0 +1,630 @@ +/* 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 new file mode 100644 index 0000000000..7183ec3a16 --- /dev/null +++ b/ext/spice/src/cspice/zzekif02.c @@ -0,0 +1,737 @@ +/* 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 new file mode 100644 index 0000000000..04a7304072 --- /dev/null +++ b/ext/spice/src/cspice/zzekiic1.c @@ -0,0 +1,672 @@ +/* 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 new file mode 100644 index 0000000000..b5a2c26891 --- /dev/null +++ b/ext/spice/src/cspice/zzekiid1.c @@ -0,0 +1,672 @@ +/* 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 new file mode 100644 index 0000000000..3b30ca6cfc --- /dev/null +++ b/ext/spice/src/cspice/zzekiii1.c @@ -0,0 +1,668 @@ +/* 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 new file mode 100644 index 0000000000..6c1ef126dc --- /dev/null +++ b/ext/spice/src/cspice/zzekille.c @@ -0,0 +1,589 @@ +/* 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 new file mode 100644 index 0000000000..0a92752d7d --- /dev/null +++ b/ext/spice/src/cspice/zzekillt.c @@ -0,0 +1,586 @@ +/* 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 new file mode 100644 index 0000000000..b5f77d1b0e --- /dev/null +++ b/ext/spice/src/cspice/zzekinqc.c @@ -0,0 +1,682 @@ +/* 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 new file mode 100644 index 0000000000..56bd13a039 --- /dev/null +++ b/ext/spice/src/cspice/zzekinqn.c @@ -0,0 +1,657 @@ +/* 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 new file mode 100644 index 0000000000..acfafa9930 --- /dev/null +++ b/ext/spice/src/cspice/zzekixdl.c @@ -0,0 +1,525 @@ +/* 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 new file mode 100644 index 0000000000..ea73581573 --- /dev/null +++ b/ext/spice/src/cspice/zzekixlk.c @@ -0,0 +1,503 @@ +/* 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 new file mode 100644 index 0000000000..f0ef40298b --- /dev/null +++ b/ext/spice/src/cspice/zzekjoin.c @@ -0,0 +1,1010 @@ +/* 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 new file mode 100644 index 0000000000..613956211a --- /dev/null +++ b/ext/spice/src/cspice/zzekjsqz.c @@ -0,0 +1,616 @@ +/* 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 new file mode 100644 index 0000000000..4a4c07af91 --- /dev/null +++ b/ext/spice/src/cspice/zzekjsrt.c @@ -0,0 +1,1877 @@ +/* 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 new file mode 100644 index 0000000000..9cf1e45679 --- /dev/null +++ b/ext/spice/src/cspice/zzekjtst.c @@ -0,0 +1,2316 @@ +/* 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 new file mode 100644 index 0000000000..fc6bb88da8 --- /dev/null +++ b/ext/spice/src/cspice/zzekkey.c @@ -0,0 +1,1145 @@ +/* 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 new file mode 100644 index 0000000000..abcb31c570 --- /dev/null +++ b/ext/spice/src/cspice/zzeklerc.c @@ -0,0 +1,603 @@ +/* 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 new file mode 100644 index 0000000000..0dcf5fb59e --- /dev/null +++ b/ext/spice/src/cspice/zzeklerd.c @@ -0,0 +1,602 @@ +/* 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 new file mode 100644 index 0000000000..c04d799abb --- /dev/null +++ b/ext/spice/src/cspice/zzekleri.c @@ -0,0 +1,603 @@ +/* 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 new file mode 100644 index 0000000000..185d73144b --- /dev/null +++ b/ext/spice/src/cspice/zzekllec.c @@ -0,0 +1,721 @@ +/* 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 new file mode 100644 index 0000000000..54eb13daf6 --- /dev/null +++ b/ext/spice/src/cspice/zzeklled.c @@ -0,0 +1,720 @@ +/* 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 new file mode 100644 index 0000000000..e94253a6d8 --- /dev/null +++ b/ext/spice/src/cspice/zzekllei.c @@ -0,0 +1,719 @@ +/* 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 new file mode 100644 index 0000000000..ef1567acfd --- /dev/null +++ b/ext/spice/src/cspice/zzeklltc.c @@ -0,0 +1,718 @@ +/* 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 new file mode 100644 index 0000000000..6beaa4a6fa --- /dev/null +++ b/ext/spice/src/cspice/zzeklltd.c @@ -0,0 +1,715 @@ +/* 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 new file mode 100644 index 0000000000..0eb2c3ec17 --- /dev/null +++ b/ext/spice/src/cspice/zzekllti.c @@ -0,0 +1,717 @@ +/* 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 new file mode 100644 index 0000000000..eab1c27e1b --- /dev/null +++ b/ext/spice/src/cspice/zzekmloc.c @@ -0,0 +1,279 @@ +/* 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 new file mode 100644 index 0000000000..7a2afdc97f --- /dev/null +++ b/ext/spice/src/cspice/zzeknres.c @@ -0,0 +1,974 @@ +/* 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 new file mode 100644 index 0000000000..c50ec69992 --- /dev/null +++ b/ext/spice/src/cspice/zzeknrml.c @@ -0,0 +1,3444 @@ +/* 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 new file mode 100644 index 0000000000..a94092df95 --- /dev/null +++ b/ext/spice/src/cspice/zzekordc.c @@ -0,0 +1,263 @@ +/* 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 new file mode 100644 index 0000000000..d5c77b01b0 --- /dev/null +++ b/ext/spice/src/cspice/zzekordd.c @@ -0,0 +1,250 @@ +/* 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 new file mode 100644 index 0000000000..9c3fa7f503 --- /dev/null +++ b/ext/spice/src/cspice/zzekordi.c @@ -0,0 +1,252 @@ +/* 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 new file mode 100644 index 0000000000..0fdacd010f --- /dev/null +++ b/ext/spice/src/cspice/zzekpage.c @@ -0,0 +1,2764 @@ +/* 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 new file mode 100644 index 0000000000..4d9d9842f6 --- /dev/null +++ b/ext/spice/src/cspice/zzekpars.c @@ -0,0 +1,2153 @@ +/* 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 new file mode 100644 index 0000000000..803fb7afe6 --- /dev/null +++ b/ext/spice/src/cspice/zzekpcol.c @@ -0,0 +1,1173 @@ +/* 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 new file mode 100644 index 0000000000..3a2e97eaa0 --- /dev/null +++ b/ext/spice/src/cspice/zzekpdec.c @@ -0,0 +1,1061 @@ +/* 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 new file mode 100644 index 0000000000..232f00237c --- /dev/null +++ b/ext/spice/src/cspice/zzekpgch.c @@ -0,0 +1,446 @@ +/* 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 new file mode 100644 index 0000000000..c599288cb3 --- /dev/null +++ b/ext/spice/src/cspice/zzekqcnj.c @@ -0,0 +1,565 @@ +/* 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 new file mode 100644 index 0000000000..9921f84dbc --- /dev/null +++ b/ext/spice/src/cspice/zzekqcon.c @@ -0,0 +1,889 @@ +/* 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 new file mode 100644 index 0000000000..2b9884e48b --- /dev/null +++ b/ext/spice/src/cspice/zzekqini.c @@ -0,0 +1,768 @@ +/* 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 new file mode 100644 index 0000000000..9115cf528e --- /dev/null +++ b/ext/spice/src/cspice/zzekqord.c @@ -0,0 +1,680 @@ +/* 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 new file mode 100644 index 0000000000..8022c065b8 --- /dev/null +++ b/ext/spice/src/cspice/zzekqsel.c @@ -0,0 +1,694 @@ +/* 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 new file mode 100644 index 0000000000..803f4ec887 --- /dev/null +++ b/ext/spice/src/cspice/zzekqtab.c @@ -0,0 +1,623 @@ +/* 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 new file mode 100644 index 0000000000..10274f61d7 --- /dev/null +++ b/ext/spice/src/cspice/zzekrbck.c @@ -0,0 +1,834 @@ +/* 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 new file mode 100644 index 0000000000..a4bf5c5a3a --- /dev/null +++ b/ext/spice/src/cspice/zzekrcmp.c @@ -0,0 +1,798 @@ +/* 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 new file mode 100644 index 0000000000..80d027ded4 --- /dev/null +++ b/ext/spice/src/cspice/zzekrd01.c @@ -0,0 +1,777 @@ +/* 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 new file mode 100644 index 0000000000..ea56af6846 --- /dev/null +++ b/ext/spice/src/cspice/zzekrd02.c @@ -0,0 +1,772 @@ +/* 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 new file mode 100644 index 0000000000..d6c0fd551e --- /dev/null +++ b/ext/spice/src/cspice/zzekrd03.c @@ -0,0 +1,952 @@ +/* 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 new file mode 100644 index 0000000000..8663a940b9 --- /dev/null +++ b/ext/spice/src/cspice/zzekrd04.c @@ -0,0 +1,910 @@ +/* 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 new file mode 100644 index 0000000000..a951f18c61 --- /dev/null +++ b/ext/spice/src/cspice/zzekrd05.c @@ -0,0 +1,866 @@ +/* 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 new file mode 100644 index 0000000000..119e919359 --- /dev/null +++ b/ext/spice/src/cspice/zzekrd06.c @@ -0,0 +1,1057 @@ +/* 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 new file mode 100644 index 0000000000..1d4b241dbb --- /dev/null +++ b/ext/spice/src/cspice/zzekrd07.c @@ -0,0 +1,818 @@ +/* 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 new file mode 100644 index 0000000000..ca549f26ab --- /dev/null +++ b/ext/spice/src/cspice/zzekrd08.c @@ -0,0 +1,815 @@ +/* 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 new file mode 100644 index 0000000000..09bbf4a3f5 --- /dev/null +++ b/ext/spice/src/cspice/zzekrd09.c @@ -0,0 +1,938 @@ +/* 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 new file mode 100644 index 0000000000..eb002bf591 --- /dev/null +++ b/ext/spice/src/cspice/zzekreqi.c @@ -0,0 +1,521 @@ +/* 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 new file mode 100644 index 0000000000..2922ad3005 --- /dev/null +++ b/ext/spice/src/cspice/zzekrmch.c @@ -0,0 +1,714 @@ +/* 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 new file mode 100644 index 0000000000..41d506a725 --- /dev/null +++ b/ext/spice/src/cspice/zzekrp2n.c @@ -0,0 +1,299 @@ +/* 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 new file mode 100644 index 0000000000..f8abe2f59d --- /dev/null +++ b/ext/spice/src/cspice/zzekrplk.c @@ -0,0 +1,495 @@ +/* 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 new file mode 100644 index 0000000000..b403cb8560 --- /dev/null +++ b/ext/spice/src/cspice/zzekrsc.c @@ -0,0 +1,573 @@ +/* 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 new file mode 100644 index 0000000000..bbccd93c2d --- /dev/null +++ b/ext/spice/src/cspice/zzekrsd.c @@ -0,0 +1,563 @@ +/* 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 new file mode 100644 index 0000000000..6197051b3f --- /dev/null +++ b/ext/spice/src/cspice/zzekrsi.c @@ -0,0 +1,568 @@ +/* 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 new file mode 100644 index 0000000000..fc877ddaf8 --- /dev/null +++ b/ext/spice/src/cspice/zzeksca.c @@ -0,0 +1,1607 @@ +/* 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 new file mode 100644 index 0000000000..9a51e9574e --- /dev/null +++ b/ext/spice/src/cspice/zzekscan.c @@ -0,0 +1,1096 @@ +/* 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 new file mode 100644 index 0000000000..bb614c7f8f --- /dev/null +++ b/ext/spice/src/cspice/zzekscdp.c @@ -0,0 +1,529 @@ +/* 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 new file mode 100644 index 0000000000..61f7d60e1d --- /dev/null +++ b/ext/spice/src/cspice/zzekscmp.c @@ -0,0 +1,1025 @@ +/* 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 new file mode 100644 index 0000000000..2d9074d7e6 --- /dev/null +++ b/ext/spice/src/cspice/zzeksdsc.c @@ -0,0 +1,250 @@ +/* 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 new file mode 100644 index 0000000000..e19371965e --- /dev/null +++ b/ext/spice/src/cspice/zzeksei.c @@ -0,0 +1,274 @@ +/* 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 new file mode 100644 index 0000000000..14b1117b8b --- /dev/null +++ b/ext/spice/src/cspice/zzeksemc.c @@ -0,0 +1,1163 @@ +/* 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 new file mode 100644 index 0000000000..25b1c7cb19 --- /dev/null +++ b/ext/spice/src/cspice/zzeksfwd.c @@ -0,0 +1,457 @@ +/* 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 new file mode 100644 index 0000000000..e0651a7d20 --- /dev/null +++ b/ext/spice/src/cspice/zzeksinf.c @@ -0,0 +1,653 @@ +/* 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 new file mode 100644 index 0000000000..dfc228a21b --- /dev/null +++ b/ext/spice/src/cspice/zzekslnk.c @@ -0,0 +1,459 @@ +/* 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 new file mode 100644 index 0000000000..08a36f0029 --- /dev/null +++ b/ext/spice/src/cspice/zzeksrcp.c @@ -0,0 +1,277 @@ +/* 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 new file mode 100644 index 0000000000..7efe09262e --- /dev/null +++ b/ext/spice/src/cspice/zzeksrs.c @@ -0,0 +1,267 @@ +/* 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 new file mode 100644 index 0000000000..f81b8a3dc1 --- /dev/null +++ b/ext/spice/src/cspice/zzekstyp.c @@ -0,0 +1,324 @@ +/* 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 new file mode 100644 index 0000000000..b6f860ccbd --- /dev/null +++ b/ext/spice/src/cspice/zzeksz04.c @@ -0,0 +1,747 @@ +/* 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 new file mode 100644 index 0000000000..fc48667b45 --- /dev/null +++ b/ext/spice/src/cspice/zzeksz05.c @@ -0,0 +1,753 @@ +/* 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 new file mode 100644 index 0000000000..15311cf13a --- /dev/null +++ b/ext/spice/src/cspice/zzeksz06.c @@ -0,0 +1,747 @@ +/* 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 new file mode 100644 index 0000000000..3436e9ee41 --- /dev/null +++ b/ext/spice/src/cspice/zzektcnv.c @@ -0,0 +1,412 @@ +/* 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 new file mode 100644 index 0000000000..19e65bc94b --- /dev/null +++ b/ext/spice/src/cspice/zzektloc.c @@ -0,0 +1,281 @@ +/* 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 new file mode 100644 index 0000000000..aab8f6f890 --- /dev/null +++ b/ext/spice/src/cspice/zzektr13.c @@ -0,0 +1,683 @@ +/* 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 new file mode 100644 index 0000000000..1ede941f82 --- /dev/null +++ b/ext/spice/src/cspice/zzektr1s.c @@ -0,0 +1,1204 @@ +/* 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 new file mode 100644 index 0000000000..8ebd0e016c --- /dev/null +++ b/ext/spice/src/cspice/zzektr23.c @@ -0,0 +1,1043 @@ +/* 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 new file mode 100644 index 0000000000..b9bbcd2cfb --- /dev/null +++ b/ext/spice/src/cspice/zzektr31.c @@ -0,0 +1,712 @@ +/* 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 new file mode 100644 index 0000000000..3960b0b937 --- /dev/null +++ b/ext/spice/src/cspice/zzektr32.c @@ -0,0 +1,1116 @@ +/* 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 new file mode 100644 index 0000000000..6a7db9cef1 --- /dev/null +++ b/ext/spice/src/cspice/zzektrap.c @@ -0,0 +1,150 @@ +/* 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 new file mode 100644 index 0000000000..19e518e322 --- /dev/null +++ b/ext/spice/src/cspice/zzektrbn.c @@ -0,0 +1,467 @@ +/* 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 new file mode 100644 index 0000000000..d2d7a1c975 --- /dev/null +++ b/ext/spice/src/cspice/zzektrbs.c @@ -0,0 +1,186 @@ +/* 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 new file mode 100644 index 0000000000..6ca7cc3562 --- /dev/null +++ b/ext/spice/src/cspice/zzektrdl.c @@ -0,0 +1,855 @@ +/* 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 new file mode 100644 index 0000000000..65b6e825d0 --- /dev/null +++ b/ext/spice/src/cspice/zzektrdp.c @@ -0,0 +1,150 @@ +/* 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 new file mode 100644 index 0000000000..9f3d10c253 --- /dev/null +++ b/ext/spice/src/cspice/zzektres.c @@ -0,0 +1,1094 @@ +/* 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 new file mode 100644 index 0000000000..cb97eca030 --- /dev/null +++ b/ext/spice/src/cspice/zzektrfr.c @@ -0,0 +1,693 @@ +/* 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 new file mode 100644 index 0000000000..786ac68428 --- /dev/null +++ b/ext/spice/src/cspice/zzektrin.c @@ -0,0 +1,694 @@ +/* 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 new file mode 100644 index 0000000000..b71e1e8665 --- /dev/null +++ b/ext/spice/src/cspice/zzektrit.c @@ -0,0 +1,550 @@ +/* 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 new file mode 100644 index 0000000000..e4bb8819b2 --- /dev/null +++ b/ext/spice/src/cspice/zzektrki.c @@ -0,0 +1,393 @@ +/* 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 new file mode 100644 index 0000000000..2ae0ee879b --- /dev/null +++ b/ext/spice/src/cspice/zzektrlk.c @@ -0,0 +1,814 @@ +/* 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 new file mode 100644 index 0000000000..af8cf7f6bd --- /dev/null +++ b/ext/spice/src/cspice/zzektrls.c @@ -0,0 +1,362 @@ +/* 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 new file mode 100644 index 0000000000..6f2c9a42b9 --- /dev/null +++ b/ext/spice/src/cspice/zzektrnk.c @@ -0,0 +1,353 @@ +/* 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 new file mode 100644 index 0000000000..c32aafe903 --- /dev/null +++ b/ext/spice/src/cspice/zzektrpi.c @@ -0,0 +1,769 @@ +/* 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 new file mode 100644 index 0000000000..5d45be2ddd --- /dev/null +++ b/ext/spice/src/cspice/zzektrrk.c @@ -0,0 +1,931 @@ +/* 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 new file mode 100644 index 0000000000..9998cc7b10 --- /dev/null +++ b/ext/spice/src/cspice/zzektrsb.c @@ -0,0 +1,464 @@ +/* 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 new file mode 100644 index 0000000000..5d0e9a4090 --- /dev/null +++ b/ext/spice/src/cspice/zzektrsz.c @@ -0,0 +1,345 @@ +/* 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 new file mode 100644 index 0000000000..7df46381a8 --- /dev/null +++ b/ext/spice/src/cspice/zzektrud.c @@ -0,0 +1,932 @@ +/* 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 new file mode 100644 index 0000000000..375873a858 --- /dev/null +++ b/ext/spice/src/cspice/zzektrui.c @@ -0,0 +1,943 @@ +/* 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 new file mode 100644 index 0000000000..4dacae7c58 --- /dev/null +++ b/ext/spice/src/cspice/zzekue01.c @@ -0,0 +1,873 @@ +/* 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 new file mode 100644 index 0000000000..832829933a --- /dev/null +++ b/ext/spice/src/cspice/zzekue02.c @@ -0,0 +1,873 @@ +/* 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 new file mode 100644 index 0000000000..a95eba78b8 --- /dev/null +++ b/ext/spice/src/cspice/zzekue03.c @@ -0,0 +1,730 @@ +/* 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 new file mode 100644 index 0000000000..8868736da6 --- /dev/null +++ b/ext/spice/src/cspice/zzekue04.c @@ -0,0 +1,449 @@ +/* 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 new file mode 100644 index 0000000000..88168918e3 --- /dev/null +++ b/ext/spice/src/cspice/zzekue05.c @@ -0,0 +1,449 @@ +/* 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 new file mode 100644 index 0000000000..cc794010a2 --- /dev/null +++ b/ext/spice/src/cspice/zzekue06.c @@ -0,0 +1,728 @@ +/* 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 new file mode 100644 index 0000000000..2bb8ad396f --- /dev/null +++ b/ext/spice/src/cspice/zzekvadr.c @@ -0,0 +1,783 @@ +/* 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 new file mode 100644 index 0000000000..7ad461b11a --- /dev/null +++ b/ext/spice/src/cspice/zzekvcmp.c @@ -0,0 +1,1219 @@ +/* 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 new file mode 100644 index 0000000000..a3cabd0569 --- /dev/null +++ b/ext/spice/src/cspice/zzekvmch.c @@ -0,0 +1,1058 @@ +/* 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 new file mode 100644 index 0000000000..fcb216d412 --- /dev/null +++ b/ext/spice/src/cspice/zzekweed.c @@ -0,0 +1,625 @@ +/* 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 new file mode 100644 index 0000000000..bdf669698c --- /dev/null +++ b/ext/spice/src/cspice/zzekweqi.c @@ -0,0 +1,544 @@ +/* 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 new file mode 100644 index 0000000000..953019c95f --- /dev/null +++ b/ext/spice/src/cspice/zzekwpac.c @@ -0,0 +1,649 @@ +/* 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 new file mode 100644 index 0000000000..082d79db9e --- /dev/null +++ b/ext/spice/src/cspice/zzekwpai.c @@ -0,0 +1,609 @@ +/* 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 new file mode 100644 index 0000000000..37fe84c288 --- /dev/null +++ b/ext/spice/src/cspice/zzekwpal.c @@ -0,0 +1,668 @@ +/* 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 new file mode 100644 index 0000000000..90c0cc4503 --- /dev/null +++ b/ext/spice/src/cspice/zzelvupy.c @@ -0,0 +1,959 @@ +/* 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 new file mode 100644 index 0000000000..a2ba0b9b0e --- /dev/null +++ b/ext/spice/src/cspice/zzenut80.c @@ -0,0 +1,210 @@ +/* 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 new file mode 100644 index 0000000000..e4e8068331 --- /dev/null +++ b/ext/spice/src/cspice/zzeprc76.c @@ -0,0 +1,225 @@ +/* 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 new file mode 100644 index 0000000000..29508f31fe --- /dev/null +++ b/ext/spice/src/cspice/zzeprcss.c @@ -0,0 +1,211 @@ +/* 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 new file mode 100644 index 0000000000..c4ef404377 --- /dev/null +++ b/ext/spice/src/cspice/zzerror.c @@ -0,0 +1,362 @@ +/* + +-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 new file mode 100644 index 0000000000..5709c667d5 --- /dev/null +++ b/ext/spice/src/cspice/zzerror.h @@ -0,0 +1,80 @@ +/* + +-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 new file mode 100644 index 0000000000..9c2e3141fe --- /dev/null +++ b/ext/spice/src/cspice/zzerrorinit.c @@ -0,0 +1,153 @@ +/* +-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 new file mode 100644 index 0000000000..71e3bb64fc --- /dev/null +++ b/ext/spice/src/cspice/zzfcstring.c @@ -0,0 +1,1504 @@ +/* + +-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 new file mode 100644 index 0000000000..54be3324b2 --- /dev/null +++ b/ext/spice/src/cspice/zzfdat.c @@ -0,0 +1,1061 @@ +/* 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 new file mode 100644 index 0000000000..21de077ab2 --- /dev/null +++ b/ext/spice/src/cspice/zzfovaxi.c @@ -0,0 +1,397 @@ +/* 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 new file mode 100644 index 0000000000..c7d087a38d --- /dev/null +++ b/ext/spice/src/cspice/zzfrmch0.c @@ -0,0 +1,878 @@ +/* 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 new file mode 100644 index 0000000000..ed4eaf6cfa --- /dev/null +++ b/ext/spice/src/cspice/zzfrmch1.c @@ -0,0 +1,878 @@ +/* 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 new file mode 100644 index 0000000000..8a5be2f25a --- /dev/null +++ b/ext/spice/src/cspice/zzfrmgt0.c @@ -0,0 +1,356 @@ +/* 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 new file mode 100644 index 0000000000..512d92d8a1 --- /dev/null +++ b/ext/spice/src/cspice/zzfrmgt1.c @@ -0,0 +1,354 @@ +/* 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 new file mode 100644 index 0000000000..ab755f7acb --- /dev/null +++ b/ext/spice/src/cspice/zzftpchk.c @@ -0,0 +1,406 @@ +/* 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 new file mode 100644 index 0000000000..5a1f71cdd9 --- /dev/null +++ b/ext/spice/src/cspice/zzftpstr.c @@ -0,0 +1,468 @@ +/* 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 new file mode 100644 index 0000000000..632607a675 --- /dev/null +++ b/ext/spice/src/cspice/zzgapool.c @@ -0,0 +1,221 @@ +/* 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 new file mode 100644 index 0000000000..b463f32e69 --- /dev/null +++ b/ext/spice/src/cspice/zzgetbff.c @@ -0,0 +1,454 @@ +/* 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 new file mode 100644 index 0000000000..e1d86ab790 --- /dev/null +++ b/ext/spice/src/cspice/zzgetcml_c.c @@ -0,0 +1,363 @@ +/* + +-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 new file mode 100644 index 0000000000..787e4c702c --- /dev/null +++ b/ext/spice/src/cspice/zzgfcoq.c @@ -0,0 +1,963 @@ +/* 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 new file mode 100644 index 0000000000..d7b4897834 --- /dev/null +++ b/ext/spice/src/cspice/zzgfcost.c @@ -0,0 +1,740 @@ +/* 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 new file mode 100644 index 0000000000..694a14407f --- /dev/null +++ b/ext/spice/src/cspice/zzgfcou.c @@ -0,0 +1,3497 @@ +/* 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 new file mode 100644 index 0000000000..01367411eb --- /dev/null +++ b/ext/spice/src/cspice/zzgfcprx.c @@ -0,0 +1,839 @@ +/* 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 new file mode 100644 index 0000000000..6ee6fb8003 --- /dev/null +++ b/ext/spice/src/cspice/zzgfcslv.c @@ -0,0 +1,1400 @@ +/* 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 new file mode 100644 index 0000000000..20349178df --- /dev/null +++ b/ext/spice/src/cspice/zzgfdiq.c @@ -0,0 +1,202 @@ +/* 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 new file mode 100644 index 0000000000..6b0dfb19da --- /dev/null +++ b/ext/spice/src/cspice/zzgfdiu.c @@ -0,0 +1,1167 @@ +/* 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 new file mode 100644 index 0000000000..c8930037be --- /dev/null +++ b/ext/spice/src/cspice/zzgfdsps.c @@ -0,0 +1,296 @@ +/* + +-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 new file mode 100644 index 0000000000..b8fb5e2aac --- /dev/null +++ b/ext/spice/src/cspice/zzgffvu.c @@ -0,0 +1,2270 @@ +/* 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 new file mode 100644 index 0000000000..45c160f38f --- /dev/null +++ b/ext/spice/src/cspice/zzgflong.c @@ -0,0 +1,3014 @@ +/* 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 new file mode 100644 index 0000000000..c7b4da1633 --- /dev/null +++ b/ext/spice/src/cspice/zzgfocu.c @@ -0,0 +1,1912 @@ +/* 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 new file mode 100644 index 0000000000..5a639334db --- /dev/null +++ b/ext/spice/src/cspice/zzgfref.c @@ -0,0 +1,119 @@ +/* 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 new file mode 100644 index 0000000000..fe98a41d74 --- /dev/null +++ b/ext/spice/src/cspice/zzgfrel.c @@ -0,0 +1,1358 @@ +/* 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 new file mode 100644 index 0000000000..9145a3dea4 --- /dev/null +++ b/ext/spice/src/cspice/zzgfrelx.c @@ -0,0 +1,1354 @@ +/* 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 new file mode 100644 index 0000000000..b805a72ff5 --- /dev/null +++ b/ext/spice/src/cspice/zzgfrpwk.c @@ -0,0 +1,1280 @@ +/* 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 new file mode 100644 index 0000000000..cd922a5c8e --- /dev/null +++ b/ext/spice/src/cspice/zzgfrrq.c @@ -0,0 +1,224 @@ +/* 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 new file mode 100644 index 0000000000..b4f54dec18 --- /dev/null +++ b/ext/spice/src/cspice/zzgfrru.c @@ -0,0 +1,1201 @@ +/* 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 new file mode 100644 index 0000000000..136c64ad9b --- /dev/null +++ b/ext/spice/src/cspice/zzgfsavh_c.c @@ -0,0 +1,281 @@ +/* + +-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 new file mode 100644 index 0000000000..6f0d67dd77 --- /dev/null +++ b/ext/spice/src/cspice/zzgfsolv.c @@ -0,0 +1,795 @@ +/* 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 new file mode 100644 index 0000000000..82a12f5f00 --- /dev/null +++ b/ext/spice/src/cspice/zzgfsolvx.c @@ -0,0 +1,808 @@ +/* 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 new file mode 100644 index 0000000000..bcb99f231b --- /dev/null +++ b/ext/spice/src/cspice/zzgfspq.c @@ -0,0 +1,306 @@ +/* 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 new file mode 100644 index 0000000000..93a0509d95 --- /dev/null +++ b/ext/spice/src/cspice/zzgfspu.c @@ -0,0 +1,1437 @@ +/* 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 new file mode 100644 index 0000000000..d412f4e373 --- /dev/null +++ b/ext/spice/src/cspice/zzgfssin.c @@ -0,0 +1,1286 @@ +/* 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 new file mode 100644 index 0000000000..a9ead5b7eb --- /dev/null +++ b/ext/spice/src/cspice/zzgfssob.c @@ -0,0 +1,1187 @@ +/* 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 new file mode 100644 index 0000000000..1568cd981a --- /dev/null +++ b/ext/spice/src/cspice/zzgftreb.c @@ -0,0 +1,208 @@ +/* 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 new file mode 100644 index 0000000000..2a13ab926e --- /dev/null +++ b/ext/spice/src/cspice/zzgfudlt.c @@ -0,0 +1,174 @@ +/* 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 new file mode 100644 index 0000000000..a706cadfdf --- /dev/null +++ b/ext/spice/src/cspice/zzgfwsts.c @@ -0,0 +1,330 @@ +/* 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 new file mode 100644 index 0000000000..c608353737 --- /dev/null +++ b/ext/spice/src/cspice/zzgpnm.c @@ -0,0 +1,262 @@ +/* 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 new file mode 100644 index 0000000000..59003cd9ee --- /dev/null +++ b/ext/spice/src/cspice/zzholdd.c @@ -0,0 +1,242 @@ +/* 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 new file mode 100644 index 0000000000..3df9c30d26 --- /dev/null +++ b/ext/spice/src/cspice/zzhullax.c @@ -0,0 +1,772 @@ +/* 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 new file mode 100644 index 0000000000..b045a9caca --- /dev/null +++ b/ext/spice/src/cspice/zzidmap.c @@ -0,0 +1,1637 @@ +/* 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 new file mode 100644 index 0000000000..8e328f2dd6 --- /dev/null +++ b/ext/spice/src/cspice/zzinssub.c @@ -0,0 +1,291 @@ +/* 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 new file mode 100644 index 0000000000..4e54ef3efe --- /dev/null +++ b/ext/spice/src/cspice/zzldker.c @@ -0,0 +1,358 @@ +/* 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 new file mode 100644 index 0000000000..5c13ccd2a9 --- /dev/null +++ b/ext/spice/src/cspice/zzmkpc.c @@ -0,0 +1,188 @@ +/* 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 new file mode 100644 index 0000000000..06fc89427c --- /dev/null +++ b/ext/spice/src/cspice/zzmobliq.c @@ -0,0 +1,185 @@ +/* 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 new file mode 100644 index 0000000000..836f579f84 --- /dev/null +++ b/ext/spice/src/cspice/zzmsxf.c @@ -0,0 +1,449 @@ +/* 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 new file mode 100644 index 0000000000..796f823eab --- /dev/null +++ b/ext/spice/src/cspice/zznofcon.c @@ -0,0 +1,685 @@ +/* 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 new file mode 100644 index 0000000000..5be931b4af --- /dev/null +++ b/ext/spice/src/cspice/zznrddp.c @@ -0,0 +1,1503 @@ +/* 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 new file mode 100644 index 0000000000..96eddca434 --- /dev/null +++ b/ext/spice/src/cspice/zznwpool.c @@ -0,0 +1,201 @@ +/* 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 new file mode 100644 index 0000000000..3894e03995 --- /dev/null +++ b/ext/spice/src/cspice/zzocced.c @@ -0,0 +1,1547 @@ +/* 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 new file mode 100644 index 0000000000..e01fc3da6a --- /dev/null +++ b/ext/spice/src/cspice/zzphsh.c @@ -0,0 +1,816 @@ +/* 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 new file mode 100644 index 0000000000..8fa3d7cd78 --- /dev/null +++ b/ext/spice/src/cspice/zzpini.c @@ -0,0 +1,299 @@ +/* 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 new file mode 100644 index 0000000000..61170b3ff0 --- /dev/null +++ b/ext/spice/src/cspice/zzplatfm.c @@ -0,0 +1,366 @@ +/* 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 new file mode 100644 index 0000000000..abef9cf0bb --- /dev/null +++ b/ext/spice/src/cspice/zzpltchk.c @@ -0,0 +1,428 @@ +/* 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 new file mode 100644 index 0000000000..da91b6dce1 --- /dev/null +++ b/ext/spice/src/cspice/zzprscor.c @@ -0,0 +1,420 @@ +/* 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 new file mode 100644 index 0000000000..6bc107486f --- /dev/null +++ b/ext/spice/src/cspice/zzrbrkst.c @@ -0,0 +1,249 @@ +/* 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 new file mode 100644 index 0000000000..e31f250916 --- /dev/null +++ b/ext/spice/src/cspice/zzrefch0.c @@ -0,0 +1,680 @@ +/* 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 new file mode 100644 index 0000000000..26c48ce3f6 --- /dev/null +++ b/ext/spice/src/cspice/zzrefch1.c @@ -0,0 +1,680 @@ +/* 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 new file mode 100644 index 0000000000..2356d28e98 --- /dev/null +++ b/ext/spice/src/cspice/zzrepsub.c @@ -0,0 +1,298 @@ +/* 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 new file mode 100644 index 0000000000..1a102c8565 --- /dev/null +++ b/ext/spice/src/cspice/zzrept.c @@ -0,0 +1,137 @@ +/* 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 new file mode 100644 index 0000000000..a1ae42b186 --- /dev/null +++ b/ext/spice/src/cspice/zzrotgt0.c @@ -0,0 +1,347 @@ +/* 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 new file mode 100644 index 0000000000..785e99068c --- /dev/null +++ b/ext/spice/src/cspice/zzrotgt1.c @@ -0,0 +1,340 @@ +/* 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 new file mode 100644 index 0000000000..e461746bc3 --- /dev/null +++ b/ext/spice/src/cspice/zzrtnmat.c @@ -0,0 +1,274 @@ +/* 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 new file mode 100644 index 0000000000..9bb16d69a6 --- /dev/null +++ b/ext/spice/src/cspice/zzrvar.c @@ -0,0 +1,1158 @@ +/* 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 new file mode 100644 index 0000000000..6b1226e1dc --- /dev/null +++ b/ext/spice/src/cspice/zzrvbf.c @@ -0,0 +1,1087 @@ +/* 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 new file mode 100644 index 0000000000..231627eb88 --- /dev/null +++ b/ext/spice/src/cspice/zzrxr.c @@ -0,0 +1,264 @@ +/* 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 new file mode 100644 index 0000000000..605e0395ec --- /dev/null +++ b/ext/spice/src/cspice/zzsclk.c @@ -0,0 +1,321 @@ +/* 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 new file mode 100644 index 0000000000..c224096e49 --- /dev/null +++ b/ext/spice/src/cspice/zzsecprt.c @@ -0,0 +1,211 @@ +/* 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 new file mode 100644 index 0000000000..0fe5ffc069 --- /dev/null +++ b/ext/spice/src/cspice/zzsizeok.c @@ -0,0 +1,218 @@ +/* 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 new file mode 100644 index 0000000000..dce700af7e --- /dev/null +++ b/ext/spice/src/cspice/zzspkac0.c @@ -0,0 +1,734 @@ +/* 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 new file mode 100644 index 0000000000..8ac4037009 --- /dev/null +++ b/ext/spice/src/cspice/zzspkac1.c @@ -0,0 +1,734 @@ +/* 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 new file mode 100644 index 0000000000..027d1bce89 --- /dev/null +++ b/ext/spice/src/cspice/zzspkap0.c @@ -0,0 +1,867 @@ +/* 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 new file mode 100644 index 0000000000..a71ecc24f2 --- /dev/null +++ b/ext/spice/src/cspice/zzspkap1.c @@ -0,0 +1,867 @@ +/* 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 new file mode 100644 index 0000000000..aebbae1c6b --- /dev/null +++ b/ext/spice/src/cspice/zzspkas0.c @@ -0,0 +1,827 @@ +/* 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 new file mode 100644 index 0000000000..94ac29061c --- /dev/null +++ b/ext/spice/src/cspice/zzspkas1.c @@ -0,0 +1,828 @@ +/* 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 new file mode 100644 index 0000000000..19d4b6575e --- /dev/null +++ b/ext/spice/src/cspice/zzspkez0.c @@ -0,0 +1,1416 @@ +/* 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 new file mode 100644 index 0000000000..ce7034cd12 --- /dev/null +++ b/ext/spice/src/cspice/zzspkez1.c @@ -0,0 +1,1432 @@ +/* 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 new file mode 100644 index 0000000000..f3906babb1 --- /dev/null +++ b/ext/spice/src/cspice/zzspkgo0.c @@ -0,0 +1,1040 @@ +/* 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 new file mode 100644 index 0000000000..df6f812862 --- /dev/null +++ b/ext/spice/src/cspice/zzspkgo1.c @@ -0,0 +1,1042 @@ +/* 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 new file mode 100644 index 0000000000..034a365650 --- /dev/null +++ b/ext/spice/src/cspice/zzspkgp0.c @@ -0,0 +1,1022 @@ +/* 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 new file mode 100644 index 0000000000..de400254ff --- /dev/null +++ b/ext/spice/src/cspice/zzspkgp1.c @@ -0,0 +1,1019 @@ +/* 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 new file mode 100644 index 0000000000..db2e8c83b2 --- /dev/null +++ b/ext/spice/src/cspice/zzspklt0.c @@ -0,0 +1,920 @@ +/* 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 new file mode 100644 index 0000000000..91ee66e1bf --- /dev/null +++ b/ext/spice/src/cspice/zzspklt1.c @@ -0,0 +1,920 @@ +/* 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 new file mode 100644 index 0000000000..e54ab085e1 --- /dev/null +++ b/ext/spice/src/cspice/zzspkpa0.c @@ -0,0 +1,814 @@ +/* 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 new file mode 100644 index 0000000000..2af7209807 --- /dev/null +++ b/ext/spice/src/cspice/zzspkpa1.c @@ -0,0 +1,815 @@ +/* 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 new file mode 100644 index 0000000000..97f4b232d9 --- /dev/null +++ b/ext/spice/src/cspice/zzspksb0.c @@ -0,0 +1,200 @@ +/* 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 new file mode 100644 index 0000000000..b5b7ecaa49 --- /dev/null +++ b/ext/spice/src/cspice/zzspksb1.c @@ -0,0 +1,200 @@ +/* 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 new file mode 100644 index 0000000000..69c641c1c4 --- /dev/null +++ b/ext/spice/src/cspice/zzspkzp0.c @@ -0,0 +1,1004 @@ +/* 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 new file mode 100644 index 0000000000..ed9a15d179 --- /dev/null +++ b/ext/spice/src/cspice/zzspkzp1.c @@ -0,0 +1,1019 @@ +/* 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 new file mode 100644 index 0000000000..df0c54f09e --- /dev/null +++ b/ext/spice/src/cspice/zzstelab.c @@ -0,0 +1,552 @@ +/* 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 new file mode 100644 index 0000000000..13a99a8738 --- /dev/null +++ b/ext/spice/src/cspice/zzsynccl_c.c @@ -0,0 +1,263 @@ +/* + +-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 new file mode 100644 index 0000000000..5ab189f013 --- /dev/null +++ b/ext/spice/src/cspice/zztime.c @@ -0,0 +1,3737 @@ +/* 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 new file mode 100644 index 0000000000..7be7587adb --- /dev/null +++ b/ext/spice/src/cspice/zztpats.c @@ -0,0 +1,597 @@ +/* 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 new file mode 100644 index 0000000000..fb31c576bf --- /dev/null +++ b/ext/spice/src/cspice/zztwovxf.c @@ -0,0 +1,459 @@ +/* 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 new file mode 100644 index 0000000000..7864931de6 --- /dev/null +++ b/ext/spice/src/cspice/zzutcpm.c @@ -0,0 +1,237 @@ +/* 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 new file mode 100644 index 0000000000..3fc0ccf59f --- /dev/null +++ b/ext/spice/src/cspice/zzvalcor.c @@ -0,0 +1,343 @@ +/* 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 new file mode 100644 index 0000000000..5303e9cc6a --- /dev/null +++ b/ext/spice/src/cspice/zzvstrng.c @@ -0,0 +1,748 @@ +/* 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 new file mode 100644 index 0000000000..28c11ebc82 --- /dev/null +++ b/ext/spice/src/cspice/zzwahr.c @@ -0,0 +1,470 @@ +/* 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 new file mode 100644 index 0000000000..672673c723 --- /dev/null +++ b/ext/spice/src/cspice/zzwind.c @@ -0,0 +1,394 @@ +/* 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 new file mode 100644 index 0000000000..288e485d75 --- /dev/null +++ b/ext/spice/src/cspice/zzwind2d.c @@ -0,0 +1,343 @@ +/* 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 new file mode 100644 index 0000000000..fbefe898de --- /dev/null +++ b/ext/spice/src/cspice/zzwninsd.c @@ -0,0 +1,402 @@ +/* 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 new file mode 100644 index 0000000000..2cc17b71f4 --- /dev/null +++ b/ext/spice/src/cspice/zzxlated.c @@ -0,0 +1,1085 @@ +/* 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 new file mode 100644 index 0000000000..0aef7734b6 --- /dev/null +++ b/ext/spice/src/cspice/zzxlatei.c @@ -0,0 +1,887 @@ +/* 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 new file mode 100644 index 0000000000..894d4e9a6c --- /dev/null +++ b/ext/spice/src/csupport/SpiceCK.h @@ -0,0 +1,155 @@ +/* + +-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 new file mode 100644 index 0000000000..7b0537e9ee --- /dev/null +++ b/ext/spice/src/csupport/SpiceCel.h @@ -0,0 +1,441 @@ +/* + +-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 new file mode 100644 index 0000000000..cbe213fb01 --- /dev/null +++ b/ext/spice/src/csupport/SpiceEK.h @@ -0,0 +1,448 @@ +/* + +-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 new file mode 100644 index 0000000000..d0c123ab06 --- /dev/null +++ b/ext/spice/src/csupport/SpiceEll.h @@ -0,0 +1,115 @@ +/* + +-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 new file mode 100644 index 0000000000..14d10de2fd --- /dev/null +++ b/ext/spice/src/csupport/SpiceGF.h @@ -0,0 +1,319 @@ +/* + +-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 new file mode 100644 index 0000000000..839fb15606 --- /dev/null +++ b/ext/spice/src/csupport/SpicePln.h @@ -0,0 +1,106 @@ +/* + +-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 new file mode 100644 index 0000000000..a4c8eac5f7 --- /dev/null +++ b/ext/spice/src/csupport/SpiceSPK.h @@ -0,0 +1,128 @@ +/* + +-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 new file mode 100644 index 0000000000..83038e32a3 --- /dev/null +++ b/ext/spice/src/csupport/SpiceUsr.h @@ -0,0 +1,217 @@ +/* + +-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 new file mode 100644 index 0000000000..f838e7f31c --- /dev/null +++ b/ext/spice/src/csupport/SpiceZad.h @@ -0,0 +1,205 @@ +/* + +-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 new file mode 100644 index 0000000000..36276051d6 --- /dev/null +++ b/ext/spice/src/csupport/SpiceZdf.h @@ -0,0 +1,246 @@ +/* + +-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 new file mode 100644 index 0000000000..33f541770b --- /dev/null +++ b/ext/spice/src/csupport/SpiceZfc.h @@ -0,0 +1,13228 @@ +/* + +-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 new file mode 100644 index 0000000000..ee8d96ebc6 --- /dev/null +++ b/ext/spice/src/csupport/SpiceZim.h @@ -0,0 +1,1358 @@ +/* + +-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 new file mode 100644 index 0000000000..df694a602e --- /dev/null +++ b/ext/spice/src/csupport/SpiceZmc.h @@ -0,0 +1,975 @@ +/* + +-Disclaimer + + THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE + CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. + GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE + ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE + PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" + TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY + WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A + PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC + SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE + SOFTWARE AND RELATED MATERIALS, HOWEVER USED. + + IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA + BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT + LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, + INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, + REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE + REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. + + RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF + THE SOFTWARE AND ANY RELATED MATERIALS, 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 new file mode 100644 index 0000000000..1413202b69 --- /dev/null +++ b/ext/spice/src/csupport/SpiceZpl.h @@ -0,0 +1,109 @@ +/* + +-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 new file mode 100644 index 0000000000..b4d672e98c --- /dev/null +++ b/ext/spice/src/csupport/SpiceZpr.h @@ -0,0 +1,3853 @@ +/* + +-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 new file mode 100644 index 0000000000..ba48b16c1c --- /dev/null +++ b/ext/spice/src/csupport/SpiceZst.h @@ -0,0 +1,199 @@ +/* + +-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 new file mode 100644 index 0000000000..a542721805 --- /dev/null +++ b/ext/spice/src/csupport/batch.c @@ -0,0 +1,120 @@ +/* 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 new file mode 100644 index 0000000000..7177a57ff6 --- /dev/null +++ b/ext/spice/src/csupport/bboard_1.c @@ -0,0 +1,3130 @@ +/* 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 new file mode 100644 index 0000000000..d5ac6567f4 --- /dev/null +++ b/ext/spice/src/csupport/bestwd.c @@ -0,0 +1,730 @@ +/* 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 new file mode 100644 index 0000000000..dec0c1d214 --- /dev/null +++ b/ext/spice/src/csupport/builtn.c @@ -0,0 +1,423 @@ +/* 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 new file mode 100644 index 0000000000..4d270e525e --- /dev/null +++ b/ext/spice/src/csupport/cbget_1.c @@ -0,0 +1,214 @@ +/* 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 new file mode 100644 index 0000000000..39d4a0d4f2 --- /dev/null +++ b/ext/spice/src/csupport/cbinit_1.c @@ -0,0 +1,184 @@ +/* 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 new file mode 100644 index 0000000000..fef699d656 --- /dev/null +++ b/ext/spice/src/csupport/cbput_1.c @@ -0,0 +1,210 @@ +/* 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 new file mode 100644 index 0000000000..4ba8e5eb67 --- /dev/null +++ b/ext/spice/src/csupport/cbrem_1.c @@ -0,0 +1,215 @@ +/* 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 new file mode 100644 index 0000000000..0b2227732c --- /dev/null +++ b/ext/spice/src/csupport/changu.c @@ -0,0 +1,512 @@ +/* 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 new file mode 100644 index 0000000000..fda52017aa --- /dev/null +++ b/ext/spice/src/csupport/chbfit.c @@ -0,0 +1,545 @@ +/* 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 new file mode 100644 index 0000000000..0c2ca153ff --- /dev/null +++ b/ext/spice/src/csupport/ck3sdn.c @@ -0,0 +1,599 @@ +/* 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 new file mode 100644 index 0000000000..dc7a131a52 --- /dev/null +++ b/ext/spice/src/csupport/cmloop.c @@ -0,0 +1,563 @@ +/* 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 new file mode 100644 index 0000000000..53fa8c1d54 --- /dev/null +++ b/ext/spice/src/csupport/cmmore.c @@ -0,0 +1,214 @@ +/* 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 new file mode 100644 index 0000000000..46609b305f --- /dev/null +++ b/ext/spice/src/csupport/cmredo.c @@ -0,0 +1,226 @@ +/* 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 new file mode 100644 index 0000000000..9c2152e912 --- /dev/null +++ b/ext/spice/src/csupport/cmstup.c @@ -0,0 +1,187 @@ +/* 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 new file mode 100644 index 0000000000..24f72fdb50 --- /dev/null +++ b/ext/spice/src/csupport/cnfirm.c @@ -0,0 +1,192 @@ +/* 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 new file mode 100644 index 0000000000..1a594fef2b --- /dev/null +++ b/ext/spice/src/csupport/cnfirm_1.c @@ -0,0 +1,204 @@ +/* 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 new file mode 100644 index 0000000000..40d70a41e6 --- /dev/null +++ b/ext/spice/src/csupport/convbt.c @@ -0,0 +1,477 @@ +/* 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 new file mode 100644 index 0000000000..6a52c61a36 --- /dev/null +++ b/ext/spice/src/csupport/convrt_2.c @@ -0,0 +1,722 @@ +/* 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 new file mode 100644 index 0000000000..407bc50a6a --- /dev/null +++ b/ext/spice/src/csupport/convrt_3.c @@ -0,0 +1,723 @@ +/* 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 new file mode 100644 index 0000000000..65b3c556c8 --- /dev/null +++ b/ext/spice/src/csupport/convtb.c @@ -0,0 +1,727 @@ +/* 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 new file mode 100644 index 0000000000..a5aca0aac5 --- /dev/null +++ b/ext/spice/src/csupport/cputim.c @@ -0,0 +1,279 @@ +/* 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 new file mode 100644 index 0000000000..aa11a89064 --- /dev/null +++ b/ext/spice/src/csupport/crtptr.c @@ -0,0 +1,211 @@ +/* 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 new file mode 100644 index 0000000000..f2bdbb4a4b --- /dev/null +++ b/ext/spice/src/csupport/curtim.c @@ -0,0 +1,190 @@ +/* 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 new file mode 100644 index 0000000000..93be2678c1 --- /dev/null +++ b/ext/spice/src/csupport/cutstr.c @@ -0,0 +1,491 @@ +/* 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 new file mode 100644 index 0000000000..1e434be391 --- /dev/null +++ b/ext/spice/src/csupport/dafacu.c @@ -0,0 +1,860 @@ +/* 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 new file mode 100644 index 0000000000..c2e73ce7a6 --- /dev/null +++ b/ext/spice/src/csupport/dafecu.c @@ -0,0 +1,316 @@ +/* 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 new file mode 100644 index 0000000000..876861d243 --- /dev/null +++ b/ext/spice/src/csupport/dcyphr.c @@ -0,0 +1,1019 @@ +/* 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 new file mode 100644 index 0000000000..926657635c --- /dev/null +++ b/ext/spice/src/csupport/dimcb_1.c @@ -0,0 +1,163 @@ +/* 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 new file mode 100644 index 0000000000..b9dfa6e00e --- /dev/null +++ b/ext/spice/src/csupport/dspvrs.c @@ -0,0 +1,151 @@ +/* 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 new file mode 100644 index 0000000000..153187be1e --- /dev/null +++ b/ext/spice/src/csupport/echo.c @@ -0,0 +1,335 @@ +/* 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 new file mode 100644 index 0000000000..282530c1d5 --- /dev/null +++ b/ext/spice/src/csupport/edtcmd.c @@ -0,0 +1,352 @@ +/* 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 new file mode 100644 index 0000000000..a6630cc2ce --- /dev/null +++ b/ext/spice/src/csupport/edtcom.c @@ -0,0 +1,1022 @@ +/* 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 new file mode 100644 index 0000000000..db395b31fe --- /dev/null +++ b/ext/spice/src/csupport/exesys.c @@ -0,0 +1,323 @@ +/* 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 new file mode 100644 index 0000000000..b8a05490e5 --- /dev/null +++ b/ext/spice/src/csupport/expfnm_1.c @@ -0,0 +1,399 @@ +/* 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 new file mode 100644 index 0000000000..c3b0b9e8ef --- /dev/null +++ b/ext/spice/src/csupport/expfnm_2.c @@ -0,0 +1,407 @@ +/* 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 new file mode 100644 index 0000000000..079fdaf490 --- /dev/null +++ b/ext/spice/src/csupport/f2c.h @@ -0,0 +1,654 @@ +/* + +-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 new file mode 100644 index 0000000000..f18fded688 --- /dev/null +++ b/ext/spice/src/csupport/f2cMang.h @@ -0,0 +1,390 @@ +/* + +-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 new file mode 100644 index 0000000000..ae2b82bbf4 --- /dev/null +++ b/ext/spice/src/csupport/flgrpt.c @@ -0,0 +1,175 @@ +/* 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 new file mode 100644 index 0000000000..dacc9c87d2 --- /dev/null +++ b/ext/spice/src/csupport/fndntk.c @@ -0,0 +1,482 @@ +/* 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 new file mode 100644 index 0000000000..3b82a5756b --- /dev/null +++ b/ext/spice/src/csupport/fndptk.c @@ -0,0 +1,480 @@ +/* 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 new file mode 100644 index 0000000000..20a731e788 --- /dev/null +++ b/ext/spice/src/csupport/fnducv.c @@ -0,0 +1,957 @@ +/* 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 new file mode 100644 index 0000000000..cab0d37612 --- /dev/null +++ b/ext/spice/src/csupport/getcml.c @@ -0,0 +1,332 @@ +/* + +-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 new file mode 100644 index 0000000000..4724325035 --- /dev/null +++ b/ext/spice/src/csupport/getdel.c @@ -0,0 +1,67 @@ +/* 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 new file mode 100644 index 0000000000..f799e3248e --- /dev/null +++ b/ext/spice/src/csupport/geteq.c @@ -0,0 +1,68 @@ +/* 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 new file mode 100644 index 0000000000..556d29ec3b --- /dev/null +++ b/ext/spice/src/csupport/getfnm.c @@ -0,0 +1,441 @@ +/* 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 new file mode 100644 index 0000000000..8cd69e712b --- /dev/null +++ b/ext/spice/src/csupport/getfnm_1.c @@ -0,0 +1,562 @@ +/* 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 new file mode 100644 index 0000000000..4b66b5da4e --- /dev/null +++ b/ext/spice/src/csupport/getopt.c @@ -0,0 +1,376 @@ +/* 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 new file mode 100644 index 0000000000..e64e108334 --- /dev/null +++ b/ext/spice/src/csupport/getopt_1.c @@ -0,0 +1,361 @@ +/* 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 new file mode 100644 index 0000000000..09d9eb1a9a --- /dev/null +++ b/ext/spice/src/csupport/getopt_2.c @@ -0,0 +1,348 @@ +/* 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 new file mode 100644 index 0000000000..63e070794f --- /dev/null +++ b/ext/spice/src/csupport/have.c @@ -0,0 +1,190 @@ +/* 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 new file mode 100644 index 0000000000..5186c06c7c --- /dev/null +++ b/ext/spice/src/csupport/header.c @@ -0,0 +1,273 @@ +/* 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 new file mode 100644 index 0000000000..93abeb02a8 --- /dev/null +++ b/ext/spice/src/csupport/langua.c @@ -0,0 +1,98 @@ +/* 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 new file mode 100644 index 0000000000..b9b5e1d9cb --- /dev/null +++ b/ext/spice/src/csupport/lbdes_1.c @@ -0,0 +1,163 @@ +/* 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 new file mode 100644 index 0000000000..1377ba601a --- /dev/null +++ b/ext/spice/src/csupport/lbget_1.c @@ -0,0 +1,187 @@ +/* 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 new file mode 100644 index 0000000000..006a590673 --- /dev/null +++ b/ext/spice/src/csupport/lbinit_1.c @@ -0,0 +1,212 @@ +/* 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 new file mode 100644 index 0000000000..00cb94c50e --- /dev/null +++ b/ext/spice/src/csupport/lbins_1.c @@ -0,0 +1,261 @@ +/* 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 new file mode 100644 index 0000000000..c09fb4a249 --- /dev/null +++ b/ext/spice/src/csupport/lbpack_1.c @@ -0,0 +1,190 @@ +/* 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 new file mode 100644 index 0000000000..a49e0fbd62 --- /dev/null +++ b/ext/spice/src/csupport/lbrem_1.c @@ -0,0 +1,254 @@ +/* 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 new file mode 100644 index 0000000000..7ffe0eab70 --- /dev/null +++ b/ext/spice/src/csupport/lbupd_1.c @@ -0,0 +1,156 @@ +/* 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 new file mode 100644 index 0000000000..98fd05e5f2 --- /dev/null +++ b/ext/spice/src/csupport/logchk.c @@ -0,0 +1,160 @@ +/* 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 new file mode 100644 index 0000000000..ef7c70fbc6 --- /dev/null +++ b/ext/spice/src/csupport/m2alph.c @@ -0,0 +1,159 @@ +/* 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 new file mode 100644 index 0000000000..050d501fcb --- /dev/null +++ b/ext/spice/src/csupport/m2begr.c @@ -0,0 +1,336 @@ +/* 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 new file mode 100644 index 0000000000..1a1f4adc11 --- /dev/null +++ b/ext/spice/src/csupport/m2bodini.c @@ -0,0 +1,198 @@ +/* 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 new file mode 100644 index 0000000000..f1dc15e745 --- /dev/null +++ b/ext/spice/src/csupport/m2bodtrn.c @@ -0,0 +1,1486 @@ +/* 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 new file mode 100644 index 0000000000..8a6bdadcbc --- /dev/null +++ b/ext/spice/src/csupport/m2body.c @@ -0,0 +1,165 @@ +/* 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 new file mode 100644 index 0000000000..38453f7491 --- /dev/null +++ b/ext/spice/src/csupport/m2cal.c @@ -0,0 +1,262 @@ +/* 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 new file mode 100644 index 0000000000..bc0a027f61 --- /dev/null +++ b/ext/spice/src/csupport/m2chck.c @@ -0,0 +1,288 @@ +/* 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 new file mode 100644 index 0000000000..1b06eea57e --- /dev/null +++ b/ext/spice/src/csupport/m2clss.c @@ -0,0 +1,376 @@ +/* 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 new file mode 100644 index 0000000000..f89a2187bd --- /dev/null +++ b/ext/spice/src/csupport/m2core.c @@ -0,0 +1,2017 @@ +/* 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 new file mode 100644 index 0000000000..3718786d99 --- /dev/null +++ b/ext/spice/src/csupport/m2day.c @@ -0,0 +1,230 @@ +/* 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 new file mode 100644 index 0000000000..f7c16d8d2f --- /dev/null +++ b/ext/spice/src/csupport/m2diag.c @@ -0,0 +1,570 @@ +/* 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 new file mode 100644 index 0000000000..9629576643 --- /dev/null +++ b/ext/spice/src/csupport/m2engl.c @@ -0,0 +1,169 @@ +/* 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 new file mode 100644 index 0000000000..16bdec090e --- /dev/null +++ b/ext/spice/src/csupport/m2epoc.c @@ -0,0 +1,165 @@ +/* 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 new file mode 100644 index 0000000000..87d6664330 --- /dev/null +++ b/ext/spice/src/csupport/m2geta.c @@ -0,0 +1,392 @@ +/* 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 new file mode 100644 index 0000000000..1baeda5279 --- /dev/null +++ b/ext/spice/src/csupport/m2getb.c @@ -0,0 +1,374 @@ +/* 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 new file mode 100644 index 0000000000..2e32f50734 --- /dev/null +++ b/ext/spice/src/csupport/m2getc.c @@ -0,0 +1,352 @@ +/* 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 new file mode 100644 index 0000000000..53cf2e1fbd --- /dev/null +++ b/ext/spice/src/csupport/m2getd.c @@ -0,0 +1,362 @@ +/* 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 new file mode 100644 index 0000000000..581fcfdc45 --- /dev/null +++ b/ext/spice/src/csupport/m2geti.c @@ -0,0 +1,363 @@ +/* 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 new file mode 100644 index 0000000000..b4d121ee44 --- /dev/null +++ b/ext/spice/src/csupport/m2gmch.c @@ -0,0 +1,1080 @@ +/* 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 new file mode 100644 index 0000000000..e239ee79e1 --- /dev/null +++ b/ext/spice/src/csupport/m2have.c @@ -0,0 +1,174 @@ +/* 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 new file mode 100644 index 0000000000..0c4d1c52c8 --- /dev/null +++ b/ext/spice/src/csupport/m2int.c @@ -0,0 +1,284 @@ +/* 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 new file mode 100644 index 0000000000..e6694e65fe --- /dev/null +++ b/ext/spice/src/csupport/m2ints.c @@ -0,0 +1,268 @@ +/* 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 new file mode 100644 index 0000000000..f2200bd364 --- /dev/null +++ b/ext/spice/src/csupport/m2keyw.c @@ -0,0 +1,263 @@ +/* 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 new file mode 100644 index 0000000000..f5160c7ed8 --- /dev/null +++ b/ext/spice/src/csupport/m2mon.c @@ -0,0 +1,207 @@ +/* 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 new file mode 100644 index 0000000000..fc5f71403c --- /dev/null +++ b/ext/spice/src/csupport/m2name.c @@ -0,0 +1,178 @@ +/* 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 new file mode 100644 index 0000000000..ba8dbbc2f1 --- /dev/null +++ b/ext/spice/src/csupport/m2ntem.c @@ -0,0 +1,224 @@ +/* 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 new file mode 100644 index 0000000000..1ddd1a037e --- /dev/null +++ b/ext/spice/src/csupport/m2numb.c @@ -0,0 +1,222 @@ +/* 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 new file mode 100644 index 0000000000..19ec04d85b --- /dev/null +++ b/ext/spice/src/csupport/m2pars.c @@ -0,0 +1,1254 @@ +/* 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 new file mode 100644 index 0000000000..8fc1706425 --- /dev/null +++ b/ext/spice/src/csupport/m2selb.c @@ -0,0 +1,359 @@ +/* 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 new file mode 100644 index 0000000000..81046a883d --- /dev/null +++ b/ext/spice/src/csupport/m2selc.c @@ -0,0 +1,355 @@ +/* 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 new file mode 100644 index 0000000000..05bc45b0c8 --- /dev/null +++ b/ext/spice/src/csupport/m2seld.c @@ -0,0 +1,364 @@ +/* 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 new file mode 100644 index 0000000000..a4341395b8 --- /dev/null +++ b/ext/spice/src/csupport/m2seli.c @@ -0,0 +1,363 @@ +/* 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 new file mode 100644 index 0000000000..33fc91f8cf --- /dev/null +++ b/ext/spice/src/csupport/m2shll.c @@ -0,0 +1,211 @@ +/* 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 new file mode 100644 index 0000000000..2bda60838d --- /dev/null +++ b/ext/spice/src/csupport/m2term.c @@ -0,0 +1,423 @@ +/* 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 new file mode 100644 index 0000000000..63dcdca661 --- /dev/null +++ b/ext/spice/src/csupport/m2thnq.c @@ -0,0 +1,170 @@ +/* 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 new file mode 100644 index 0000000000..bafab22201 --- /dev/null +++ b/ext/spice/src/csupport/m2time.c @@ -0,0 +1,319 @@ +/* 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 new file mode 100644 index 0000000000..0ebf80da78 --- /dev/null +++ b/ext/spice/src/csupport/m2tran.c @@ -0,0 +1,323 @@ +/* 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 new file mode 100644 index 0000000000..d51b5fdc09 --- /dev/null +++ b/ext/spice/src/csupport/m2trim.c @@ -0,0 +1,200 @@ +/* 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 new file mode 100644 index 0000000000..04d8f99b21 --- /dev/null +++ b/ext/spice/src/csupport/m2unit.c @@ -0,0 +1,142 @@ +/* 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 new file mode 100644 index 0000000000..44dc69f6c4 --- /dev/null +++ b/ext/spice/src/csupport/m2wmch.c @@ -0,0 +1,375 @@ +/* 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 new file mode 100644 index 0000000000..05eb324ffe --- /dev/null +++ b/ext/spice/src/csupport/m2xist.c @@ -0,0 +1,190 @@ +/* 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 new file mode 100644 index 0000000000..a1476c1d1f --- /dev/null +++ b/ext/spice/src/csupport/m2year.c @@ -0,0 +1,237 @@ +/* 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 new file mode 100644 index 0000000000..8f15392ce9 --- /dev/null +++ b/ext/spice/src/csupport/makstr.c @@ -0,0 +1,860 @@ +/* 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 new file mode 100644 index 0000000000..1de8bba3e7 --- /dev/null +++ b/ext/spice/src/csupport/match.c @@ -0,0 +1,239 @@ +/* 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 new file mode 100644 index 0000000000..eced248f03 --- /dev/null +++ b/ext/spice/src/csupport/matchc.c @@ -0,0 +1,389 @@ +/* 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 new file mode 100644 index 0000000000..0c5e561b59 --- /dev/null +++ b/ext/spice/src/csupport/matche.c @@ -0,0 +1,320 @@ +/* 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 new file mode 100644 index 0000000000..fb2888ca7c --- /dev/null +++ b/ext/spice/src/csupport/matchm.c @@ -0,0 +1,636 @@ +/* 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 new file mode 100644 index 0000000000..96fdeb5299 --- /dev/null +++ b/ext/spice/src/csupport/matcho.c @@ -0,0 +1,459 @@ +/* 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 new file mode 100644 index 0000000000..02526c3a17 --- /dev/null +++ b/ext/spice/src/csupport/meta_2.c @@ -0,0 +1,504 @@ +/* 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 new file mode 100644 index 0000000000..2244d9acc5 --- /dev/null +++ b/ext/spice/src/csupport/mkprodct.csh @@ -0,0 +1,314 @@ +#! /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 new file mode 100644 index 0000000000..d50dba6ce5 --- /dev/null +++ b/ext/spice/src/csupport/mspeld.c @@ -0,0 +1,266 @@ +/* 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 new file mode 100644 index 0000000000..411cba302a --- /dev/null +++ b/ext/spice/src/csupport/ncodec.c @@ -0,0 +1,285 @@ +/* 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 new file mode 100644 index 0000000000..10c8d68d76 --- /dev/null +++ b/ext/spice/src/csupport/ncoded.c @@ -0,0 +1,283 @@ +/* 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 new file mode 100644 index 0000000000..c7e24857b8 --- /dev/null +++ b/ext/spice/src/csupport/ncodei.c @@ -0,0 +1,283 @@ +/* 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 new file mode 100644 index 0000000000..aa379c960f --- /dev/null +++ b/ext/spice/src/csupport/newfil.c @@ -0,0 +1,351 @@ +/* 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 new file mode 100644 index 0000000000..2779666502 --- /dev/null +++ b/ext/spice/src/csupport/newfil_1.c @@ -0,0 +1,255 @@ +/* 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 new file mode 100644 index 0000000000..e7524774c9 --- /dev/null +++ b/ext/spice/src/csupport/nicebt_1.c @@ -0,0 +1,1107 @@ +/* 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 new file mode 100644 index 0000000000..bc04a1998a --- /dev/null +++ b/ext/spice/src/csupport/niceio_3.c @@ -0,0 +1,1136 @@ +/* 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 new file mode 100644 index 0000000000..67a136730c --- /dev/null +++ b/ext/spice/src/csupport/nicepr_1.c @@ -0,0 +1,1121 @@ +/* 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 new file mode 100644 index 0000000000..b30d15edcd --- /dev/null +++ b/ext/spice/src/csupport/no.c @@ -0,0 +1,51 @@ +/* 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 new file mode 100644 index 0000000000..f87a953113 --- /dev/null +++ b/ext/spice/src/csupport/nspio.c @@ -0,0 +1,2331 @@ +/* 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 new file mode 100644 index 0000000000..ae25f357fd --- /dev/null +++ b/ext/spice/src/csupport/nsplgr.c @@ -0,0 +1,247 @@ +/* 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 new file mode 100644 index 0000000000..50d73367ef --- /dev/null +++ b/ext/spice/src/csupport/nspopl.c @@ -0,0 +1,219 @@ +/* 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 new file mode 100644 index 0000000000..d6513f6ef7 --- /dev/null +++ b/ext/spice/src/csupport/nsppwd.c @@ -0,0 +1,242 @@ +/* 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 new file mode 100644 index 0000000000..7dc9f29991 --- /dev/null +++ b/ext/spice/src/csupport/nspsav.c @@ -0,0 +1,61 @@ +/* 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 new file mode 100644 index 0000000000..645286b6ac --- /dev/null +++ b/ext/spice/src/csupport/nspxcp.c @@ -0,0 +1,220 @@ +/* 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 new file mode 100644 index 0000000000..5fe21b6c0b --- /dev/null +++ b/ext/spice/src/csupport/nthuqt.c @@ -0,0 +1,267 @@ +/* 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 new file mode 100644 index 0000000000..565e9ae966 --- /dev/null +++ b/ext/spice/src/csupport/nthuqw.c @@ -0,0 +1,267 @@ +/* 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 new file mode 100644 index 0000000000..7a1300c492 --- /dev/null +++ b/ext/spice/src/csupport/nxtcom.c @@ -0,0 +1,719 @@ +/* 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 new file mode 100644 index 0000000000..2b199009ef --- /dev/null +++ b/ext/spice/src/csupport/occurs.c @@ -0,0 +1,155 @@ +/* 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 new file mode 100644 index 0000000000..38384f3066 --- /dev/null +++ b/ext/spice/src/csupport/pagman.c @@ -0,0 +1,1348 @@ +/* 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 new file mode 100644 index 0000000000..3d244a842a --- /dev/null +++ b/ext/spice/src/csupport/pltfrm.c @@ -0,0 +1,202 @@ +/* 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 new file mode 100644 index 0000000000..f6deb33253 --- /dev/null +++ b/ext/spice/src/csupport/podaec.c @@ -0,0 +1,204 @@ +/* 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 new file mode 100644 index 0000000000..ea04b0c43a --- /dev/null +++ b/ext/spice/src/csupport/podaed.c @@ -0,0 +1,204 @@ +/* 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 new file mode 100644 index 0000000000..a287da7f1b --- /dev/null +++ b/ext/spice/src/csupport/podaei.c @@ -0,0 +1,204 @@ +/* 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 new file mode 100644 index 0000000000..54da3eb107 --- /dev/null +++ b/ext/spice/src/csupport/podbec.c @@ -0,0 +1,169 @@ +/* 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 new file mode 100644 index 0000000000..f5a55c8e9b --- /dev/null +++ b/ext/spice/src/csupport/podbed.c @@ -0,0 +1,168 @@ +/* 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 new file mode 100644 index 0000000000..7afb515f91 --- /dev/null +++ b/ext/spice/src/csupport/podbei.c @@ -0,0 +1,168 @@ +/* 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 new file mode 100644 index 0000000000..e22dca400e --- /dev/null +++ b/ext/spice/src/csupport/podbgc.c @@ -0,0 +1,203 @@ +/* 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 new file mode 100644 index 0000000000..004f80a795 --- /dev/null +++ b/ext/spice/src/csupport/podbgd.c @@ -0,0 +1,199 @@ +/* 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 new file mode 100644 index 0000000000..36650b8dbc --- /dev/null +++ b/ext/spice/src/csupport/podbgi.c @@ -0,0 +1,199 @@ +/* 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 new file mode 100644 index 0000000000..bea85238a9 --- /dev/null +++ b/ext/spice/src/csupport/podcgc.c @@ -0,0 +1,243 @@ +/* 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 new file mode 100644 index 0000000000..63960952b2 --- /dev/null +++ b/ext/spice/src/csupport/podcgd.c @@ -0,0 +1,238 @@ +/* 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 new file mode 100644 index 0000000000..0b78a6418e --- /dev/null +++ b/ext/spice/src/csupport/podcgi.c @@ -0,0 +1,239 @@ +/* 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 new file mode 100644 index 0000000000..0416cb19f3 --- /dev/null +++ b/ext/spice/src/csupport/poddgc.c @@ -0,0 +1,198 @@ +/* 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 new file mode 100644 index 0000000000..30d15cea52 --- /dev/null +++ b/ext/spice/src/csupport/poddgd.c @@ -0,0 +1,198 @@ +/* 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 new file mode 100644 index 0000000000..7b1c9d44ff --- /dev/null +++ b/ext/spice/src/csupport/poddgi.c @@ -0,0 +1,197 @@ +/* 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 new file mode 100644 index 0000000000..7ffd9f3bea --- /dev/null +++ b/ext/spice/src/csupport/podegc.c @@ -0,0 +1,241 @@ +/* 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 new file mode 100644 index 0000000000..c09285f63a --- /dev/null +++ b/ext/spice/src/csupport/podegd.c @@ -0,0 +1,237 @@ +/* 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 new file mode 100644 index 0000000000..eeac1a3336 --- /dev/null +++ b/ext/spice/src/csupport/podegi.c @@ -0,0 +1,238 @@ +/* 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 new file mode 100644 index 0000000000..ba2099cfc1 --- /dev/null +++ b/ext/spice/src/csupport/podiec.c @@ -0,0 +1,220 @@ +/* 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 new file mode 100644 index 0000000000..15c261b212 --- /dev/null +++ b/ext/spice/src/csupport/podied.c @@ -0,0 +1,220 @@ +/* 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 new file mode 100644 index 0000000000..732adf3b9d --- /dev/null +++ b/ext/spice/src/csupport/podiei.c @@ -0,0 +1,219 @@ +/* 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 new file mode 100644 index 0000000000..b306092547 --- /dev/null +++ b/ext/spice/src/csupport/podonc.c @@ -0,0 +1,177 @@ +/* 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 new file mode 100644 index 0000000000..de3d8e2925 --- /dev/null +++ b/ext/spice/src/csupport/podond.c @@ -0,0 +1,177 @@ +/* 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 new file mode 100644 index 0000000000..e78d06f50b --- /dev/null +++ b/ext/spice/src/csupport/podoni.c @@ -0,0 +1,176 @@ +/* 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 new file mode 100644 index 0000000000..c58e93c627 --- /dev/null +++ b/ext/spice/src/csupport/podrec.c @@ -0,0 +1,213 @@ +/* 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 new file mode 100644 index 0000000000..b175a37f50 --- /dev/null +++ b/ext/spice/src/csupport/podred.c @@ -0,0 +1,212 @@ +/* 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 new file mode 100644 index 0000000000..312e73f3d4 --- /dev/null +++ b/ext/spice/src/csupport/podrei.c @@ -0,0 +1,211 @@ +/* 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 new file mode 100644 index 0000000000..b80dac72eb --- /dev/null +++ b/ext/spice/src/csupport/podrgc.c @@ -0,0 +1,244 @@ +/* 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 new file mode 100644 index 0000000000..27e2e13dfd --- /dev/null +++ b/ext/spice/src/csupport/podrgd.c @@ -0,0 +1,240 @@ +/* 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 new file mode 100644 index 0000000000..222b57c4fc --- /dev/null +++ b/ext/spice/src/csupport/podrgi.c @@ -0,0 +1,239 @@ +/* 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 new file mode 100644 index 0000000000..6e7ce75d2c --- /dev/null +++ b/ext/spice/src/csupport/prcomf.c @@ -0,0 +1,868 @@ +/* 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 new file mode 100644 index 0000000000..2f116b81dd --- /dev/null +++ b/ext/spice/src/csupport/prepsn.c @@ -0,0 +1,316 @@ +/* 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 new file mode 100644 index 0000000000..539f5f15cb --- /dev/null +++ b/ext/spice/src/csupport/prtrap.c @@ -0,0 +1,208 @@ +/* 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 new file mode 100644 index 0000000000..e328d27448 --- /dev/null +++ b/ext/spice/src/csupport/pstack.c @@ -0,0 +1,1092 @@ +/* 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 new file mode 100644 index 0000000000..afcd510c22 --- /dev/null +++ b/ext/spice/src/csupport/qlstnb.c @@ -0,0 +1,247 @@ +/* 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 new file mode 100644 index 0000000000..21955a4c20 --- /dev/null +++ b/ext/spice/src/csupport/qmini.c @@ -0,0 +1,343 @@ +/* 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 new file mode 100644 index 0000000000..34b6dbdf46 --- /dev/null +++ b/ext/spice/src/csupport/qrtrim.c @@ -0,0 +1,272 @@ +/* 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 new file mode 100644 index 0000000000..4eaafc17eb --- /dev/null +++ b/ext/spice/src/csupport/qtran.c @@ -0,0 +1,203 @@ +/* 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 new file mode 100644 index 0000000000..8e62eb9f74 --- /dev/null +++ b/ext/spice/src/csupport/rdstmn.c @@ -0,0 +1,151 @@ +/* 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 new file mode 100644 index 0000000000..077db31fcf --- /dev/null +++ b/ext/spice/src/csupport/rdstmt.c @@ -0,0 +1,153 @@ +/* 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 new file mode 100644 index 0000000000..7141ed62c9 --- /dev/null +++ b/ext/spice/src/csupport/ressym.c @@ -0,0 +1,150 @@ +/* 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 new file mode 100644 index 0000000000..b527e5d4ab --- /dev/null +++ b/ext/spice/src/csupport/rptsym.c @@ -0,0 +1,132 @@ +/* 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 new file mode 100644 index 0000000000..2a5553f458 --- /dev/null +++ b/ext/spice/src/csupport/sbget_1.c @@ -0,0 +1,184 @@ +/* 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 new file mode 100644 index 0000000000..a8b9dc861b --- /dev/null +++ b/ext/spice/src/csupport/sbinit_1.c @@ -0,0 +1,212 @@ +/* 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 new file mode 100644 index 0000000000..870a7862c2 --- /dev/null +++ b/ext/spice/src/csupport/sbrem_1.c @@ -0,0 +1,187 @@ +/* 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 new file mode 100644 index 0000000000..f687ce3326 --- /dev/null +++ b/ext/spice/src/csupport/sbset_1.c @@ -0,0 +1,226 @@ +/* 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 new file mode 100644 index 0000000000..289d44585a --- /dev/null +++ b/ext/spice/src/csupport/scansl.c @@ -0,0 +1,193 @@ +/* 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 new file mode 100644 index 0000000000..f4ce14324b --- /dev/null +++ b/ext/spice/src/csupport/shosym.c @@ -0,0 +1,186 @@ +/* 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 new file mode 100644 index 0000000000..360d8d0118 --- /dev/null +++ b/ext/spice/src/csupport/signal1.h @@ -0,0 +1,118 @@ +/* + +-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 new file mode 100644 index 0000000000..c5feed3ec1 --- /dev/null +++ b/ext/spice/src/csupport/sizecb_1.c @@ -0,0 +1,162 @@ +/* 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 new file mode 100644 index 0000000000..a55bb0d1b7 --- /dev/null +++ b/ext/spice/src/csupport/spcacb.c @@ -0,0 +1,446 @@ +/* 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 new file mode 100644 index 0000000000..05f8c6d908 --- /dev/null +++ b/ext/spice/src/csupport/stran.c @@ -0,0 +1,714 @@ +/* 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 new file mode 100644 index 0000000000..8cdc8bef08 --- /dev/null +++ b/ext/spice/src/csupport/syptrc.c @@ -0,0 +1,216 @@ +/* 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 new file mode 100644 index 0000000000..2ab1cfbb88 --- /dev/null +++ b/ext/spice/src/csupport/syptri.c @@ -0,0 +1,202 @@ +/* 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 new file mode 100644 index 0000000000..d716e8c251 --- /dev/null +++ b/ext/spice/src/csupport/tabrpt.c @@ -0,0 +1,882 @@ +/* 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 new file mode 100644 index 0000000000..710cf0ebe3 --- /dev/null +++ b/ext/spice/src/csupport/trnlat.c @@ -0,0 +1,374 @@ +/* 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 new file mode 100644 index 0000000000..873c3f484e --- /dev/null +++ b/ext/spice/src/csupport/txtops.c @@ -0,0 +1,274 @@ +/* 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 new file mode 100644 index 0000000000..8ee99b0007 --- /dev/null +++ b/ext/spice/src/csupport/unitp.c @@ -0,0 +1,394 @@ +/* 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 new file mode 100644 index 0000000000..c955b4bb58 --- /dev/null +++ b/ext/spice/src/csupport/upto.c @@ -0,0 +1,211 @@ +/* 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 new file mode 100644 index 0000000000..db8168c6ba --- /dev/null +++ b/ext/spice/src/csupport/utrans_2.c @@ -0,0 +1,356 @@ +/* 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 new file mode 100644 index 0000000000..572268c8eb --- /dev/null +++ b/ext/spice/src/csupport/zzalloc.h @@ -0,0 +1,125 @@ +/* + +-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 new file mode 100644 index 0000000000..cddd8a5318 --- /dev/null +++ b/ext/spice/src/csupport/zzckcvr2.c @@ -0,0 +1,219 @@ +/* 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 new file mode 100644 index 0000000000..73c8e16bb1 --- /dev/null +++ b/ext/spice/src/csupport/zzckcvr3.c @@ -0,0 +1,325 @@ +/* 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 new file mode 100644 index 0000000000..d791d974a5 --- /dev/null +++ b/ext/spice/src/csupport/zzckcvr4.c @@ -0,0 +1,349 @@ +/* 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 new file mode 100644 index 0000000000..fedd90384c --- /dev/null +++ b/ext/spice/src/csupport/zzckcvr5.c @@ -0,0 +1,403 @@ +/* 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 new file mode 100644 index 0000000000..5709c667d5 --- /dev/null +++ b/ext/spice/src/csupport/zzerror.h @@ -0,0 +1,80 @@ +/* + +-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 new file mode 100644 index 0000000000..2841f8b063 --- /dev/null +++ b/ext/spice/src/csupport/zzgetenv.c @@ -0,0 +1,332 @@ +/* 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 new file mode 100644 index 0000000000..2284c613ea --- /dev/null +++ b/ext/spice/src/csupport/zzgetfat.c @@ -0,0 +1,752 @@ +/* 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 new file mode 100644 index 0000000000..46fd9e1993 --- /dev/null +++ b/ext/spice/src/csupport/zznsppok.c @@ -0,0 +1,159 @@ +/* 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 new file mode 100644 index 0000000000..b8e764d010 --- /dev/null +++ b/ext/spice/src/csupport/zztxtopn.c @@ -0,0 +1,290 @@ +/* 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_ */ + diff --git a/modules/common/common.xml b/modules/common/common.xml new file mode 100644 index 0000000000..4be50769af --- /dev/null +++ b/modules/common/common.xml @@ -0,0 +1,24 @@ + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/modules/common/shaders/powerscale_fs.glsl b/modules/common/shaders/powerscale_fs.glsl new file mode 100644 index 0000000000..e5f4e43deb --- /dev/null +++ b/modules/common/shaders/powerscale_fs.glsl @@ -0,0 +1,107 @@ +/** +Copyright (C) 2012-2014 Jonas Strandstedt + +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. +*/ +#version 150 + +uniform mat4 ViewProjection; +uniform mat4 ModelTransform; +uniform vec4 campos; +uniform vec4 objpos; +uniform float time; +uniform sampler2D texture1; +uniform sampler2D texture2; +uniform sampler2D texture3; +uniform float TessLevel; +uniform bool Wireframe; +uniform bool Lightsource; +uniform bool UseTexture; + +in vec2 vs_st; +in vec3 vs_stp; +in vec4 vs_normal; +in vec4 vs_color; +in vec4 vs_position; + +out vec4 diffuse; + +const float k = 10.0; + +vec4 psc_normlization(vec4 invec) { + + float xymax = max(invec.x,invec.y); + + if(invec.z > 0.0f || invec.z < 0.0f) { + return invec / abs(invec.z); + } else if (xymax != 0.0f) { + return invec / xymax; + } else { + return invec / -.0; + } +} + +void main() +{ + + // Observable universe is 10^27m, setting the far value to extremely high, aka 30!! ERMAHGERD! + float s_far = 27.0; //= gl_DepthRange.far; // 40 + float s_farcutoff = 12.0; + float s_nearcutoff = 7.0; + float s_near = 0.0f;// gl_DepthRange.near; // 0.1 + float depth; + + // the value can be normalized to 1 + vec4 p = vs_position; + if(vs_position.w <= 0.5) { + //depth = abs(vs_position.z * pow(10, vs_position.w)) / pow(k,s_far); + depth = (vs_position.w+log(abs(vs_position.z)))/pow(k, vs_position.w); + } else if(vs_position.w < 3.0) { + depth = vs_position.w+log(abs(vs_position.z))/pow(k, vs_position.w); + } else { + depth = vs_position.w+log(abs(vs_position.z)); + } + + // DEBUG + float depth_orig = depth; + float x = 0.0f; + float cutoffs = 0.0; + float orig_z = vs_position.z; + + // calculate a normalized depth [0.0 1.0] + if((depth > s_near && depth <= s_nearcutoff) || (depth > s_farcutoff && depth < s_far)) { + + // completely linear interpolation [s_near .. depth .. s_far] + depth = (depth - s_near) / (s_far - s_near); + + } else if(depth > s_nearcutoff && depth < s_farcutoff) { + + // DEBUG + cutoffs = 1.0; + + // interpolate [10^s_nearcutoff .. 10^depth .. 10^s_farcutoff] + // calculate between 0..1 where the depth is + x = (pow(10,depth) - pow(10, s_nearcutoff)) / (pow(10,s_farcutoff) - pow(10, s_nearcutoff)); + + // remap the depth to the 0..1 depth buffer + depth = s_nearcutoff + x * (s_farcutoff - s_nearcutoff); + depth = (depth - s_near) / (s_far - s_near); + + } else { + // where am I? + // do I need to be discarded? + //discard; + } + + + // set the depth + gl_FragDepth = depth; + + // color + diffuse = texture2D(texture1, vs_st); + //diffuse = vec4(1.0,0.0,0.0,1.0); +} \ No newline at end of file diff --git a/modules/common/shaders/powerscale_vs.glsl b/modules/common/shaders/powerscale_vs.glsl new file mode 100644 index 0000000000..4bf86969b3 --- /dev/null +++ b/modules/common/shaders/powerscale_vs.glsl @@ -0,0 +1,100 @@ +/** +Copyright (C) 2012-2014 Jonas Strandstedt + +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. +*/ +#version 150 + +uniform mat4 ViewProjection; +uniform mat4 ModelTransform; +uniform vec4 campos; +uniform mat4 camrot; +uniform vec2 scaling; +uniform vec4 objpos; +uniform float time; +uniform sampler2D texture1; +uniform sampler2D texture2; +uniform sampler2D texture3; +uniform float TessLevel; +uniform bool Wireframe; +uniform bool Lightsource; +uniform bool UseTexture; + +in vec3 in_position; +in vec2 in_st; +in vec3 in_normal; +in vec4 in_color; +in vec3 in_attribute3f; +in float in_attribute1f; + +out vec2 vs_st; +out vec3 vs_stp; +out vec4 vs_normal; +out vec4 vs_color; +out vec4 vs_position; + +const float k = 10.0; +const float dgr_to_rad = 0.0174532925; + +vec4 psc_addition(vec4 v1, vec4 v2) { + float ds = v2.w - v1.w; + if(ds >= 0) { + float p = pow(k,-ds); + return vec4(v1.x*p + v2.x, v1.y*p + v2.y, v1.z*p + v2.z, v2.w); + } else { + float p = pow(k,ds); + return vec4(v1.x + v2.x*p, v1.y + v2.y*p, v1.z + v2.z*p, v1.w); + } +} + +vec4 psc_to_meter(vec4 v1, vec2 v2) { + return vec4(v1.xyz * v2.x * pow(k,v2.y + v1.w), 1.0); +} + +vec4 psc_scaling(vec4 v1, vec2 v2) { + float ds = v2.y - v1.w; + if(ds >= 0) { + return vec4(v1.xyz * v2.x * pow(k,v1.w), v2.y); + } else { + return vec4(v1.xyz * v2.x * pow(k,v2.y), v1.w); + } +} + +void main() +{ + // set variables + vs_st = in_st; + vs_stp = in_position; + vs_normal = normalize(ModelTransform * vec4(in_normal,1)); + vs_color = in_color; + + // fetch model and view translation + vec4 vertex_translate = ModelTransform[3]; + + // rotate and scale vertex with model transform and add the translation + vec3 local_vertex_pos = mat3(ModelTransform) * in_position + vertex_translate.xyz; + + // PSC addition; local vertex position and the object power scaled world position + vs_position = psc_addition(vec4(local_vertex_pos,0),objpos); + + // PSC addition; rotated and viewscaled vertex and the cmaeras negative position + vs_position = psc_addition(vs_position,vec4(-campos.xyz,campos.w)); + + // rotate the camera + vs_position = camrot * vs_position; + + // rescales the scene to fit inside the view frustum + // is set from the main program, but these are decent values + //vec2 scaling = vec2(1.0, -8.0); + + // project using the rescaled coordinates, + //vec4 vs_position_rescaled = psc_scaling(vs_position, scaling); + vec4 vs_position_rescaled = psc_to_meter(vs_position, scaling); + + // project the position to view space + gl_Position = ViewProjection * vs_position_rescaled; +} \ No newline at end of file diff --git a/modules/common/shaders/pscstandard_fs.glsl b/modules/common/shaders/pscstandard_fs.glsl new file mode 100644 index 0000000000..345af2a123 --- /dev/null +++ b/modules/common/shaders/pscstandard_fs.glsl @@ -0,0 +1,106 @@ +/** +Copyright (C) 2012-2014 Jonas Strandstedt + +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. +*/ +#version 150 + +uniform mat4 ViewProjection; +uniform mat4 ModelTransform; +uniform vec4 campos; +uniform vec4 objpos; +uniform float time; +uniform sampler2D texture1; +uniform sampler2D texture2; +uniform sampler2D texture3; +uniform float TessLevel; +uniform bool Wireframe; +uniform bool Lightsource; +uniform bool UseTexture; + +in vec2 vs_st; +in vec3 vs_stp; +in vec4 vs_normal; +in vec4 vs_position; + +out vec4 diffuse; + +const float k = 10.0; + +vec4 psc_normlization(vec4 invec) { + + float xymax = max(invec.x,invec.y); + + if(invec.z > 0.0f || invec.z < 0.0f) { + return invec / abs(invec.z); + } else if (xymax != 0.0f) { + return invec / xymax; + } else { + return invec / -.0; + } +} + +void main() +{ + + // Observable universe is 10^27m, setting the far value to extremely high, aka 30!! ERMAHGERD! + float s_far = 27.0; //= gl_DepthRange.far; // 40 + float s_farcutoff = 12.0; + float s_nearcutoff = 7.0; + float s_near = 0.0f;// gl_DepthRange.near; // 0.1 + float depth; + + // the value can be normalized to 1 + vec4 p = vs_position; + if(vs_position.w <= 0.5) { + //depth = abs(vs_position.z * pow(10, vs_position.w)) / pow(k,s_far); + depth = (vs_position.w+log(abs(vs_position.z)))/pow(k, vs_position.w); + } else if(vs_position.w < 3.0) { + depth = vs_position.w+log(abs(vs_position.z))/pow(k, vs_position.w); + } else { + depth = vs_position.w+log(abs(vs_position.z)); + } + + // DEBUG + float depth_orig = depth; + float x = 0.0f; + float cutoffs = 0.0; + float orig_z = vs_position.z; + + // calculate a normalized depth [0.0 1.0] + if((depth > s_near && depth <= s_nearcutoff) || (depth > s_farcutoff && depth < s_far)) { + + // completely linear interpolation [s_near .. depth .. s_far] + depth = (depth - s_near) / (s_far - s_near); + + } else if(depth > s_nearcutoff && depth < s_farcutoff) { + + // DEBUG + cutoffs = 1.0; + + // interpolate [10^s_nearcutoff .. 10^depth .. 10^s_farcutoff] + // calculate between 0..1 where the depth is + x = (pow(10,depth) - pow(10, s_nearcutoff)) / (pow(10,s_farcutoff) - pow(10, s_nearcutoff)); + + // remap the depth to the 0..1 depth buffer + depth = s_nearcutoff + x * (s_farcutoff - s_nearcutoff); + depth = (depth - s_near) / (s_far - s_near); + + } else { + // where am I? + // do I need to be discarded? + //discard; + } + + + // set the depth + gl_FragDepth = depth; + + // color + diffuse = texture2D(texture1, vs_st); + //diffuse = vec4(1.0,0.0,0.0,1.0); +} \ No newline at end of file diff --git a/modules/common/shaders/pscstandard_vs.glsl b/modules/common/shaders/pscstandard_vs.glsl new file mode 100644 index 0000000000..32ade96aba --- /dev/null +++ b/modules/common/shaders/pscstandard_vs.glsl @@ -0,0 +1,95 @@ +/** +Copyright (C) 2012-2014 Jonas Strandstedt + +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. +*/ +#version 150 + +uniform mat4 ViewProjection; +uniform mat4 ModelTransform; +uniform vec4 campos; +uniform mat4 camrot; +uniform vec2 scaling; +uniform vec4 objpos; +uniform float time; +uniform sampler2D texture1; +uniform sampler2D texture2; +uniform sampler2D texture3; +uniform float TessLevel; +uniform bool Wireframe; +uniform bool Lightsource; +uniform bool UseTexture; + +in vec4 in_position; +in vec2 in_st; +in vec3 in_normal; + +out vec2 vs_st; +out vec3 vs_stp; +out vec4 vs_normal; +out vec4 vs_position; + +const float k = 10.0; +const float dgr_to_rad = 0.0174532925; + +vec4 psc_addition(vec4 v1, vec4 v2) { + float ds = v2.w - v1.w; + if(ds >= 0) { + float p = pow(k,-ds); + return vec4(v1.x*p + v2.x, v1.y*p + v2.y, v1.z*p + v2.z, v2.w); + } else { + float p = pow(k,ds); + return vec4(v1.x + v2.x*p, v1.y + v2.y*p, v1.z + v2.z*p, v1.w); + } +} + +vec4 psc_to_meter(vec4 v1, vec2 v2) { + return vec4(v1.xyz * v2.x * pow(k,v2.y + v1.w), 1.0); +} + +vec4 psc_scaling(vec4 v1, vec2 v2) { + float ds = v2.y - v1.w; + if(ds >= 0) { + return vec4(v1.xyz * v2.x * pow(k,v1.w), v2.y); + } else { + return vec4(v1.xyz * v2.x * pow(k,v2.y), v1.w); + } +} + +void main() +{ + // set variables + vs_st = in_st; + vs_stp = in_position.xyz; + vs_normal = normalize(ModelTransform * vec4(in_normal,1)); + + // fetch model and view translation + vec4 vertex_translate = ModelTransform[3]; + + // rotate and scale vertex with model transform and add the translation + vec3 local_vertex_pos = mat3(ModelTransform) * in_position.xyz + vertex_translate.xyz; + + // PSC addition; local vertex position and the object power scaled world position + vs_position = psc_addition(vec4(local_vertex_pos,in_position.w),objpos); + + // PSC addition; rotated and viewscaled vertex and the cmaeras negative position + vs_position = psc_addition(vs_position,vec4(-campos.xyz,campos.w)); + + // rotate the camera + vs_position = camrot * vs_position; + + // rescales the scene to fit inside the view frustum + // is set from the main program, but these are decent values + //vec2 scaling = vec2(1.0, -8.0); + + // project using the rescaled coordinates, + //vec4 vs_position_rescaled = psc_scaling(vs_position, scaling); + vec4 vs_position_rescaled = psc_to_meter(vs_position, scaling); + + // project the position to view space + gl_Position = ViewProjection * vs_position_rescaled; +} \ No newline at end of file diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt new file mode 100644 index 0000000000..c643fe3dea --- /dev/null +++ b/src/CMakeLists.txt @@ -0,0 +1,58 @@ +######################################################################################### +# # +# OpenSpace # +# # +# Copyright (c) 2014 # +# # +# 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. # +######################################################################################### + + +#set(EXECUTABLE_OUTPUT_PATH ${PROJECT_BINARY_DIR}/bin) + +set(SOURCE_ROOT_DIR ${CMAKE_CURRENT_SOURCE_DIR}) +set(HEADER_ROOT_DIR ${CMAKE_CURRENT_SOURCE_DIR}) + +file(GLOB MAIN_SOURCE ${SOURCE_ROOT_DIR}/*.cpp) +set(OPENSPACE_SOURCE ${OPENSPACE_SOURCE} ${MAIN_SOURCE}) +file(GLOB MAIN_HEADER ${SOURCE_ROOT_DIR}/*.h) +set(OPENSPACE_HEADER ${OPENSPACE_HEADER} ${MAIN_HEADER}) +source_group(Main FILES ${MAIN_SOURCE} ${MAIN_HEADER}) + +file(GLOB EXTERNALCONTROL_SOURCE ${SOURCE_ROOT_DIR}/externalcontrol/*.cpp) +set(OPENSPACE_SOURCE ${OPENSPACE_SOURCE} ${EXTERNALCONTROL_SOURCE}) +file(GLOB EXTERNALCONTROL_HEADER ${HEADER_ROOT_DIR}/externalcontrol/*.h) +set(OPENSPACE_HEADER ${OPENSPACE_HEADER} ${EXTERNALCONTROL_HEADER}) +source_group(ExternalControl FILES ${EXTERNALCONTROL_SOURCE} ${EXTERNALCONTROL_HEADER}) + +file(GLOB SCENEGRAPH_SOURCE ${SOURCE_ROOT_DIR}/scenegraph/*.cpp) +set(OPENSPACE_SOURCE ${OPENSPACE_SOURCE} ${SCENEGRAPH_SOURCE}) +file(GLOB SCENEGRAPH_HEADER ${HEADER_ROOT_DIR}/scenegraph/*.h) +set(OPENSPACE_HEADER ${OPENSPACE_HEADER} ${SCENEGRAPH_HEADER}) +source_group(ExternalControl FILES ${SCENEGRAPH_SOURCE} ${SCENEGRAPH_HEADER}) + +file(GLOB UTIL_SOURCE ${SOURCE_ROOT_DIR}/util/*.cpp) +set(OPENSPACE_SOURCE ${OPENSPACE_SOURCE} ${UTIL_SOURCE}) +file(GLOB UTIL_HEADER ${HEADER_ROOT_DIR}/util/*.h) +set(OPENSPACE_HEADER ${OPENSPACE_HEADER} ${UTIL_HEADER}) +source_group(Util FILES ${UTIL_SOURCE} ${UTIL_HEADER}) + +include_directories(${HEADER_ROOT_DIR}) + +add_executable(OpenSpace ${OPENSPACE_HEADER} ${OPENSPACE_SOURCE}) +target_link_libraries(OpenSpace ${DEPENDENT_LIBS}) diff --git a/src/camera.cpp b/src/camera.cpp new file mode 100644 index 0000000000..c95b2b5180 --- /dev/null +++ b/src/camera.cpp @@ -0,0 +1,97 @@ + +// open space includes +#include "camera.h" + +// sgct includes +#include "sgct.h" + +namespace openspace { + +Camera::Camera() { + //glm::vec3 EulerAngles(90, 45, 0); + scaling_ = glm::vec2(1.0,0.0); + glm::vec3 EulerAngles(0, 0, 0); + viewRotation_ = glm::quat(EulerAngles); + //printf("Camera: [%f, %f, %f, %f]\n", viewRotation_[0], viewRotation_[1], viewRotation_[2], viewRotation_[3]); +} + +Camera::~Camera() { + +} + +void Camera::setPosition(psc pos) { + position_ = pos; +} + +const psc& Camera::getPosition() const { + return position_; +} + + +void Camera::setViewProjectionMatrix(const glm::mat4 &viewProjectionMatrix) { + viewProjectionMatrix_ = viewProjectionMatrix; +} + +void Camera::setCameraDirection(const glm::vec3 &cameraDirection) { + cameraDirection_ = cameraDirection; +} + +const glm::mat4 & Camera::getViewProjectionMatrix() const { + return viewProjectionMatrix_; +} + +const glm::mat4 & Camera::getViewRotationMatrix() const { + return viewRotationMatrix_; +} + +void Camera::compileViewRotationMatrix() { + // convert from quaternion to rotationmatrix using glm + viewRotationMatrix_ = glm::mat4_cast(viewRotation_); + + // the camera matrix needs to be rotated inverse to the world + glm::mat4 camrotmatrix = glm::mat4_cast(glm::inverse(viewRotation_)); + glm::vec4 camdir(cameraDirection_[0],cameraDirection_[1],cameraDirection_[2],0); + camdir = camrotmatrix* camdir; + viewDirection_ = glm::normalize(glm::vec3(camdir[0],camdir[1],camdir[2])); +} + +void Camera::rotate(glm::quat rotation) { + viewRotation_ = rotation * viewRotation_; + viewRotation_ = glm::normalize(viewRotation_); +} + +void Camera::setRotation(glm::quat rotation) { + viewRotation_ = glm::normalize(rotation); +} + +const glm::quat & Camera::getRotation() const { + return viewRotation_; +} + +const glm::vec3 & Camera::getViewDirection() const { + return viewDirection_; +} + + +const float & Camera::getMaxFov() const { + return maxFov_; +} + +const float & Camera::getSinMaxFov() const { + return sinMaxFov_; +} + +void Camera::setMaxFov(const float &fov) { + maxFov_ = fov; + sinMaxFov_ = sin(maxFov_); +} + +void Camera::setScaling(const glm::vec2 &scaling) { + scaling_ = scaling; +} + +const glm::vec2 & Camera::getScaling() const { + return scaling_; +} + +} // namespace openspace \ No newline at end of file diff --git a/src/camera.h b/src/camera.h new file mode 100644 index 0000000000..13681009c7 --- /dev/null +++ b/src/camera.h @@ -0,0 +1,59 @@ +#ifndef CAMERA_H +#define CAMERA_H + +// open space includes +#include "object.h" +#include "util/psc.h" + +// glm includes +#include +#include +#include +#include + +namespace openspace { + +class Camera: public Object { +public: + + // constructors & destructor + Camera(); + ~Camera(); + + void setPosition(psc pos); + const psc& getPosition() const; + + void setViewProjectionMatrix(const glm::mat4 &viewProjectionMatrix); + void setCameraDirection(const glm::vec3 &cameraDirection); + + const glm::mat4 & getViewProjectionMatrix() const; + const glm::mat4 & getViewRotationMatrix() const; + void compileViewRotationMatrix(); + + void rotate(glm::quat rotation); + void setRotation(glm::quat rotation); + const glm::quat & getRotation() const; + + const glm::vec3 & getViewDirection() const; + const float & getMaxFov() const; + const float & getSinMaxFov() const; + void setMaxFov(const float &fov); + void setScaling(const glm::vec2 &scaling); + const glm::vec2 & getScaling() const; + +private: + float maxFov_; + float sinMaxFov_; + psc position_; + glm::mat4 viewProjectionMatrix_; + glm::vec3 viewDirection_; + glm::vec3 cameraDirection_; + glm::vec2 scaling_; + + glm::quat viewRotation_; + glm::mat4 viewRotationMatrix_; // compiled from the quaternion +}; + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/deviceidentifier.cpp b/src/deviceidentifier.cpp new file mode 100644 index 0000000000..ecac780d05 --- /dev/null +++ b/src/deviceidentifier.cpp @@ -0,0 +1,157 @@ + +// open space includes +#include "deviceIdentifier.h" + +// sgct includes +#include "sgct.h" + +namespace openspace { + + +DeviceIdentifier* DeviceIdentifier::this_ = nullptr; + +DeviceIdentifier::DeviceIdentifier() { + + // scan for devices on init + devices_ = 0; + for(int i = 0; i < MAXDEVICES; ++i) { + inputDevice_[i] = InputDevice::NONE; + } +} + +DeviceIdentifier::~DeviceIdentifier() { + + // deallocates memory on exit + for(int i = 0; i < MAXDEVICES; ++i) { + if(inputDevice_[i] != InputDevice::NONE) { + delete axesPos_[i]; + delete buttons_[i]; + } + } +} + +void DeviceIdentifier::init() { + assert( ! this_); + this_ = new DeviceIdentifier(); +} + +void DeviceIdentifier::deinit() { + assert(this_); + delete this_; + this_ = nullptr; +} + +DeviceIdentifier& DeviceIdentifier::ref() { + assert(this_); + return *this_; +} + +bool DeviceIdentifier::isInitialized() { + return this_ != nullptr; +} + +void DeviceIdentifier::scanDevices() { + assert(this_); + + // sgct/glfw supports 16 joysticks, scans all of them + for (int i = 0; i < MAXDEVICES; ++i) + { + // check for device on position i + const char* joystickName = sgct::Engine::getJoystickName(SGCT_JOYSTICK_1 + i); + + // int joystickPresent = sgct::Engine::getJoystickParam( GLFW_JOYSTICK_1 + i, GLFW_PRESENT ); + //numberOfAxes_[i] = sgct::Engine::getJoystickParam( GLFW_JOYSTICK_1 + i, GLFW_AXES ); + //numberOfButtons_[i] = sgct::Engine::getJoystickParam( GLFW_JOYSTICK_1 + i, GLFW_BUTTONS ); + + // joystick found + if( joystickName != NULL ) { + sgct::Engine::getJoystickAxes(SGCT_JOYSTICK_1 + i, &numberOfAxes_[i]); + sgct::Engine::getJoystickButtons(SGCT_JOYSTICK_1 + i, &numberOfButtons_[i]); + + + + // allocate + axesPos_[i] = new float[numberOfAxes_[i]]; + buttons_[i] = new unsigned char[numberOfButtons_[i]]; + + // increment the device count + ++devices_; + + // identify what device it is + if(numberOfAxes_[i] == 6 && numberOfButtons_[i] == 10) { + printf("XBOX controller "); + inputDevice_[i] = InputDevice::XBOX; + } else if(numberOfAxes_[i] == 6 && numberOfButtons_[i] == 4) { + printf("SPACENAVIGATOR "); + inputDevice_[i] = InputDevice::SPACENAVIGATOR; + } else { + printf("UNKNOWN device "); + inputDevice_[i] = InputDevice::UNKNOWN; + } + printf("found at position %i, b=%i, a=%i\n", i, numberOfButtons_[i], numberOfAxes_[i]); + + + } else { + inputDevice_[i] = InputDevice::NONE; + } + + } +} + +const int DeviceIdentifier::numberOfDevices() const { + assert(this_); + return devices_; +} + +const InputDevice DeviceIdentifier::type(const int device) const { + assert(this_); + return inputDevice_[device]; +} + +void DeviceIdentifier::update() { + assert(this_); + for(int i = 0; i < devices_; ++i) { + update(i); + } +} + +void DeviceIdentifier::update(const int device) { + assert(this_); + if(inputDevice_[device] != InputDevice::NONE) { + const float* axesPos = sgct::Engine::getJoystickAxes(GLFW_JOYSTICK_1+device, &(numberOfAxes_[device]) ); + + //axesPos_[device] + const unsigned char* buttons = sgct::Engine::getJoystickButtons( GLFW_JOYSTICK_1+device, &(numberOfButtons_[device]) ); + //buttons_[device] + } +} + +const int DeviceIdentifier::getButtons(const int device, unsigned char **buttons) const { + assert(this_); + if(inputDevice_[device] != InputDevice::NONE) { + if(buttons) + *buttons = buttons_[device]; + return numberOfButtons_[device]; + } + return 0; +} + +const int DeviceIdentifier::getAxes(const int device, float **axespos) const { + assert(this_); + if(inputDevice_[device] != InputDevice::NONE) { + if(axespos) + *axespos = axesPos_[device]; + return numberOfAxes_[device]; + } + return 0; +} + +void DeviceIdentifier::get(const int device, unsigned char **buttons, float **axespos) const { + assert(this_); + if(inputDevice_[device] != InputDevice::NONE) { + *axespos = axesPos_[device]; + *buttons = buttons_[device]; + } +} + +} // namespace openspace \ No newline at end of file diff --git a/src/deviceidentifier.h b/src/deviceidentifier.h new file mode 100644 index 0000000000..b4025844e3 --- /dev/null +++ b/src/deviceidentifier.h @@ -0,0 +1,58 @@ +#ifndef DEVICEIDENTIFIER_H +#define DEVICEIDENTIFIER_H + +// open space includes +#include "object.h" + +// std includes +#include +#include +#include + +namespace openspace { + +#define MAXDEVICES 16 + +enum class InputDevice {NONE, UNKNOWN, SPACENAVIGATOR, XBOX}; + +class DeviceIdentifier: public Object { +public: + static DeviceIdentifier& ref(); + virtual ~DeviceIdentifier(); + + static void init(); + static void deinit(); + static bool isInitialized(); + + void scanDevices(); + const int numberOfDevices() const; + const InputDevice type(const int device) const; + + void update(); + void update(const int device); + + const int getButtons(const int device, unsigned char **buttons = nullptr) const; + const int getAxes(const int device, float **axespos = nullptr) const; + void get(const int device, unsigned char **buttons, float **axespos) const; + +private: + // singleton + static DeviceIdentifier* this_; + DeviceIdentifier(void); + DeviceIdentifier(const DeviceIdentifier& src); + DeviceIdentifier& operator=(const DeviceIdentifier& rhs); + + + // member variables + int devices_; + std::array inputDevice_; + std::array numberOfAxes_; + std::array numberOfButtons_; + std::array axesPos_; + std::array buttons_; + +}; + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/externalcontrol/externalconnectioncontroller.cpp b/src/externalcontrol/externalconnectioncontroller.cpp new file mode 100644 index 0000000000..82fdb6814a --- /dev/null +++ b/src/externalcontrol/externalconnectioncontroller.cpp @@ -0,0 +1,12 @@ +#include "externalcontrol/externalconnectioncontroller.h" + +namespace openspace { + +ExternalConnectionController::ExternalConnectionController() { +} + +ExternalConnectionController::~ExternalConnectionController() { + +} + +} // namespace openspace \ No newline at end of file diff --git a/src/externalcontrol/externalconnectioncontroller.h b/src/externalcontrol/externalconnectioncontroller.h new file mode 100644 index 0000000000..7aba787507 --- /dev/null +++ b/src/externalcontrol/externalconnectioncontroller.h @@ -0,0 +1,24 @@ +#ifndef EXTERNALCONNECTIONCONTROLLER_H +#define EXTERNALCONNECTIONCONTROLLER_H + +#include "externalcontrol/externalcontrol.h" +#include + +namespace openspace { + +class ExternalConnectionController: public ExternalControl { +public: + + // constructors & destructor + ExternalConnectionController(); + ~ExternalConnectionController(); + +private: + + std::vector controllers; + +}; + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/externalcontrol/externalcontrol.cpp b/src/externalcontrol/externalcontrol.cpp new file mode 100644 index 0000000000..d982dd2726 --- /dev/null +++ b/src/externalcontrol/externalcontrol.cpp @@ -0,0 +1,32 @@ +#include "externalcontrol/externalcontrol.h" +#include "interactionhandler.h" +#include + +namespace openspace { + +ExternalControl::ExternalControl() { + +} + +ExternalControl::~ExternalControl() { +} + +void ExternalControl::update() { + +} + +void ExternalControl::rotate(const glm::quat &rotation) { + InteractionHandler::ref().rotate(rotation); +} + +void ExternalControl::orbit(const glm::quat &rotation) { + InteractionHandler::ref().orbit(rotation); +} + +void ExternalControl::distance(const pss &distance) { + InteractionHandler::ref().distance(distance); +} + + +} // namespace openspace + diff --git a/src/externalcontrol/externalcontrol.h b/src/externalcontrol/externalcontrol.h new file mode 100644 index 0000000000..bc4cff8b02 --- /dev/null +++ b/src/externalcontrol/externalcontrol.h @@ -0,0 +1,30 @@ +#ifndef EXTERNALCONTROL_H +#define EXTERNALCONTROL_H + +#include "object.h" +#include "util/pss.h" +#include +#include + +namespace openspace { + +class ExternalControl: public Object { +public: + + // constructors & destructor + ExternalControl(); + ~ExternalControl(); + + virtual void update(); + + void rotate(const glm::quat &rotation); + void orbit(const glm::quat &rotation); + void distance(const pss &distance); + + +protected: +}; + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/externalcontrol/joystickexternalcontrol.cpp b/src/externalcontrol/joystickexternalcontrol.cpp new file mode 100644 index 0000000000..7f2f543d3b --- /dev/null +++ b/src/externalcontrol/joystickexternalcontrol.cpp @@ -0,0 +1,63 @@ +//#include "externalcontrol/joystickexternalcontrol.h" +//#include "deviceidentifier.h" +// +//// workaround since Python debug does not work on windows +//#ifdef _DEBUG +//#undef _DEBUG +//#include +//#define _DEBUG +//#else +//#include +//#endif +// +//namespace openspace { +// +// +//JoystickExternalControl::JoystickExternalControl(const char *filename): PythonExternalControl(filename) { +//} +// +//void JoystickExternalControl::setInputDevice(const int device) { +// if(device >= 0 && device <= 16) { +// inputDevice_ = device; +// numberOfButtons_ = DeviceIdentifier::ref().getButtons(inputDevice_); +// numberOfAxes_ = DeviceIdentifier::ref().getAxes(inputDevice_); +// clear(); +// pyarrSize_ = numberOfButtons_ + numberOfAxes_; +// pyarr_ = new PyObject*[pyarrSize_]; +// } +// +//} +// +//void JoystickExternalControl::update() { +// +// if(inputDevice_ != -1) { +// float *axesPos; +// unsigned char *buttons; +// DeviceIdentifier::ref().getButtons(inputDevice_, &buttons); +// DeviceIdentifier::ref().getAxes(inputDevice_, &axesPos); +// +// // init array +// for(int i = 0; i < numberOfButtons_; ++i){ +// pyarr_[i] = PyLong_FromLong(buttons[i]); +// } +// for(int i = 0; i < numberOfAxes_; ++i){ +// pyarr_[i+numberOfButtons_] = PyFloat_FromDouble(axesPos[i]); +// } +// } +// +// run(); +// +// if(inputDevice_ != -1) { +// // cleanup +// for(int i = 0; i < pyarrSize_; ++i) { +// Py_DECREF(pyarr_[i]); +// } +// } +// +//} +// +//JoystickExternalControl::~JoystickExternalControl() { +//} +// +//} // namespace openspace +// diff --git a/src/externalcontrol/joystickexternalcontrol.cpp.orig b/src/externalcontrol/joystickexternalcontrol.cpp.orig new file mode 100644 index 0000000000..390295e748 --- /dev/null +++ b/src/externalcontrol/joystickexternalcontrol.cpp.orig @@ -0,0 +1,63 @@ +#include "externalcontrol/joystickexternalcontrol.h" +#include "deviceidentifier.h" + +// workaround since Python debug does not work on windows +#ifdef _DEBUG +#undef _DEBUG +#include +#define _DEBUG +#else +#include +#endif + +namespace openspace { + + +JoystickExternalControl::JoystickExternalControl(const char *filename): PythonExternalControl(filename) { +} + +void JoystickExternalControl::setInputDevice(const int device) { + if(device >= 0 && device <= 16) { + inputDevice_ = device; + numberOfButtons_ = DeviceIdentifier::ref().getButtons(inputDevice_); + numberOfAxes_ = DeviceIdentifier::ref().getAxes(inputDevice_); + clear(); + pyarrSize_ = numberOfButtons_ + numberOfAxes_; + pyarr_ = new PyObject*[pyarrSize_]; + } + +} + +void JoystickExternalControl::update() { + + if(inputDevice_ != -1) { + float *axesPos; + unsigned char *buttons; + DeviceIdentifier::ref().getButtons(inputDevice_, &buttons); + DeviceIdentifier::ref().getAxes(inputDevice_, &axesPos); + + // init array + for(int i = 0; i < numberOfButtons_; ++i){ + pyarr_[i] = PyLong_FromLong(buttons[i]); + } + for(int i = 0; i < numberOfAxes_; ++i){ + pyarr_[i+numberOfButtons_] = PyFloat_FromDouble(axesPos[i]); + } + } + + run(); + + if(inputDevice_ != -1) { + // cleanup + //for(int i = 0; i < pyarrSize_; ++i) { + // Py_XDECREF(pyarr_[i]); + //} + } + +} + +JoystickExternalControl::~JoystickExternalControl() { +} + +} // namespace openspace + diff --git a/src/externalcontrol/joystickexternalcontrol.h b/src/externalcontrol/joystickexternalcontrol.h new file mode 100644 index 0000000000..9416c6b202 --- /dev/null +++ b/src/externalcontrol/joystickexternalcontrol.h @@ -0,0 +1,28 @@ +//#ifndef JOYSTICKEXTERNALCONTROL_H +//#define JOYSTICKEXTERNALCONTROL_H +// +//#include "externalcontrol/pythonexternalcontrol.h" +// +//namespace openspace { +// +//class JoystickExternalControl: public PythonExternalControl { +//public: +// +// // constructors & destructor +// JoystickExternalControl(const char *filename); +// ~JoystickExternalControl(); +// +// void setInputDevice(const int device); +// void update(); +// +//private: +// +// // joystick +// int inputDevice_; +// int numberOfButtons_; +// int numberOfAxes_; +//}; +// +//} // namespace openspace +// +//#endif \ No newline at end of file diff --git a/src/externalcontrol/keyboardexternalcontrol.cpp b/src/externalcontrol/keyboardexternalcontrol.cpp new file mode 100644 index 0000000000..9715da5326 --- /dev/null +++ b/src/externalcontrol/keyboardexternalcontrol.cpp @@ -0,0 +1,62 @@ +//#include "externalcontrol/keyboardexternalcontrol.h" +// +//// workaround since Python debug does not work on windows +//#ifdef _DEBUG +//#undef _DEBUG +//#include +//#define _DEBUG +//#else +//#include +//#endif +// +// +//namespace openspace { +// +// +//KeyboardExternalControl::KeyboardExternalControl(const char *filename): PythonExternalControl(filename) { +// clear(); +// pyarrSize_ = 'Z' - 'A' + 80; // all letters, 69 special keys, space and 10 numbers +// pyarr_ = new PyObject*[pyarrSize_]; +// for(int i = 0; i < pyarrSize_; ++i) { +// pyarr_[i] = PyLong_FromLong(0); +// } +//} +// +//void KeyboardExternalControl::keyboardCallback(int key, int action) { +// +// //printf("key: %i\n",key); +// int pos = -1; +// if(key >= '0' && key <= '9') { +// pos = key - '0'; +// Py_XDECREF(pyarr_[pos]); +// pyarr_[pos] = PyLong_FromLong(action); +// } else if(key >= 'A' && key <= 'Z') { +// pos = key - 'A' + 10; +// Py_XDECREF(pyarr_[pos]); +// pyarr_[pos] = PyLong_FromLong(action); +// } else if (key > 256 && key < 256+69) { +// pos = key - 256 + 'Z'-'A' +10; +// Py_XDECREF(pyarr_[pos]); +// pyarr_[pos] = PyLong_FromLong(action); +// } else if (key == 32) { +// pos = 'Z' - 'A' + 11; +// Py_XDECREF(pyarr_[pos]); +// pyarr_[pos] = PyLong_FromLong(action); +// } +// //printf("pos: %i\n",pos); +//} +// +// +// +//void KeyboardExternalControl::update() { +// run(); +//} +// +//KeyboardExternalControl::~KeyboardExternalControl() { +// for(int i = 0; i < pyarrSize_; ++i) { +// Py_XDECREF(pyarr_[i]); +// } +//} +// +//} // namespace openspace +// diff --git a/src/externalcontrol/keyboardexternalcontrol.cpp.orig b/src/externalcontrol/keyboardexternalcontrol.cpp.orig new file mode 100644 index 0000000000..0b90506247 --- /dev/null +++ b/src/externalcontrol/keyboardexternalcontrol.cpp.orig @@ -0,0 +1,62 @@ +#include "externalcontrol/keyboardexternalcontrol.h" + +// workaround since Python debug does not work on windows +#ifdef _DEBUG +#undef _DEBUG +#include +#define _DEBUG +#else +#include +#endif + + +namespace openspace { + + +KeyboardExternalControl::KeyboardExternalControl(const char *filename): PythonExternalControl(filename) { + clear(); + pyarrSize_ = 'Z' - 'A' + 80; // all letters, 69 special keys, space and 10 numbers + pyarr_ = new PyObject*[pyarrSize_]; + for(int i = 0; i < pyarrSize_; ++i) { + pyarr_[i] = PyLong_FromLong(0); + } +} + +void KeyboardExternalControl::keyboardCallback(int key, int action) { + + //printf("key: %i\n",key); + int pos = -1; + if(key >= '0' && key <= '9') { + pos = key - '0'; + //Py_XDECREF(pyarr_[pos]); + pyarr_[pos] = PyLong_FromLong(action); + } else if(key >= 'A' && key <= 'Z') { + pos = key - 'A' + 10; + //Py_XDECREF(pyarr_[pos]); + pyarr_[pos] = PyLong_FromLong(action); + } else if (key > 256 && key < 256+69) { + pos = key - 256 + 'Z'-'A' +10; + //Py_XDECREF(pyarr_[pos]); + pyarr_[pos] = PyLong_FromLong(action); + } else if (key == 32) { + pos = 'Z' - 'A' + 11; + //Py_XDECREF(pyarr_[pos]); + pyarr_[pos] = PyLong_FromLong(action); + } + //printf("pos: %i\n",pos); +} + + + +void KeyboardExternalControl::update() { + run(); +} + +KeyboardExternalControl::~KeyboardExternalControl() { + //for(int i = 0; i < pyarrSize_; ++i) { + // Py_XDECREF(pyarr_[i]); + //} +} + +} // namespace openspace + diff --git a/src/externalcontrol/keyboardexternalcontrol.h b/src/externalcontrol/keyboardexternalcontrol.h new file mode 100644 index 0000000000..6e331e69b8 --- /dev/null +++ b/src/externalcontrol/keyboardexternalcontrol.h @@ -0,0 +1,25 @@ +//#ifndef KEYBOARDEXTERNALCONTROL_H +//#define KEYBOARDEXTERNALCONTROL_H +// +//#include "externalcontrol/pythonexternalcontrol.h" +// +//namespace openspace { +// +//class KeyboardExternalControl: public PythonExternalControl { +//public: +// +// // constructors & destructor +// KeyboardExternalControl(const char *filename); +// ~KeyboardExternalControl(); +// +// void update(); +// +// void keyboardCallback(int key, int action); +//private: +// int *keys_; +// +//}; +// +//} // namespace openspace +// +//#endif \ No newline at end of file diff --git a/src/externalcontrol/mouseexternalcontrol.cpp b/src/externalcontrol/mouseexternalcontrol.cpp new file mode 100644 index 0000000000..d9da0d00dc --- /dev/null +++ b/src/externalcontrol/mouseexternalcontrol.cpp @@ -0,0 +1,79 @@ +//#include "externalcontrol/mouseexternalcontrol.h" +// +//// workaround since Python debug does not work on windows +//#ifdef _DEBUG +//#undef _DEBUG +//#include +//#define _DEBUG +//#else +//#include +//#endif +// +// +//namespace openspace { +// +// +//MouseExternalControl::MouseExternalControl(const char *filename): PythonExternalControl(filename) { +// clear(); +// pyarrSize_ = 6*2; +// pyarr_ = new PyObject*[pyarrSize_]; +// x_ = 0; +// y_ = 0; +// pos_ = 0; +// button1_ = 0; +// button2_ = 0; +// button3_ = 0; +// for(int i = 0; i < pyarrSize_; ++i) { +// pyarr_[i] = PyLong_FromLong(0);; +// } +// +//} +// +//void MouseExternalControl::mouseButtonCallback(int key, int action) { +// if(key == 0) +// button1_ = action; +// if(key == 1) +// button2_ = action; +// if(key == 2) +// button3_ = action; +//} +// +//void MouseExternalControl::mousePosCallback(int x, int y) { +// x_ = x; +// y_ = y; +//} +// +//void MouseExternalControl::mouseScrollCallback(int pos) { +// pos_ = pos; +//} +// +//void MouseExternalControl::update() { +// +// pyarr_[6] = pyarr_[0]; +// pyarr_[7] = pyarr_[1]; +// pyarr_[8] = pyarr_[2]; +// pyarr_[9] = pyarr_[3]; +// pyarr_[10] = pyarr_[4]; +// pyarr_[11] = pyarr_[5]; +// pyarr_[0] = PyLong_FromLong(button1_); +// pyarr_[1] = PyLong_FromLong(button2_); +// pyarr_[2] = PyLong_FromLong(button3_); +// pyarr_[3] = PyLong_FromLong(pos_); +// pyarr_[4] = PyLong_FromLong(x_); +// pyarr_[5] = PyLong_FromLong(y_); +// +// run(); +// +// // cleanup +// for(int i = pyarrSize_ / 2; i < pyarrSize_; ++i) { +// Py_XDECREF(pyarr_[i]); +// } +// +//} +// +//MouseExternalControl::~MouseExternalControl() { +// +//} +// +//} // namespace openspace +// diff --git a/src/externalcontrol/mouseexternalcontrol.cpp.orig b/src/externalcontrol/mouseexternalcontrol.cpp.orig new file mode 100644 index 0000000000..b365a02c03 --- /dev/null +++ b/src/externalcontrol/mouseexternalcontrol.cpp.orig @@ -0,0 +1,79 @@ +#include "externalcontrol/mouseexternalcontrol.h" + +// workaround since Python debug does not work on windows +#ifdef _DEBUG +#undef _DEBUG +#include +#define _DEBUG +#else +#include +#endif + + +namespace openspace { + + +MouseExternalControl::MouseExternalControl(const char *filename): PythonExternalControl(filename) { + clear(); + pyarrSize_ = 6*2; + pyarr_ = new PyObject*[pyarrSize_]; + x_ = 0; + y_ = 0; + pos_ = 0; + button1_ = 0; + button2_ = 0; + button3_ = 0; + for(int i = 0; i < pyarrSize_; ++i) { + pyarr_[i] = PyLong_FromLong(0);; + } + +} + +void MouseExternalControl::mouseButtonCallback(int key, int action) { + if(key == 0) + button1_ = action; + if(key == 1) + button2_ = action; + if(key == 2) + button3_ = action; +} + +void MouseExternalControl::mousePosCallback(int x, int y) { + x_ = x; + y_ = y; +} + +void MouseExternalControl::mouseScrollCallback(int pos) { + pos_ = pos; +} + +void MouseExternalControl::update() { + + pyarr_[6] = pyarr_[0]; + pyarr_[7] = pyarr_[1]; + pyarr_[8] = pyarr_[2]; + pyarr_[9] = pyarr_[3]; + pyarr_[10] = pyarr_[4]; + pyarr_[11] = pyarr_[5]; + pyarr_[0] = PyLong_FromLong(button1_); + pyarr_[1] = PyLong_FromLong(button2_); + pyarr_[2] = PyLong_FromLong(button3_); + pyarr_[3] = PyLong_FromLong(pos_); + pyarr_[4] = PyLong_FromLong(x_); + pyarr_[5] = PyLong_FromLong(y_); + + run(); + + // cleanup + //for(int i = pyarrSize_ / 2; i < pyarrSize_; ++i) { + // Py_XDECREF(pyarr_[i]); + //} + +} + +MouseExternalControl::~MouseExternalControl() { + +} + +} // namespace openspace + diff --git a/src/externalcontrol/mouseexternalcontrol.h b/src/externalcontrol/mouseexternalcontrol.h new file mode 100644 index 0000000000..890a741733 --- /dev/null +++ b/src/externalcontrol/mouseexternalcontrol.h @@ -0,0 +1,28 @@ +//#ifndef MOUSEEXTERNALCONTROL_H +//#define MOUSEEXTERNALCONTROL_H +// +//#include "externalcontrol/pythonexternalcontrol.h" +// +//namespace openspace { +// +//class MouseExternalControl: public PythonExternalControl { +//public: +// +// // constructors & destructor +// MouseExternalControl(const char *filename); +// ~MouseExternalControl(); +// +// void update(); +// +// void mouseButtonCallback(int key, int action); +// void mousePosCallback(int x, int y); +// void mouseScrollCallback(int pos); +//private: +// +// int x_, y_, pos_, button1_, button2_, button3_; +// +//}; +// +//} // namespace openspace +// +//#endif \ No newline at end of file diff --git a/src/externalcontrol/pythonexternalcontrol.cpp b/src/externalcontrol/pythonexternalcontrol.cpp new file mode 100644 index 0000000000..ac95c3639a --- /dev/null +++ b/src/externalcontrol/pythonexternalcontrol.cpp @@ -0,0 +1,147 @@ +//#include "externalcontrol/pythonexternalcontrol.h" +// +//// workaround since Python debug does not work on windows +//#ifdef _DEBUG +//#undef _DEBUG +//#include +//#define _DEBUG +//#else +//#include +//#endif +// +//#include +//#include +//#include +//#include +//#include "deviceidentifier.h" +// +//#include "util/pss.h" +//#include "externalcontrol/externalcontrol.h" +//#include "interactionhandler.h" +// +//namespace openspace { +// +// +//// defining python callback functions +//static PyObject* pyexcontrol_numargs(PyObject *self, PyObject *args) { +// if(!PyArg_ParseTuple(args, ":pyexcontrol_numargs")) +// return NULL; +// return PyLong_FromLong(10); +//} +// +//static PyObject* pyexcontrol_message(PyObject *self, PyObject *args) +//{ +// char* text = 0; +// if(!PyArg_ParseTuple(args, "s:pyexcontrol_yeah",&text)) +// Py_RETURN_NONE; +// +// PythonExternalControl * ext = 0; +// ext->message(text); +// +// Py_RETURN_NONE; +//} +// +//static PyObject* pyexcontrol_rotateCamera(PyObject *self, PyObject *args) +//{ +// char* text = 0; +// float f1 = 0; +// float f2 = 0; +// float f3 = 0; +// float f4 = 0; +// if(!PyArg_ParseTuple(args, "fff:pyexcontrol_rotateCamera",&f1,&f2,&f3)) +// Py_RETURN_NONE; +// +// double dt = InteractionHandler::ref().getDt(); +// glm::vec3 EulerAngles(f1*dt,f2*dt, f3*dt); +// glm::quat rot = glm::quat(EulerAngles); +// ExternalControl * ext = 0; +// ext->rotate(rot); +// +// Py_RETURN_NONE; +//} +// +//static PyObject* pyexcontrol_orbitCamera(PyObject *self, PyObject *args) +//{ +// char* text = 0; +// float f1 = 0; +// float f2 = 0; +// float f3 = 0; +// if(!PyArg_ParseTuple(args, "fff:pyexcontrol_rotateCamera",&f1,&f2,&f3)) +// Py_RETURN_NONE; +// +// double dt = InteractionHandler::ref().getDt(); +// glm::vec3 EulerAngles(f1*dt,f2*dt, f3*dt); +// glm::quat rot = glm::quat(EulerAngles); +// ExternalControl * ext = 0; +// ext->orbit(rot); +// +// Py_RETURN_NONE; +//} +// +//static PyObject* pyexcontrol_distance(PyObject *self, PyObject *args) +//{ +// char* text = 0; +// float f1 = 0; +// float f2 = 0; +// if(!PyArg_ParseTuple(args, "ff:pyexcontrol_rotateCamera",&f1,&f2)) +// Py_RETURN_NONE; +// +// float dt = static_cast(InteractionHandler::ref().getDt()); +// pss dist(f1*dt,f2); +// ExternalControl * ext = 0; +// ext->distance(dist); +// +// Py_RETURN_NONE; +//} +// +//PyMethodDef* PythonExternalControl::getMethodDef() { +// // creating the python callback function table +// static PyMethodDef pyexcontrol_methods[] = { +// {"numargs", pyexcontrol_numargs, METH_VARARGS, "function"}, +// {"message", pyexcontrol_message, METH_VARARGS, "function"}, +// {"rotate", pyexcontrol_rotateCamera, METH_VARARGS, "function"}, +// {"orbit", pyexcontrol_orbitCamera, METH_VARARGS, "function"}, +// {"distance", pyexcontrol_distance, METH_VARARGS, "function"}, +// {NULL, NULL, 0, NULL} +// }; +// return pyexcontrol_methods; +//} +// +//void PythonExternalControl::message(const char *text) { +// +// printf("Input message from PythonScript: %s\n", text); +//} +// +//PythonExternalControl::PythonExternalControl(const char *filename) { +// pyarr_ = nullptr; +// ps_.load(filename, true); +//} +// +// +//void PythonExternalControl::update() { +// run(); +//} +// +//void PythonExternalControl::run() { +// if(pyarrSize_ > 0) +// ps_.run(pyarrSize_, pyarr_); +// else +// ps_.run(); +//} +// +// +//void PythonExternalControl::clear() { +// if(pyarr_ != nullptr) { +// // cleanup +// delete pyarr_; +// pyarr_ = nullptr; +// pyarrSize_ = 0; +// } +//} +// +//PythonExternalControl::~PythonExternalControl() { +// clear(); +//} +// +//} // namespace openspace +// diff --git a/src/externalcontrol/pythonexternalcontrol.h b/src/externalcontrol/pythonexternalcontrol.h new file mode 100644 index 0000000000..8a01d6f571 --- /dev/null +++ b/src/externalcontrol/pythonexternalcontrol.h @@ -0,0 +1,35 @@ +//#ifndef PYTHONEXTERNALCONTROL_H +//#define PYTHONEXTERNALCONTROL_H +// +//#include +//#include +// +//#include "externalcontrol/externalcontrol.h" +//#include "python/pythonscript.h" +// +//namespace openspace { +// +//class PythonExternalControl: public ExternalControl { +//public: +// +// // constructors & destructor +// PythonExternalControl(const char *filename); +// ~PythonExternalControl(); +// +// static PyMethodDef* getMethodDef(); +// +// void message(const char *text); +// virtual void update(); +// void clear(); +//private: +// PythonScript ps_; +// +//protected: +// void run(); +// int pyarrSize_; +// PyObject **pyarr_; +//}; +// +//} // namespace openspace +// +//#endif \ No newline at end of file diff --git a/src/externalcontrol/randomexternalcontrol.cpp b/src/externalcontrol/randomexternalcontrol.cpp new file mode 100644 index 0000000000..55bcf025ab --- /dev/null +++ b/src/externalcontrol/randomexternalcontrol.cpp @@ -0,0 +1,59 @@ +#include "externalcontrol/randomexternalcontrol.h" + +#include +#ifndef __WIN32__ + #include +#endif + +namespace openspace { + +typedef struct +{ + bool *keepGoing; + double *dx; +} parm; + +void *updatedx(void * arg) { + parm *p = (parm*) arg; + bool *kg = p->keepGoing; + double *dx = p->dx; + while( *kg ) { + //printf("Hello world!\n"); + *dx = *dx + 0.5; + + // random sleep time + int diff = rand() % 200; + +#ifndef __WIN32__ + usleep(10000*diff); +#endif + } + delete p; + return NULL; +} + + +RandomExternalControl::RandomExternalControl() { + /* + inputGuard = PTHREAD_MUTEX_INITIALIZER; + + pthread_attr_t pthread_custom_attr; + pthread_attr_init(&pthread_custom_attr); + keepGoing_ = new bool; + *keepGoing_ = true; + parm *p = (parm*)malloc(sizeof(parm)); + p->keepGoing = keepGoing_; + p->dx = &dx_; + + pthread_create(&backgroundThread, &pthread_custom_attr, updatedx, (void*)p); + */ +} + +RandomExternalControl::~RandomExternalControl() { + *keepGoing_ = false; + //pthread_join(backgroundThread, NULL); + delete keepGoing_; +} + +} // namespace openspace + diff --git a/src/externalcontrol/randomexternalcontrol.h b/src/externalcontrol/randomexternalcontrol.h new file mode 100644 index 0000000000..2114f6580d --- /dev/null +++ b/src/externalcontrol/randomexternalcontrol.h @@ -0,0 +1,26 @@ +#ifndef RANDOMEXTERNALCONTROL_H +#define RANDOMEXTERNALCONTROL_H + +#include +#include + +#include "externalcontrol/externalcontrol.h" + +namespace openspace { + +class RandomExternalControl: public ExternalControl { +public: + + // constructors & destructor + RandomExternalControl(); + ~RandomExternalControl(); + +private: + std::mutex inputGuard; + bool *keepGoing_; + std::thread *backgroundThread; +}; + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/interactionhandler.cpp b/src/interactionhandler.cpp new file mode 100644 index 0000000000..d8f32e0789 --- /dev/null +++ b/src/interactionhandler.cpp @@ -0,0 +1,228 @@ + +// open space includes +#include "interactionhandler.h" +#include "deviceidentifier.h" +#include "externalcontrol/randomexternalcontrol.h" +#include "externalcontrol/joystickexternalcontrol.h" + +// std includes +#include + +namespace openspace { + +InteractionHandler* InteractionHandler::this_ = nullptr; + +InteractionHandler::InteractionHandler() { + + // initiate pointers + camera_ = nullptr; + enabled_ = true; + node_ = nullptr; + dt_ = 0.0; +} + +InteractionHandler::~InteractionHandler() { + for (size_t i = 0; i < controllers_.size(); ++i) + { + delete controllers_[i]; + } +} + +void InteractionHandler::init() { + assert( ! this_); + this_ = new InteractionHandler(); +} + +void InteractionHandler::deinit() { + assert(this_); + delete this_; + this_ = nullptr; +} + +InteractionHandler& InteractionHandler::ref() { + assert(this_); + return *this_; +} + +bool InteractionHandler::isInitialized() { + return this_ != nullptr; +} + +void InteractionHandler::enable() { + assert(this_); + enabled_ = true; +} + +void InteractionHandler::disable() { + assert(this_); + enabled_ = false; +} + +const bool InteractionHandler::isEnabled() const { + assert(this_); + if (camera_) + return false; + return enabled_; +} + +void InteractionHandler::connectDevices() { + assert(this_); + assert(DeviceIdentifier::ref().isInitialized()); + + // for each device found + for(int i = 0; i < DeviceIdentifier::ref().numberOfDevices(); ++i) { + + // TODO + //if(DeviceIdentifier::ref().type(i) == InputDevice::XBOX) { + + // // found xbox, use xbox python controller + // JoystickExternalControl *joystickexcontrol = new JoystickExternalControl(RELATIVE_PATH"pyinput/Xbox.py"); + // joystickexcontrol->setInputDevice(i); + // addExternalControl(joystickexcontrol); + + //} else if(DeviceIdentifier::ref().type(i) == InputDevice::SPACENAVIGATOR) { + + // // found SpaceNavigator, use SpaceNavigator python controller + // JoystickExternalControl *joystickexcontrol = new JoystickExternalControl(RELATIVE_PATH"pyinput/SpaceNavigator.py"); + // joystickexcontrol->setInputDevice(i); + // addExternalControl(joystickexcontrol); + //} + + } +} + +void InteractionHandler::addExternalControl(ExternalControl* controller) { + assert(this_); + if (controller != nullptr) + { + controllers_.push_back(controller); + } +} + +void InteractionHandler::setCamera(Camera *camera) { + assert(this_); + camera_ = camera; +} + +Camera * InteractionHandler::getCamera() const { + assert(this_); + if (enabled_) + { + return camera_; + } + return nullptr; +} + +const psc InteractionHandler::getOrigin() const { + if(node_) + return node_->getWorldPosition(); + return psc(); +} + +void InteractionHandler::lockControls() { + assert(this_); + cameraGuard_.lock(); +} + +void InteractionHandler::unlockControls() { + assert(this_); + cameraGuard_.unlock(); +} + +void InteractionHandler::setFocusNode(SceneGraphNode *node) { + assert(this_); + node_ = node; +} + +void InteractionHandler::rotate(const glm::quat &rotation) { + assert(this_); + lockControls(); + camera_->rotate(rotation); + unlockControls(); +} + +void InteractionHandler::orbit(const glm::quat &rotation) { + assert(this_); + lockControls(); + + // the camera position + psc relative = camera_->getPosition(); + + // should be changed to something more dynamic =) + psc origin; + if(node_) { + origin = node_->getWorldPosition(); + } + + psc relative_origin_coordinate = relative - origin; + glm::mat4 rotation_matrix = glm::mat4_cast(rotation); + relative_origin_coordinate = relative_origin_coordinate.mul(rotation_matrix); + relative = relative_origin_coordinate + origin; + + camera_->setPosition(relative); + + unlockControls(); +} + +void InteractionHandler::distance(const pss &distance) { + assert(this_); + lockControls(); + + + psc relative = camera_->getPosition(); + psc origin; + if(node_) { + origin = node_->getWorldPosition(); + } + + psc relative_origin_coordinate = relative - origin; + glm::dvec3 dir = relative_origin_coordinate.getDirection(); + dir = dir * distance[0]; + relative_origin_coordinate = dir; + relative_origin_coordinate[3] = distance[1]; + relative = relative + relative_origin_coordinate; + + camera_->setPosition(relative); + + unlockControls(); +} + +void InteractionHandler::lookAt(const glm::quat &rotation) { + assert(this_); + lockControls(); + + unlockControls(); +} + +void InteractionHandler::setRotation(const glm::quat &rotation) { + assert(this_); + lockControls(); + + unlockControls(); +} + +void InteractionHandler::update(const double dt) { + assert(this_); + + // setting dt_ for use in callbacks + dt_ = dt; + + if (enabled_ && camera_) { + + // fetch data from joysticks + DeviceIdentifier::ref().update(); + + // update all controllers + for (size_t i = 0; i < controllers_.size(); ++i) { + controllers_[i]->update(); + } + + } +} + +double InteractionHandler::getDt() { + assert(this_); + return dt_; +} + +} // namespace openspace \ No newline at end of file diff --git a/src/interactionhandler.h b/src/interactionhandler.h new file mode 100644 index 0000000000..bfb83087b1 --- /dev/null +++ b/src/interactionhandler.h @@ -0,0 +1,86 @@ +#ifndef INTERACTIONHANDLER_H +#define INTERACTIONHANDLER_H + +// open space includes +#include "object.h" +#include "camera.h" +#include "externalcontrol/externalcontrol.h" +#include "scenegraph/scenegraphnode.h" + +// std includes +#include +#include +#include +#include + +// hack until we have a file/path manager +//#ifdef __WIN32__ +//#ifdef NDEBUG +//#define RELATIVE_PATH "" +//#else +//#define RELATIVE_PATH "../../../" +//#endif +//#else +//#define RELATIVE_PATH "../" +//#endif + +namespace openspace { + +class InteractionHandler: public Object { +public: + virtual ~InteractionHandler(); + + static void init(); + static void deinit(); + static InteractionHandler& ref(); + static bool isInitialized(); + + void enable(); + void disable(); + const bool isEnabled() const; + + void connectDevices(); + void addExternalControl(ExternalControl* controller); + + void setCamera(Camera *camera = nullptr); + Camera * getCamera() const; + const psc getOrigin() const; + void lockControls(); + void unlockControls(); + + void setFocusNode(SceneGraphNode *node); + + void orbit(const glm::quat &rotation); + void rotate(const glm::quat &rotation); + void distance(const pss &distance); + + void lookAt(const glm::quat &rotation); + void setRotation(const glm::quat &rotation); + + void update(const double dt); + + double getDt(); + +private: + static InteractionHandler* this_; + InteractionHandler(void); + InteractionHandler(const InteractionHandler& src); + InteractionHandler& operator=(const InteractionHandler& rhs); + + Camera *camera_; + bool enabled_; + SceneGraphNode *node_; + + double dt_; + + // used for calling when updating and deallocation + std::vector controllers_; + + // for locking and unlocking + std::mutex cameraGuard_; + +}; + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/main.cpp b/src/main.cpp new file mode 100644 index 0000000000..b9e4c88a5e --- /dev/null +++ b/src/main.cpp @@ -0,0 +1,148 @@ + +// open space includes +#include "renderengine.h" + +// sgct includes +#include "sgct.h" + +// std includes +#include +#include + +#include + +// graphics and openspace engines +sgct::Engine * gEngine; +openspace::RenderEngine *rEngine; + +// function pointer declarations +void mainInitFunc(void); +void mainPreSyncFunc(void); +void mainPostSyncPreDrawFunc(void); +void mainRenderFunc(void); +void mainPostDrawFunc(void); +void mainKeyboardCallback(int key, int action); +void mainMouseButtonCallback(int key, int action); +void mainMousePosCallback(double x, double y); +void mainMouseScrollCallback(double posX, double posY); +void mainEncodeFun(); +void mainDecodeFun(); + +/** +* The main function, only purpose is to connect the +* OpenSpace rendering engine with SGCT. +*/ +int main(int argc, char **argv) { + ghoul::filesystem::FileSystem::initialize(); + FileSys.registerPathToken("${BASE_PATH}", "../.."); + + char* cmd = "-config"; + const std::string pathStr = p("${BASE_PATH}/config/single.xml"); + char* path = _strdup(pathStr.c_str()); + char** newArgv = new char*[3]; + int newArgc = 3; + newArgv[0] = argv[0]; + newArgv[1] = cmd; + newArgv[2] = path; + + // allocate sgct- and openspace engine objects + gEngine = new sgct::Engine( newArgc, newArgv ); + rEngine = new openspace::RenderEngine(argc, argv); + + free(path); + delete[] newArgv; + + // Bind functions + gEngine->setInitOGLFunction( mainInitFunc ); + gEngine->setPreSyncFunction( mainPreSyncFunc ); + gEngine->setPostSyncPreDrawFunction( mainPostSyncPreDrawFunc ); + gEngine->setDrawFunction( mainRenderFunc ); + gEngine->setPostDrawFunction( mainPostDrawFunc ); + gEngine->setKeyboardCallbackFunction( mainKeyboardCallback ); + gEngine->setMouseButtonCallbackFunction( mainMouseButtonCallback ); + gEngine->setMousePosCallbackFunction( mainMousePosCallback ); + gEngine->setMouseScrollCallbackFunction( mainMouseScrollCallback ); + + // set encode and decode functions + // NOTE: starts synchronizing before init functions + sgct::SharedData::instance()->setEncodeFunction(mainEncodeFun); + sgct::SharedData::instance()->setDecodeFunction(mainDecodeFun); + + // try to open a window + if( ! gEngine->init(sgct::Engine::OpenGL_4_4_Core_Profile)) { + + // could not open a window, deallocates and exits + delete gEngine; + delete rEngine; + return EXIT_FAILURE; + } + + // Main loop + gEngine->render(); + + // Clean up (de-allocate) + delete gEngine; + delete rEngine; + + // Exit program + exit( EXIT_SUCCESS ); +} + + +void mainInitFunc(void) { + rEngine->init(); +} + +void mainPreSyncFunc(void) { + rEngine->preSync(); +} + +void mainPostSyncPreDrawFunc(void) { + rEngine->postSyncPreDraw(); +} + +void mainRenderFunc(void) { + rEngine->render(); +} + +void mainPostDrawFunc(void) { + rEngine->postDraw(); +} + +void mainKeyboardCallback(int key, int action) { + if (gEngine->isMaster()) + { + rEngine->keyboardCallback(key, action); + } +} + +void mainMouseButtonCallback(int key, int action) { + if (gEngine->isMaster()) + { + rEngine->mouseButtonCallback(key, action); + } +} + +void mainMousePosCallback(double x, double y) { + if (gEngine->isMaster()) + { + rEngine->mousePosCallback(static_cast(x), static_cast(y)); + } +} + +void mainMouseScrollCallback(double pos, double /*pos2*/) { + if (gEngine->isMaster()) + { + rEngine->mouseScrollCallback(static_cast(pos)); + } +} + +void mainEncodeFun() { + rEngine->encode(); +} + +void mainDecodeFun() { + rEngine->decode(); +} + + diff --git a/src/object.cpp b/src/object.cpp new file mode 100644 index 0000000000..55d93a51d7 --- /dev/null +++ b/src/object.cpp @@ -0,0 +1,27 @@ + +// open space includes +#include "object.h" + +namespace openspace { + +Object::Object() { + +} + +void Object::serialize() const { + +} + +void Object::deserialize() const { + +} + +void Object::encode() { + +} + +void Object::decode() { + +} + +} // namespace openspace \ No newline at end of file diff --git a/src/object.h b/src/object.h new file mode 100644 index 0000000000..1a3d0ac7a2 --- /dev/null +++ b/src/object.h @@ -0,0 +1,21 @@ +#ifndef OBJECT_H +#define OBJECT_H + +namespace openspace { + +#define sharedDataInstance_ sgct::SharedData::instance() + +class Object { +public: + Object(); + + virtual void serialize() const; + virtual void deserialize() const; + + virtual void encode(); + virtual void decode(); +}; + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/renderable.cpp b/src/renderable.cpp new file mode 100644 index 0000000000..0819ce804a --- /dev/null +++ b/src/renderable.cpp @@ -0,0 +1,32 @@ + +// open space includes +#include "renderable.h" + +namespace openspace { + +Renderable::Renderable() { + +} + +Renderable::Renderable(const pss &boundingSphere) { + boundingSphere_ = boundingSphere; +} + +Renderable::~Renderable() { + +} + +void Renderable::setBoundingSphere(const pss &boundingSphere) { + boundingSphere_ = boundingSphere; +} + +const pss& Renderable::getBoundingSphere() { + return boundingSphere_; +} + +void Renderable::update() { +} + + + +} // namespace openspace \ No newline at end of file diff --git a/src/renderable.h b/src/renderable.h new file mode 100644 index 0000000000..436e15f4e6 --- /dev/null +++ b/src/renderable.h @@ -0,0 +1,33 @@ +#ifndef RENDERABLE_H +#define RENDERABLE_H + +// open space includes +#include "object.h" +#include "util/psc.h" +#include "util/pss.h" +#include "camera.h" + +namespace openspace { + +class Renderable: public Object { +public: + + // constructors & destructor + Renderable(); + Renderable(const pss &boundingSphere); + virtual ~Renderable(); + + void setBoundingSphere(const pss &boundingSphere); + const pss &getBoundingSphere(); + + virtual void render(const Camera *camera, const psc &thisPosition) = 0; + virtual void update(); + +private: + pss boundingSphere_; + +}; + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/renderablebody.cpp b/src/renderablebody.cpp new file mode 100644 index 0000000000..aa1afda9ed --- /dev/null +++ b/src/renderablebody.cpp @@ -0,0 +1,74 @@ + +// open space includes +#include "renderablebody.h" + +namespace openspace { + +RenderableBody::RenderableBody(const pss &radius):Renderable(radius) { + programObject_ = nullptr; + texture_ = nullptr; + rad_ = radius[0] * pow(10,radius[1]); + + // setup a unit sphere + planet_ = new gl4::Sphere(1.0f,30); + planet_->init(); +} + +RenderableBody::~RenderableBody() { + delete planet_; +} + +void RenderableBody::setProgramObject(ghoul::opengl::ProgramObject *programObject = nullptr) { + assert(programObject) ; + programObject_ = programObject; +} + +void RenderableBody::setTexture(ghoul::opengl::Texture *texture) { + assert(texture); + texture_ = texture; +} + +void RenderableBody::render(const Camera *camera, const psc &thisPosition) { + + // check so that the shader is set + assert(programObject_); + assert(texture_); + + // activate shader + programObject_->activate(); + + // fetch data + psc currentPosition = thisPosition; + psc campos = camera->getPosition(); + glm::mat4 camrot = camera->getViewRotationMatrix(); + + // scale the planet to appropriate size since the planet is a unit sphere + glm::mat4 transform = glm::mat4(1); + transform = glm::scale(transform, glm::vec3(rad_,rad_,rad_)); + + // setup the data to the shader + programObject_->setUniform("ViewProjection", camera->getViewProjectionMatrix()); + programObject_->setUniform("ModelTransform", transform); + programObject_->setUniform("campos", campos.getVec4f()); + programObject_->setUniform("objpos", currentPosition.getVec4f()); + programObject_->setUniform("camrot", camrot); + programObject_->setUniform("scaling", camera->getScaling()); + + // if texture is availible, use it + glActiveTexture(GL_TEXTURE0); + texture_->bind(); + programObject_->setUniform("texture1", 0); + + // render + planet_->render(); + + // disable shader + programObject_->deactivate(); + +} + +void RenderableBody::update() { + +} + +} // namespace openspace \ No newline at end of file diff --git a/src/renderablebody.h b/src/renderablebody.h new file mode 100644 index 0000000000..110663de16 --- /dev/null +++ b/src/renderablebody.h @@ -0,0 +1,37 @@ +#ifndef RENDERABLEBODY_H +#define RENDERABLEBODY_H + +// open space includes +#include "renderable.h" +#include "util/sphere.h" + +// ghoul includes +#include "ghoul/opengl/programobject.h" +#include "ghoul/opengl/texture.h" + +namespace openspace { + +class RenderableBody: public Renderable { +public: + + // constructors & destructor + RenderableBody(const pss &radius); + ~RenderableBody(); + + void setProgramObject(ghoul::opengl::ProgramObject *programObject); + void setTexture(ghoul::opengl::Texture *texture); + + virtual void render(const Camera *camera, const psc &thisPosition); + virtual void update(); + +private: + ghoul::opengl::ProgramObject *programObject_; + ghoul::opengl::Texture *texture_; + double rad_; + + gl4::Sphere *planet_; +}; + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/renderableplanet.cpp b/src/renderableplanet.cpp new file mode 100644 index 0000000000..b2c4df14ae --- /dev/null +++ b/src/renderableplanet.cpp @@ -0,0 +1,71 @@ + +// open space includes +#include "renderableplanet.h" + +namespace openspace { + +RenderablePlanet::RenderablePlanet(const pss &radius):Renderable(radius) { + programObject_ = nullptr; + texture_ = nullptr; + + // setup a unit sphere + planet_ = new Planet(radius,30); +} + +RenderablePlanet::~RenderablePlanet() { + delete planet_; +} + +void RenderablePlanet::setProgramObject(ghoul::opengl::ProgramObject *programObject = nullptr) { + assert(programObject) ; + programObject_ = programObject; +} + +void RenderablePlanet::setTexture(ghoul::opengl::Texture *texture) { + assert(texture); + texture_ = texture; +} + +void RenderablePlanet::render(const Camera *camera, const psc &thisPosition) { + + // check so that the shader is set + assert(programObject_); + assert(texture_); + + // activate shader + programObject_->activate(); + + // fetch data + psc currentPosition = thisPosition; + psc campos = camera->getPosition(); + glm::mat4 camrot = camera->getViewRotationMatrix(); + + // scale the planet to appropriate size since the planet is a unit sphere + glm::mat4 transform = glm::mat4(1); + + // setup the data to the shader + programObject_->setUniform("ViewProjection", camera->getViewProjectionMatrix()); + programObject_->setUniform("ModelTransform", transform); + programObject_->setUniform("campos", campos.getVec4f()); + programObject_->setUniform("objpos", currentPosition.getVec4f()); + programObject_->setUniform("camrot", camrot); + programObject_->setUniform("scaling", camera->getScaling()); + + // if texture is availible, use it + glActiveTexture(GL_TEXTURE0); + texture_->bind(); + programObject_->setUniform("texture1", 0); + + // render + planet_->render(); + + // disable shader + programObject_->deactivate(); + +} + +void RenderablePlanet::update() { + +} + +} // namespace openspace \ No newline at end of file diff --git a/src/renderableplanet.h b/src/renderableplanet.h new file mode 100644 index 0000000000..70547af11a --- /dev/null +++ b/src/renderableplanet.h @@ -0,0 +1,37 @@ +#ifndef RENDERABLEPLANET_H +#define RENDERABLEPLANET_H + +// open space includes +#include "renderable.h" +#include "util/planet.h" + +// ghoul includes +#include "ghoul/opengl/programobject.h" +#include "ghoul/opengl/texture.h" + +namespace openspace { + +class RenderablePlanet: public Renderable { +public: + + // constructors & destructor + RenderablePlanet(const pss &radius); + ~RenderablePlanet(); + + void setProgramObject(ghoul::opengl::ProgramObject *programObject); + void setTexture(ghoul::opengl::Texture *texture); + + virtual void render(const Camera *camera, const psc &thisPosition); + virtual void update(); + +private: + ghoul::opengl::ProgramObject *programObject_; + ghoul::opengl::Texture *texture_; + double rad_; + + Planet *planet_; +}; + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/renderengine.cpp b/src/renderengine.cpp new file mode 100644 index 0000000000..a6693a3712 --- /dev/null +++ b/src/renderengine.cpp @@ -0,0 +1,389 @@ + +// open space includes +#include "renderengine.h" +#include "deviceidentifier.h" +#include "util/spice.h" +#include "util/planet.h" +#include "util/time.h" +//#include "python/pythonmanager.h" +#include "renderablebody.h" + +// ghoul includes +#include "ghoul/opengl/texturereader.h" +#include "ghoul/opengl/texture.h" + +// sgct includes +#include "sgct.h" + +const std::string _loggerCat = "RenderEngine"; + +namespace openspace { + + RenderEngine::RenderEngine(int argc, char **argv) { + + // initialize all pointers as nullptr. + mainCamera_ = nullptr; + //mouseControl_ = nullptr; + //keyboardControl_ = nullptr; + sceneGraph_ = nullptr; +} + +RenderEngine::~RenderEngine() { + + // finalize python + //PythonManager::finalize(); + + // finalize singletons + if(Spice::isInitialized()) { + Spice::deinit(); + } + if(Time::isInitialized()) { + Time::deinit(); + } + if(InteractionHandler::isInitialized()) { + InteractionHandler::deinit(); + } + if(DeviceIdentifier::isInitialized()) { + DeviceIdentifier::deinit(); + } + + // remove camera + if(mainCamera_) + delete mainCamera_; + + // deallocate the scene graph + if(sceneGraph_) + delete sceneGraph_; +} + +bool RenderEngine::init() { + + // init ghoul logging + std::string _loggerCat = "RenderEngine::init"; + ghoul::logging::LogManager::initialize(ghoul::logging::LogManager::LogLevel::Info); + LogMgr.addLog(new ghoul::logging::ConsoleLog); + + // init python + //PythonManager::init(); + + // init singletons + DeviceIdentifier::init(); + DeviceIdentifier::ref().scanDevices(); + InteractionHandler::init(); + InteractionHandler::ref().connectDevices(); + Time::init(); + Spice::init(); + Spice::ref().loadDefaultKernels(); + + Planet pl(pss(), 4); + + // GL settings + glEnable (GL_DEPTH_TEST); + glEnable(GL_CULL_FACE); + glCullFace(GL_BACK); + + // set the close clip plane and the far clip plane to extreme values while in development + sgct::Engine::instance()->setNearAndFarClippingPlanes(0.1f,10000.0f); + //sgct::Engine::setNearAndFarClippingPlanes(0.1f,10000.0f); + //sgct::Engine::getPtr()->setNearAndFarClippingPlanes(0.1f,10000.0f); + + // init camera and set position + mainCamera_ = new Camera(); + mainCamera_->setScaling(glm::vec2(1.0, -8.0)); + mainCamera_->setPosition(psc(0.0,0.0,1.499823,11.0)); // about the distance from the sun to our moon, will be overritten by the scenegraphloader + + // if master, setup interaction + if (sgct::Engine::instance()->isMaster()) { + InteractionHandler::ref().setCamera(mainCamera_); + + // init interactionhandler and mouse interaction + //keyboardControl_ = new KeyboardExternalControl(RELATIVE_PATH"pyinput/keyboard.py"); + //mouseControl_ = new MouseExternalControl(RELATIVE_PATH"pyinput/mouse.py"); + //InteractionHandler::ref().addExternalControl(mouseControl_); // the interactionhandler is deallocating the object when it terminates + //InteractionHandler::ref().addExternalControl(keyboardControl_); // the interactionhandler is deallocating the object when it terminates + + } + + // init scenegraph + sceneGraph_ = new SceneGraph(); + sceneGraph_->init(); + + // set some random seed, should be random for release + srand(1000); + + // calculating the maximum field of view for the camera, used to determine visibility of objects in the scene graph + if(sgct::Engine::instance()->getWindowPtr(0)->isUsingFisheyeRendering()) { + + // fisheye mode, looking upwards to the "dome" + glm::vec4 viewdir(0,1,0,0); + + // get the tilt and rotate the view + float tilt = sgct::Engine::instance()->getWindowPtr(0)->getFisheyeTilt(); + //tilt = tilt * 0.0174532925; // degrees to radians + glm::mat4 tiltMatrix = glm::rotate(glm::mat4(1.0f), tilt, glm::vec3(1.0f,0.0f,0.0f)); + viewdir = tiltMatrix * viewdir; + + // set the tilted view and the FOV + mainCamera_->setCameraDirection(glm::vec3(viewdir[0],viewdir[1],viewdir[2])); + //mainCamera_->setMaxFov(sgct_core::SGCTSettings::Instance()->getFisheyeFOV()); + mainCamera_->setMaxFov(sgct::Engine::instance()->getWindowPtr(0)->getFisheyeFOV()); + } else { + + // get corner positions, calculating the forth to easily calculate center + glm::vec3 corners[4]; + corners[0] = sgct::Engine::instance()->getWindowPtr(0)->getCurrentViewport()->getViewPlaneCoords(sgct_core::Viewport::LowerLeft); + corners[1] = sgct::Engine::instance()->getWindowPtr(0)->getCurrentViewport()->getViewPlaneCoords(sgct_core::Viewport::UpperLeft); + corners[2] = sgct::Engine::instance()->getWindowPtr(0)->getCurrentViewport()->getViewPlaneCoords(sgct_core::Viewport::UpperRight); + corners[3] = glm::vec3(corners[2][0],corners[0][1],corners[2][2]); + glm::vec3 center = (corners[0] + corners[1] + corners[2] + corners[3]) / 4.0f; + + // set the eye position, useful during rendering + eyePosition_ = sgct_core::ClusterManager::instance()->getUserPtr()->getPos(); + + // get viewdirection, stores the direction in the camera, used for culling + glm::vec3 viewdir = glm::normalize(eyePosition_- center); + mainCamera_->setCameraDirection(-viewdir); + + // set the initial fov to be 0.0 which means everything will be culled + float maxFov = 0.0f; + + // for each corner + for(int i = 0; i < 4; ++i) { + + // calculate radians to corner + glm::vec3 dir = glm::normalize(eyePosition_- corners[i]); + float radsbetween = acos(glm::dot(viewdir, dir))/(glm::length(viewdir) * glm::length(dir)); + + // the angle to a corner is larger than the current maxima + if (radsbetween > maxFov) { + maxFov = radsbetween; + } + } + mainCamera_->setMaxFov(maxFov); + } + + // successfull init + return true; +} + +void RenderEngine::preSync() { + + if (sgct::Engine::instance()->isMaster()) { + // get time variables + masterTime_ = sgct::Engine::instance()->getTime(); + double dt = sgct::Engine::instance()->getDt(); + + // do interaction handling + InteractionHandler::ref().update(dt); + // lock controls so camera is not updated during rendering + InteractionHandler::ref().lockControls(); + } + +} + +void RenderEngine::postSyncPreDraw() { + + // converts the quaternion used to rotation matrices + mainCamera_->compileViewRotationMatrix(); + + // update and evaluate the scene starting from the root node + sceneGraph_->update(); + sceneGraph_->evaluate(mainCamera_); +} + +void RenderEngine::render() { + + // preparing the camera can only be done in the render function + // since the SGCT get matrix functions is only valid in the render function + glm::mat4 projection = sgct::Engine::instance()->getActiveProjectionMatrix(); + glm::mat4 view = sgct::Engine::instance()->getActiveViewMatrix(); + view = glm::translate(view, eyePosition_); // make sure the eye is in the center + + // setup the camera for the current frame + mainCamera_->setViewProjectionMatrix(projection*view); + + // render the scene starting from the root node + sceneGraph_->render(mainCamera_); + + if(sgct::Engine::instance()->isMaster()) { + const glm::vec2 scaling = mainCamera_->getScaling(); + const glm::vec3 viewdirection = mainCamera_->getViewDirection(); + const psc position = mainCamera_->getPosition(); + Freetype::print(sgct_text::FontManager::instance()->getFont( "SGCTFont", 10 ), 10, 50, + "Position: (%.5f, %.5f, %.5f, %.5f)", position[0], position[1], position[2], position[3] + ); + Freetype::print(sgct_text::FontManager::instance()->getFont( "SGCTFont", 10 ), 10, 35, + "View direction: (%.3f, %.3f, %.3f)", viewdirection[0], viewdirection[1], viewdirection[2] + ); + Freetype::print(sgct_text::FontManager::instance()->getFont( "SGCTFont", 10 ), 10, 20, + "Scaling: (%.10f, %.2f)", scaling[0], scaling[1] + ); + + psc campos = InteractionHandler::ref().getCamera()->getPosition(); + psc origin = InteractionHandler::ref().getOrigin(); + psc relative = campos - origin; + pss pssl = relative.length(); + //mainCamera_->setScaling(glm::vec2(pssl[0], -pssl[1]+6)); + //mainCamera_->setScaling(glm::vec2(3000.0, -11.0f)); + Freetype::print(sgct_text::FontManager::instance()->getFont( "SGCTFont", 10 ), 10, 65, + "Distance to origin: (%.15f, %.2f)", pssl[0], pssl[1] + ); + } +} + +void RenderEngine::postDraw() { + + // unlock controls so the camera can be updated again + if (sgct::Engine::instance()->isMaster()) { + InteractionHandler::ref().unlockControls(); + } + +} + +void RenderEngine::keyboardCallback(int key, int action) { + const double speed = 0.75; + if (key == 'S') { + double dt = InteractionHandler::ref().getDt(); + glm::vec3 euler(speed * dt, 0.0, 0.0); + glm::quat rot = glm::quat(euler); + InteractionHandler::ref().orbit(rot); + } + if (key == 'W') { + double dt = InteractionHandler::ref().getDt(); + glm::vec3 euler(-speed * dt, 0.0, 0.0); + glm::quat rot = glm::quat(euler); + InteractionHandler::ref().orbit(rot); + } + if (key == 'A') { + double dt = InteractionHandler::ref().getDt(); + glm::vec3 euler(0.0, -speed * dt, 0.0); + glm::quat rot = glm::quat(euler); + InteractionHandler::ref().orbit(rot); + } + if (key == 'D') { + double dt = InteractionHandler::ref().getDt(); + glm::vec3 euler(0.0, speed * dt, 0.0); + glm::quat rot = glm::quat(euler); + InteractionHandler::ref().orbit(rot); + } + if (key == 262) { + double dt = InteractionHandler::ref().getDt(); + glm::vec3 euler(0.0, speed * dt, 0.0); + glm::quat rot = glm::quat(euler); + InteractionHandler::ref().rotate(rot); + } + if (key == 263) { + double dt = InteractionHandler::ref().getDt(); + glm::vec3 euler(0.0, -speed * dt, 0.0); + glm::quat rot = glm::quat(euler); + InteractionHandler::ref().rotate(rot); + } + if (key == 264) { + double dt = InteractionHandler::ref().getDt(); + glm::vec3 euler(speed * dt, 0.0, 0.0); + glm::quat rot = glm::quat(euler); + InteractionHandler::ref().rotate(rot); + } + if (key == 265) { + double dt = InteractionHandler::ref().getDt(); + glm::vec3 euler(-speed * dt, 0.0, 0.0); + glm::quat rot = glm::quat(euler); + InteractionHandler::ref().rotate(rot); + } + if (key == 'R') { + double dt = InteractionHandler::ref().getDt(); + pss dist(3 * -speed * dt, 8.0); + InteractionHandler::ref().distance(dist); + } + if (key == 'F') { + double dt = InteractionHandler::ref().getDt(); + pss dist(3 * speed * dt, 8.0); + InteractionHandler::ref().distance(dist); + } +} + +void RenderEngine::mouseButtonCallback(int key, int action) { + //if(mouseControl_ != nullptr) { + // mouseControl_->mouseButtonCallback(key,action); + //} +} + +void RenderEngine::mousePosCallback(int x, int y) { + //if(mouseControl_ != nullptr) { + // mouseControl_->mousePosCallback(x,y); + //} +} + +void RenderEngine::mouseScrollCallback(int pos) { + //if(mouseControl_ != nullptr) { + // mouseControl_->mouseScrollCallback(pos); + //} +} + +void RenderEngine::encode() { + + // allocate a sgct shared double for syncing + sgct::SharedDouble *shDouble = new sgct::SharedDouble(); + + // sync the time + shDouble->setVal(masterTime_); + sharedDataInstance_->writeDouble(shDouble); + + // check that the camera has been allocated + if(mainCamera_ != nullptr) { + + // sync position + psc campos = mainCamera_->getPosition(); + for(int i = 0; i < 4; i++) { + shDouble->setVal(campos[i]); + sharedDataInstance_->writeDouble(shDouble); + } + + // sync view direction + glm::quat camrot = mainCamera_->getRotation(); + for(int i = 0; i < 4; i++) { + shDouble->setVal(camrot[i]); + sharedDataInstance_->writeDouble(shDouble); + } + } + + // deallocate + delete shDouble; + +} + +void RenderEngine::decode() { + + // allocate a sgct shared double for syncing + sgct::SharedDouble *shDouble = new sgct::SharedDouble(); + + // sync the time + sharedDataInstance_->readDouble(shDouble); + masterTime_ = shDouble->getVal(); + + // check that the camera has been allocated + if(mainCamera_ != nullptr) { + + // sync position + psc campos; + for(int i = 0; i < 4; i++) { + sharedDataInstance_->readDouble(shDouble); + campos[i] = shDouble->getVal(); + } + mainCamera_->setPosition(campos); + + // sync view direction + glm::quat camrot; + for(int i = 0; i < 4; i++) { + sharedDataInstance_->readDouble(shDouble); + camrot[i] = static_cast(shDouble->getVal()); + } + mainCamera_->setRotation(camrot); + } + + // deallocate + delete shDouble; + +} + +} // namespace openspace diff --git a/src/renderengine.h b/src/renderengine.h new file mode 100644 index 0000000000..1500ae165d --- /dev/null +++ b/src/renderengine.h @@ -0,0 +1,52 @@ +#ifndef RENDERENGINE_H +#define RENDERENGINE_H + +// open space includes +#include "object.h" +#include "camera.h" +#include "scenegraph/scenegraph.h" +#include "interactionhandler.h" +#include "externalcontrol/mouseexternalcontrol.h" +#include "externalcontrol/keyboardexternalcontrol.h" + +// ghoul includes +#include "ghoul/logging/logmanager.h" +#include "ghoul/logging/consolelog.h" + +namespace openspace { + +class RenderEngine: public Object { +public: + + // constructors & destructor + RenderEngine(int argc, char **argv); + ~RenderEngine(); + + // sgct wrapped functions + bool init(); + void preSync(); + void postSyncPreDraw(); + void render(); + void postDraw(); + void keyboardCallback(int key, int action); + void mouseButtonCallback(int key, int action); + void mousePosCallback(int x, int y); + void mouseScrollCallback(int pos); + + // object extensions + virtual void encode(); + virtual void decode(); + +private: + double masterTime_; + Camera *mainCamera_; + //MouseExternalControl *mouseControl_; + //KeyboardExternalControl *keyboardControl_; + + SceneGraph *sceneGraph_; + glm::vec3 eyePosition_; +}; + +} // namespace openspace + +#endif diff --git a/src/scenegraph/scenegraph.cpp b/src/scenegraph/scenegraph.cpp new file mode 100644 index 0000000000..e4fe3c50c3 --- /dev/null +++ b/src/scenegraph/scenegraph.cpp @@ -0,0 +1,63 @@ + +// open space includes +#include "scenegraph/scenegraph.h" +#include "scenegraph/scenegraphloader.h" +#include "renderablebody.h" +#include "interactionhandler.h" +#include "util/spice.h" + +// ghoul includes +#include "ghoul/opengl/programobject.h" +#include "ghoul/logging/logmanager.h" +#include "ghoul/logging/consolelog.h" +#include "ghoul/opengl/texturereader.h" +#include "ghoul/opengl/texture.h" +#include + +namespace openspace { + +SceneGraph::SceneGraph() { + root_ = nullptr; +} + +SceneGraph::~SceneGraph() { + + // deallocate the scene graph + if(root_) + delete root_; + + // deallocate shaders, iterate c++11 style + for (auto& shaderTuple: shaders_) { + + // the shader is in the maps second position + delete shaderTuple.second; + } + +} + +void SceneGraph::init() { + // logger string + std::string _loggerCat = "SceneGraph::init"; + + SceneGraphLoader *loader = new SceneGraphLoader(&nodes_, &shaders_); + root_ = loader->loadSceneGraph(p("${BASE_PATH}/modules")); + update(); + pss bs = root_->calculateBoundingSphere(); +} + +void SceneGraph::update() { + for(int i = 0; i < nodes_.size(); ++i) { + nodes_[i]->update(); + } +} + +void SceneGraph::evaluate(Camera *camera) { + root_->evaluate(camera); +} + +void SceneGraph::render(Camera *camera) { + root_->render(camera); +} + + +} // namespace openspace \ No newline at end of file diff --git a/src/scenegraph/scenegraph.h b/src/scenegraph/scenegraph.h new file mode 100644 index 0000000000..e98743c3da --- /dev/null +++ b/src/scenegraph/scenegraph.h @@ -0,0 +1,40 @@ +#ifndef SCENEGRAPH_H +#define SCENEGRAPH_H + +// open space includes +#include "object.h" +#include "scenegraph/scenegraphnode.h" + +// std includes +#include +#include + +// ghoul includes +#include "ghoul/opengl/programobject.h" + +namespace openspace { + +class SceneGraph: public Object { +public: + + // constructors & destructor + SceneGraph(); + ~SceneGraph(); + + void init(); + + void update(); + void evaluate(Camera *camera); + void render(Camera *camera); + +private: + + SceneGraphNode *root_; + std::vector nodes_; + std::map shaders_; + +}; + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/scenegraph/scenegraphloader.cpp b/src/scenegraph/scenegraphloader.cpp new file mode 100644 index 0000000000..3b742087fc --- /dev/null +++ b/src/scenegraph/scenegraphloader.cpp @@ -0,0 +1,431 @@ + +// open space includes +#include "scenegraph/scenegraphloader.h" +#include "renderablebody.h" +#include "renderableplanet.h" +#include "interactionhandler.h" +#include "util/spice.h" + +// ghoul includes +#include "ghoul/logging/logmanager.h" +#include "ghoul/logging/consolelog.h" +#include "ghoul/opengl/texturereader.h" +#include "ghoul/opengl/texture.h" + +// std includes +#include + +namespace openspace { + +SceneGraphLoader::SceneGraphLoader(std::vector *nodes, std::map *commonShaders) { + root_ = nullptr; + nodes_ = nodes; + commonShaders_ = commonShaders; +} + +SceneGraphLoader::~SceneGraphLoader() { +} + +SceneGraphNode* SceneGraphLoader::loadSceneGraph(const std::string &path) { + + assert(commonShaders_); + + std::string _loggerCat = "SceneGraphLoader::loadSceneGraph"; + + // initializes the scene graph + root_ = new SceneGraphNode(); + + // loading all common stuff + tinyxml2::XMLDocument commonXML; + std::string commonPath = path + "/common/common.xml"; + commonXML.LoadFile(commonPath.c_str()); + + // loading the shaders + tinyxml2::XMLElement* shaders = commonXML.FirstChildElement( "shaders" ); + if(shaders) { + tinyxml2::XMLElement* shader = shaders->FirstChildElement( "shader" ); + for(;shader; shader = shader->NextSiblingElement( "shader" )) { + if(shader->Attribute("identifier")) { + std::string identifier = shader->Attribute("identifier"); + ghoul::opengl::ProgramObject *programObject = nullptr; + if(getShader(&programObject,path + "/common/", shader )) + commonShaders_->insert( std::make_pair(identifier, programObject) ); + } + } + } + + tinyxml2::XMLDocument scenegraphXML; + std::string scenegraphPath = path + "/scenegraph.xml"; + scenegraphXML.LoadFile(scenegraphPath.c_str()); + + // loading the scenegraph + tinyxml2::XMLElement* root = scenegraphXML.FirstChildElement( "root" ); + if(root) { + tinyxml2::XMLElement* node = root->FirstChildElement( "node" ); + loadSceneGraphTree(node, root_, path); + } + + return root_; +} + +// ugly +void SceneGraphLoader::loadSceneGraphTree(tinyxml2::XMLElement* node, SceneGraphNode *current, const std::string &path) { + + // check that everything works + assert(InteractionHandler::isInitialized()); + + // ghoul logger + std::string _loggerCat = "SceneGraphLoader::loadSceneGraphTree"; + + for(;node; node = node->NextSiblingElement( "node" )) { + SceneGraphNode *thisNode = nullptr; + std::string name = ""; + if(node->Attribute("module")) { + name = node->Attribute("module"); + thisNode = loadSceneGraphNodeFromFile(name, current, path); + } else { + thisNode = loadSceneGraphNode(node, "", current, path); + } + + if(thisNode) { + tinyxml2::XMLElement* children = node->FirstChildElement( "node" ); + if(children) { + loadSceneGraphTree(children, thisNode, path); + } + nodes_->push_back(thisNode); + + // camera stuff + tinyxml2::XMLElement* camera = node->FirstChildElement( "camera" ); + if(camera && camera->Attribute("setting")) { + std::string setting = camera->Attribute("setting"); + if(setting == "focus") { + // HACK + InteractionHandler::ref().setFocusNode(thisNode->parent()); + LINFO_SAFE("Setting camera focus: " << name); + } else if(setting == "position") { + InteractionHandler::ref().getCamera()->setPosition(thisNode->getWorldPosition()); + LINFO_SAFE("Setting camera position: " << name); + } + } + + + } else { + LERROR_SAFE("Could not load SceneGraphNode [ " << name << " ], ignoring all children!"); + } + + } +} + +SceneGraphNode * SceneGraphLoader::loadSceneGraphNodeFromFile(std::string name, SceneGraphNode *parent, const std::string &path) { + std::string _loggerCat = "SceneGraphLoader::loadSceneGraphNode"; + + // path and name + std::string nodePath = path + "/" + name + "/" + name + ".xml"; + tinyxml2::XMLDocument nodeXML; + nodeXML.LoadFile(nodePath.c_str()); + + return loadSceneGraphNode(nodeXML.FirstChildElement( "module" ), name, parent, path + "/" + name); +} + +SceneGraphNode * SceneGraphLoader::loadSceneGraphNode(tinyxml2::XMLElement *xmlnode, std::string name, SceneGraphNode *parent, const std::string &path) { + + assert(commonShaders_); + + std::string _loggerCat = "SceneGraphLoader::loadSceneGraphNode"; + + // the node + SceneGraphNode *thisNode = nullptr; + + // load the properties + tinyxml2::XMLElement* moduleElement = xmlnode; + if(moduleElement) { + + thisNode = new SceneGraphNode(); + + // load spice + getSpice(thisNode, parent, moduleElement->FirstChildElement( "spice" )); + + tinyxml2::XMLElement* renderableElement = moduleElement->FirstChildElement( "renderable" ); + if(renderableElement && renderableElement->Attribute("type")) { + std::string type = renderableElement->Attribute("type"); + if(type == "RenderableBody") { + + RenderableBody *renderable = nullptr; + + // load radius + pss radius; + + // the radii element takes priority when setting the radius + if( getRadii(&radius, renderableElement->FirstChildElement( "radii" )) || thisNode->getSpiceID() > 0) { + double radii[3]; + int n; + if(Spice::ref().getRadii(thisNode->getSpiceName(),radii,&n)) { + + // multiply with factor 1000, spice uses km as standard and Open Space uses m + radius = pss::CreatePSS(radii[0]*1000.0); + } else { + LERROR_SAFE("Tried to use spice raddi but failed for: " << name); + delete thisNode; + return nullptr; + } + } else { + LERROR_SAFE("Could not find radiiElement or spice id for: " << name << " " << thisNode->getSpiceID() ); + delete thisNode; + return nullptr; + } + + + LINFO_SAFE("Adding renderable: "<< name); + // load texture and shader + ghoul::opengl::Texture *texture = nullptr; + ghoul::opengl::ProgramObject *program = nullptr; + + tinyxml2::XMLElement* textureElement = renderableElement->FirstChildElement( "texture" ); + if(textureElement) { + if( ! getTexture(&texture, path, textureElement->FirstChildElement( "file" ))) { + LERROR_SAFE("Could not load texture " << name); + } + } else { + LERROR_SAFE("Could not find texture for: " << name); + } + + // load shader + if( ! getShader(&program, path, renderableElement->FirstChildElement( "shader" ))) { + LERROR_SAFE("Could not find shader for: " << name); + } + + if( ! texture || ! program) { + delete thisNode; + return nullptr; + } + + // create the renderable + renderable = new RenderableBody(radius); + renderable->setTexture(texture); + renderable->setProgramObject(program); + thisNode->setRenderable(renderable); + + } else if(type == "RenderablePlanet") { + + RenderablePlanet *renderable = nullptr; + + // load radius + pss radius; + + // the radii element takes priority when setting the radius + if( getRadii(&radius, renderableElement->FirstChildElement( "radii" )) || thisNode->getSpiceID() > 0) { + double radii[3]; + int n; + if(Spice::ref().getRadii(thisNode->getSpiceName(),radii,&n)) { + + // multiply with factor 1000, spice uses km as standard and Open Space uses m + radius = pss::CreatePSS(radii[0]*1000.0); + } else { + LERROR_SAFE("Tried to use spice raddi but failed for: " << name); + delete thisNode; + return nullptr; + } + } else { + LERROR_SAFE("Could not find radiiElement or spice id for: " << name << " " << thisNode->getSpiceID() ); + delete thisNode; + return nullptr; + } + + + LINFO_SAFE("Adding renderable: "<< name); + // load texture and shader + ghoul::opengl::Texture *texture = nullptr; + ghoul::opengl::ProgramObject *program = nullptr; + + tinyxml2::XMLElement* textureElement = renderableElement->FirstChildElement( "texture" ); + if(textureElement) { + if( ! getTexture(&texture, path, textureElement->FirstChildElement( "file" ))) { + LERROR_SAFE("Could not load texture " << name); + } + } else { + LERROR_SAFE("Could not find texture for: " << name); + } + + // load shader + if( ! getShader(&program, path, renderableElement->FirstChildElement( "shader" ))) { + LERROR_SAFE("Could not find shader for: " << name); + } + + if( ! texture || ! program) { + delete thisNode; + return nullptr; + } + + // create the renderable + renderable = new RenderablePlanet(radius); + renderable->setTexture(texture); + renderable->setProgramObject(program); + thisNode->setRenderable(renderable); + LINFO_SAFE("Adding renderablePlanet"); + } + } + + // set identifier and add to parent + thisNode->setName(name); + parent->addNode(thisNode); + return thisNode; + + } else { + LERROR_SAFE("Unable to open properties element"); + return nullptr; + } +} + + +bool SceneGraphLoader::getSpice(SceneGraphNode *node, SceneGraphNode *parent, tinyxml2::XMLElement *xmlnode) { + std::string _loggerCat = "SceneGraphLoader::getSpice"; + if(xmlnode && node) { + tinyxml2::XMLElement* identifierElement = xmlnode->FirstChildElement( "identifier" ); + if(identifierElement && identifierElement->Attribute("string")) { + std::string identifier = identifierElement->Attribute("string"); + + int spiceID; + int spiceIDFound; + Spice::ref().bod_NameToInt(identifierElement->Attribute("string"), &spiceID, &spiceIDFound); + if(spiceIDFound) { + + // The spice id exists, save the identifier + node->setSpiceName(identifier); + + int parentSpice = 0; // sun barycenter + if(parent) { + if( parent->getSpiceID() != 0) + parentSpice = parent->getSpiceID(); + } + node->setSpiceID(spiceID,parentSpice); + return true; + } else { + LERROR_SAFE("Could not find spice ID "); + } + } else { + LERROR_SAFE("Could not find spice identifier element in xml "); + } + } + return false; +} + +bool SceneGraphLoader::getRadii(pss *radii, tinyxml2::XMLElement *xmlnode) { + std::string _loggerCat = "SceneGraphLoader::getRadii"; + if(xmlnode ) { + double value = 0.0; + double power = 0.0; + if(xmlnode->Attribute("value")) { + value = xmlnode->DoubleAttribute("value"); + if(xmlnode->Attribute("power")) + power = xmlnode->DoubleAttribute("power"); + *radii = pss(value, power); + return true; + } + } + return false; +} + +bool SceneGraphLoader::getTexture(ghoul::opengl::Texture **texture, const std::string &path, tinyxml2::XMLElement *xmlnode) { + std::string _loggerCat = "SceneGraphLoader::getTexture"; + if(xmlnode && xmlnode->Attribute("path")) { + std::string texturePath = path + "/" + xmlnode->Attribute("path"); + *texture = ghoul::opengl::loadTexture(texturePath); + + // if textures where accessed, upload them to the graphics card. This check needs to be done to avoid crash. + if(texture) { + LINFO_SAFE("Uploading tetxure: "<< texturePath); + (*texture)->uploadTexture(); + //ghoul::opengl::Texture *tmp = new ghoul::opengl::Texture(*texture); + //texture = tmp; + return true; + } else { + LERROR_SAFE("Could not load texture: "<< texturePath); + } + } else { + LERROR_SAFE("Could not find file element"); + } + return false; +} + +bool SceneGraphLoader::getShader(ghoul::opengl::ProgramObject **program, const std::string &path, tinyxml2::XMLElement *xmlnode) { + std::string _loggerCat = "SceneGraphLoader::getShader"; + if( ! xmlnode) + return false; + + // use a common shader + if(xmlnode->IntAttribute("common") && xmlnode->Attribute( "identifier" )) { + std::string identifier = xmlnode->Attribute( "identifier" ); + std::map::iterator it; + it = commonShaders_->find(identifier); + if(it != commonShaders_->end()) { + *program = it->second; + return true; + } + + LERROR_SAFE("Could not find common shader: " << identifier); + return false; + + // load and return the shader + } else { + tinyxml2::XMLElement* glsl_vs = xmlnode->FirstChildElement( "vertex" ); + tinyxml2::XMLElement* glsl_fs = xmlnode->FirstChildElement( "fragment" ); + if(glsl_vs && glsl_fs) { + if(glsl_vs->Attribute("path") && glsl_fs->Attribute("path")) { + std::string vs_path = glsl_vs->Attribute("path"); + std::string fs_path = glsl_fs->Attribute("path"); + + vs_path = path + vs_path; + fs_path = path + fs_path; + ghoul::opengl::ProgramObject *programObject = new ghoul::opengl::ProgramObject(); + ghoul::opengl::ShaderObject *vs = new ghoul::opengl::ShaderObject(ghoul::opengl::ShaderObject::ShaderType::ShaderTypeVertex, vs_path); + ghoul::opengl::ShaderObject *fs = new ghoul::opengl::ShaderObject(ghoul::opengl::ShaderObject::ShaderType::ShaderTypeFragment, fs_path); + programObject->attachObject(vs); + programObject->attachObject(fs); + + // check for bindings + tinyxml2::XMLElement* bindings = xmlnode->FirstChildElement( "bindings" ); + if(bindings) { + + tinyxml2::XMLElement* attributes = bindings->FirstChildElement( "attribute" ); + for(;attributes; attributes = attributes->NextSiblingElement( "attribute" )) { + if(attributes->Attribute("name") && attributes->Attribute("position")) { + std::string name = attributes->Attribute("name"); + int position = attributes->IntAttribute("position"); + programObject->bindAttributeLocation(name,position); + } + } + tinyxml2::XMLElement* fragdata = bindings->FirstChildElement( "fragdata" ); + for(;fragdata; fragdata = fragdata->NextSiblingElement( "fragdata" )) { + if(fragdata->Attribute("name") && fragdata->Attribute("position")) { + std::string name = fragdata->Attribute("name"); + int position = fragdata->IntAttribute("position"); + programObject->bindFragDataLocation(name,position); + } + } + } + + if(programObject->compileShaderObjects()) { + if(programObject->linkProgramObject()) { + *program = programObject; + LINFO_SAFE("Common shader successfully loaded!"); + return true; + } else { + LERROR_SAFE("Common shader could not be linked!"); + } + } else { + LERROR_SAFE("Common shader could not be compiled!"); + } + + if(programObject) + delete programObject; + + return false; + } + } + } + + LERROR_SAFE("Could not load shader"); + return false; +} + +} // namespace openspace \ No newline at end of file diff --git a/src/scenegraph/scenegraphloader.h b/src/scenegraph/scenegraphloader.h new file mode 100644 index 0000000000..a6f372173c --- /dev/null +++ b/src/scenegraph/scenegraphloader.h @@ -0,0 +1,51 @@ +#ifndef SCENEGRAPHLOADER_H +#define SCENEGRAPHLOADER_H + +// open space includes +#include "object.h" +#include "scenegraph/scenegraphnode.h" + +// std includes +#include +#include +#include + +// ghoul includes +#include "ghoul/opengl/programobject.h" +#include "ghoul/opengl/texture.h" + +// sgct includes +#include "external/tinyxml2.h" + +namespace openspace { + +class SceneGraphLoader: public Object { +public: + + // constructors & destructor + SceneGraphLoader(std::vector *nodes, std::map *commonShaders); + ~SceneGraphLoader(); + + SceneGraphNode *loadSceneGraph(const std::string &path); + +private: + + SceneGraphNode *root_; + std::map *commonShaders_; + std::vector *nodes_; + + // private methods + void loadSceneGraphTree(tinyxml2::XMLElement* node, SceneGraphNode *current, const std::string &path); + SceneGraphNode * loadSceneGraphNodeFromFile(std::string name, SceneGraphNode *parent, const std::string &path); + SceneGraphNode * loadSceneGraphNode(tinyxml2::XMLElement *xmlnode, std::string name, SceneGraphNode *parent, const std::string &path); + + bool getSpice(SceneGraphNode *node,SceneGraphNode *parent, tinyxml2::XMLElement *xmlnode); + bool getRadii(pss *radii, tinyxml2::XMLElement *xmlnode); + bool getTexture(ghoul::opengl::Texture **texture, const std::string &path, tinyxml2::XMLElement *xmlnode); + bool getShader(ghoul::opengl::ProgramObject **program, const std::string &path, tinyxml2::XMLElement *xmlnode); + +}; + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/scenegraph/scenegraphnode.cpp b/src/scenegraph/scenegraphnode.cpp new file mode 100644 index 0000000000..52c2332385 --- /dev/null +++ b/src/scenegraph/scenegraphnode.cpp @@ -0,0 +1,257 @@ + +// open space includes +#include "scenegraph/scenegraphnode.h" +#include "util/spice.h" + +// ghoul includes +#include "ghoul/logging/logmanager.h" +#include "ghoul/logging/consolelog.h" + +namespace openspace { + +SceneGraphNode::SceneGraphNode() { + + nodeName_ = ""; + + // init pointers with nullptr + renderable_ = nullptr; + parent_ = nullptr; + boundingSphereVisible_ = false; + renderableVisible_ = false; + + // spice not used when spiceID_ is 0, 0 is the sun barycenter + spiceID_ = 0; + parentSpiceID_ = 0; +} + +SceneGraphNode::~SceneGraphNode() { + // logger string + std::string _loggerCat = "SceneGraphNode::~SceneGraphNode()"; + LDEBUG_SAFE("Deallocating: " << nodeName_); + + // deallocate the renderable + if(renderable_) + delete renderable_; + + // deallocate the child nodes and delete them, iterate c++11 style + for( auto &child: children_) { + delete child; + } + + // empty the vector + children_.erase (children_.begin(),children_.end()); +} + +// essential +void SceneGraphNode::update() { + + if(spiceID_ > 0) { + double state[3]; + //double orientation[3][3]; + Spice::ref().spk_getPosition(spiceID_, parentSpiceID_, state); + + // multiply with factor 1000, spice uses km as standard and Open Space uses m + position_ = psc::CreatePSC(state[0]*1000.0,state[1]*1000.0,state[2]*1000.0); + + // update rotation + //if(Spice::ref().spk_getOrientation(spiceName_,orientation)) { + // printf("%s\n",spiceName_); + // printf("%.5f %.5f %.5f \n", orientation[0][0], orientation[0][1], orientation[0][2]); + // printf("%.5f %.5f %.5f \n", orientation[1][0], orientation[1][1], orientation[1][2]); + // printf("%.5f %.5f %.5f \n", orientation[2][0], orientation[2][1], orientation[2][2]); + //} + } + + if(renderable_) { + renderable_->update(); + } +} + +void SceneGraphNode::evaluate(const Camera *camera, const psc & parentPosition) { + + const psc thisPosition = parentPosition + position_; + const psc toCamera = thisPosition - camera->getPosition(); + + // init as not visible + boundingSphereVisible_ = true; + renderableVisible_ = false; + + // check if camera is outside the node boundingsphere + if(toCamera.length() > boundingSphere_) { + + // check if the boudningsphere is visible before avaluating children + if( ! sphereInsideFrustum(thisPosition, boundingSphere_, camera)) { + // the node is completely outside of the camera view, stop evaluating this node + return; + } + + } + boundingSphereVisible_ = true; + // inside boudningsphere or parts of the sphere is visible, individual children needs to be evaluated + + // this node has an renderable + if(renderable_) { + + // check if the renderable boundingsphere is visible + renderableVisible_ = sphereInsideFrustum(thisPosition, renderable_->getBoundingSphere(), camera); + } + + // evaluate all the children, tail-recursive function(?) + for(auto &child: children_) { + child->evaluate(camera,thisPosition); + } + +} + +void SceneGraphNode::render(const Camera *camera, const psc & parentPosition) { + + const psc thisPosition = parentPosition + position_; + + // check if camera is outside the node boundingsphere + if( ! boundingSphereVisible_) { + return; + } + if(renderableVisible_) { + if (nodeName_ == "earth") + nodeName_ = nodeName_; + renderable_->render(camera,thisPosition); + } + + // evaluate all the children, tail-recursive function(?) + for(auto &child: children_) { + child->render(camera,thisPosition); + } + +} + +// set & get +void SceneGraphNode::addNode(SceneGraphNode *child) { + + // add a child node and set this node to be the parent + child->setParent(this); + children_.push_back(child); +} + +void SceneGraphNode::setName(const std::string &name) { + nodeName_ = name; +} + +void SceneGraphNode::setParent(SceneGraphNode *parent) { + parent_ = parent; +} + +void SceneGraphNode::setPosition(const psc &position) { + position_ = position; +} + +void SceneGraphNode::setSpiceID(const int spiceID, const int parentSpiceID) { + spiceID_ = spiceID; + parentSpiceID_ = parentSpiceID; + update(); +} + +void SceneGraphNode::setSpiceName(const std::string &name) { + spiceName_ = name; +} + +const int SceneGraphNode::getSpiceID() const { + return spiceID_; +} + +const std::string & SceneGraphNode::getSpiceName() { + return spiceName_; +} + +const psc &SceneGraphNode::getPosition() const { + return position_; +} + +psc SceneGraphNode::getWorldPosition() const { + + // recursive up the hierarchy if there are parents available + if(parent_) { + return position_ + parent_->getWorldPosition(); + } else { + return position_; + } +} + +// bounding sphere +pss SceneGraphNode::calculateBoundingSphere() { + + // set the vounding sphere to 0.0 + boundingSphere_ = 0.0; + + if(children_.size() > 0) { // node + pss maxChild; + + // loop though all children and find the one furthest away/with the largest bounding sphere + for(size_t i = 0; i < children_.size(); ++i) { + + // when positions is dynamix, change this part to fins the most distant position + pss child = children_.at(i)->getPosition().length() + children_.at(i)->calculateBoundingSphere(); + if(child > maxChild) { + maxChild = child; + } + } + boundingSphere_ += maxChild; + } else { // leaf + + // if has a renderable, use that boundingsphere + if(renderable_) + boundingSphere_ += renderable_->getBoundingSphere(); + } + + return boundingSphere_; +} + +// renderable +void SceneGraphNode::setRenderable(Renderable *renderable) { + renderable_ = renderable; + update(); +} + +const Renderable * SceneGraphNode::getRenderable() const{ + return renderable_; +} + +// private helper methods +bool SceneGraphNode::sphereInsideFrustum(const psc s_pos, const pss & s_rad, const Camera *camera) { + + // direction the camera is looking at in power scale + psc psc_camdir = psc(camera->getViewDirection()); + + // the position of the camera, moved backwards in the view direction to encapsulate the sphere radius + psc U = camera->getPosition() - psc_camdir * s_rad * ( 1.0 / camera->getSinMaxFov()); + + // the vector to the object from the new position + psc D = s_pos - U; + + // check if outside the maximum angle + if (nodeName_ == "earth") { + psc tmp = s_pos - camera->getPosition(); + + LINFOC("", "Angle: " << psc_camdir.angle(D)); + LINFOC("", "Pos: " << tmp.getVec4f()[0] << " " << tmp.getVec4f()[1] << " " << tmp.getVec4f()[2] << " " << tmp.getVec4f()[3]); + } + const double a = psc_camdir.angle(D); + if ( a < camera->getMaxFov()) + { + // center is inside K'' + D = s_pos - camera->getPosition(); + if ( D.length()* psc_camdir.length() *camera->getSinMaxFov() <= -psc_camdir.dot(D)) { + // center is inside K'' and inside K' + return D.length() <= s_rad; + } else { + // center is inside K'' and outside K' + return true; + } + } else { + // outside the maximum angle + return false; + } + +} + + +} // namespace openspace \ No newline at end of file diff --git a/src/scenegraph/scenegraphnode.h b/src/scenegraph/scenegraphnode.h new file mode 100644 index 0000000000..1e4ee82f5c --- /dev/null +++ b/src/scenegraph/scenegraphnode.h @@ -0,0 +1,75 @@ +#ifndef SCENEGRAPHNODE_H +#define SCENEGRAPHNODE_H + +// open space includes +#include "object.h" +#include "renderable.h" + +// std includes +#include +#include + +namespace openspace { + +class SceneGraphNode: public Object { +public: + + // constructors & destructor + SceneGraphNode(); + ~SceneGraphNode(); + + // essential + void update(); + void evaluate(const Camera *camera, const psc &parentPosition = psc()); + void render(const Camera *camera, const psc &parentPosition = psc()); + + // set & get + void addNode(SceneGraphNode *child); + void setName(const std::string &name); + void setParent(SceneGraphNode *parent); + void setPosition(const psc &position); + void setSpiceID(const int spiceID, const int parentSpiceID); + void setSpiceName(const std::string &name); + const int getSpiceID() const; + const std::string & getSpiceName(); + const psc& getPosition() const; + psc getWorldPosition() const; + + SceneGraphNode* parent() const { return parent_; } + + // bounding sphere + pss calculateBoundingSphere(); + + // renderable + void setRenderable(Renderable *renderable); + const Renderable * getRenderable() const; + +private: + + // essential + std::vector children_; + SceneGraphNode *parent_; + psc position_; + std::string nodeName_; + + // renderable + Renderable *renderable_; + bool renderableVisible_; + + // bounding sphere + bool boundingSphereVisible_; + pss boundingSphere_; + + // spice + std::string spiceName_; + int spiceID_; + int parentSpiceID_; + + // private helper methods + bool sphereInsideFrustum(const psc s_pos, const pss & s_rad, const Camera *camera); + +}; + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/util/geometry.cpp b/src/util/geometry.cpp new file mode 100644 index 0000000000..29227913b4 --- /dev/null +++ b/src/util/geometry.cpp @@ -0,0 +1,59 @@ +/** +Copyright (C) 2012-2014 Jonas Strandstedt + +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. +*/ + +// open space includes +#include "util/Geometry.h" + +gl4::Geometry::Geometry() +{ + +} +gl4::Geometry::~Geometry() +{ + +} +void gl4::Geometry::init() +{ + VBO::init(); + //LOG("Geometry Init()\n"); + + // if there is an geometry + if(_vsize > 0 && _isize > 0 && _varray != NULL && _iarray != NULL) { + + // calculate xyz max and mins + for (int i = 0; i < 3; ++i) + { + _limits[i][0] = _varray[0].location[i]; + _limits[i][1] = _varray[0].location[i]; + } + for (unsigned int i = 0; i < _vsize; ++i) + { + + for (unsigned int j = 0; j < 3; ++j) + { + if (_varray[i].location[j] < _limits[j][0]) + { + _limits[j][0] = _varray[i].location[j]; + } + if (_varray[i].location[j] < _limits[j][1]) + { + _limits[j][1] = _varray[i].location[j]; + } + } + } + } + +} + +glm::mat4 gl4::Geometry::getTransform() +{ + glm::mat4 transform = glm::translate(glm::mat4(1.0), _position); + return transform * _rotation; +} \ No newline at end of file diff --git a/src/util/geometry.h b/src/util/geometry.h new file mode 100644 index 0000000000..ec14f76f22 --- /dev/null +++ b/src/util/geometry.h @@ -0,0 +1,38 @@ +/** +Copyright (C) 2012-2014 Jonas Strandstedt + +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. +*/ +#ifndef GEOMETRY_H +#define GEOMETRY_H + +// open space includes +#include "util/VBO.h" + +namespace gl4 +{ + class Geometry : public VBO + { + public: + //initializers + Geometry(); + ~Geometry(); + + virtual void init(); + glm::mat4 getTransform(); + + private: + glm::vec2 _limits[3]; + glm::vec3 _position; + glm::mat4 _rotation; + protected: + std::string _texture; + glm::mat4 _transform; + }; +} + +#endif \ No newline at end of file diff --git a/src/util/planet.cpp b/src/util/planet.cpp new file mode 100644 index 0000000000..c9386b4f23 --- /dev/null +++ b/src/util/planet.cpp @@ -0,0 +1,169 @@ +/** +Copyright (C) 2012-2014 Jonas Strandstedt + +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. +*/ + +// open space includes +#include "util/Planet.h" + +// sgct includes +#include "sgct.h" + +// std includes +#include + +namespace openspace +{ + +Planet::Planet(pss radius, int levels) { + + // describe datatype and Vertex structure to the vbo template + std::vector > descriptor; + descriptor.push_back(std::make_tuple(4, GL_FLOAT, 0)); + descriptor.push_back(std::make_tuple(2, GL_FLOAT, 16)); + descriptor.push_back(std::make_tuple(3, GL_FLOAT, 24)); + + int vsize = levels * levels + 1; + int isize = 2 * levels * 3 + (levels -1) * (levels +1) * 6-3; + Vertex *varray = new Vertex[vsize]; + int *iarray = new int[isize]; + + // define PI + const float PI = 3.14159265f; + int nr = 0; + + // define top vertex + varray[nr].location[0] = 0.0f; + varray[nr].location[1] = static_cast(radius[0]); + varray[nr].location[2] = 0.0f; + varray[nr].location[3] = static_cast(radius[1]); + varray[nr].normal[0] = 0.0f; + varray[nr].normal[1] = 1.0f; + varray[nr].normal[2] = 0.0f; + varray[nr].tex[0] = 0.5f; + varray[nr].tex[1] = 1.0f; + + nr++; + for (int i = 1; i < levels; i++) + { + // define an extra vertex around the y-axis due to texture mapping + for (int j = 0; j <= levels; j++) + { + + float theta = static_cast(i)*PI/static_cast(levels); + float phi = static_cast(j)*PI*2.0f/static_cast(levels); + + float z = static_cast(radius[0]*cos(phi)*sin(theta)); + float x = static_cast(radius[0]*sin(phi)*sin(theta)); + float y = static_cast(radius[0]*cos(theta)); + + glm::vec3 normal = glm::vec3(x,y,z); + if (!(x == 0.f && y == 0.f && z == 0.f)) + normal = glm::normalize(normal); + + float t1 = static_cast(j)/static_cast(levels); + float t2 = 1.0f-static_cast(i)/static_cast(levels); + + varray[nr].location[0] = x; + varray[nr].location[1] = y; + varray[nr].location[2] = z; + varray[nr].location[3] = static_cast(radius[1]); + varray[nr].normal[0] = normal[0]; + varray[nr].normal[1] = normal[1]; + varray[nr].normal[2] = normal[2]; + + varray[nr].tex[0] = t1; + varray[nr].tex[1] = t2; + + nr++; + + } + } + // define bottom vertex + varray[nr].location[0] = 0.0f; + varray[nr].location[1] = static_cast(-radius[0]); + varray[nr].location[2] = 0.0f; + varray[nr].location[3] = static_cast(radius[1]); + varray[nr].normal[0] = 0.0f; + varray[nr].normal[1] = -1.0f; + varray[nr].normal[2] = 0.0f; + varray[nr].tex[0] = 0.5f; + varray[nr].tex[1] = 0.0f; + nr++; + + nr = 0; + // define indicies for top cap + for (int i = 0; i < levels; ++i) + { + iarray[nr] = 0; + nr++; + iarray[nr] = 1 + i; + nr++; + iarray[nr] = 2 + i; + nr++; + } + + // define indicies for middle + for (int i = 1; i < levels ; ++i) + { + for (int j = 0; j < levels; ++j) + { + iarray[nr] = (levels+1)*(i-1) + j +1; + nr++; + iarray[nr] = (levels+1)*i + 1 + j; + nr++; + iarray[nr] = (levels+1)*i+ 1 + j+1; + nr++; + + iarray[nr] = (levels+1)*(i-1) + j +2; + nr++; + iarray[nr] = (levels+1)*(i-1) + j +1; + nr++; + iarray[nr] = (levels+1)*i+ 1 + j+1; + nr++; + } + } + + // define indices for bottom cap + for (int i = 0; i < levels; ++i) + { + iarray[nr] = vsize - levels + i-2; + nr++; + iarray[nr] = vsize - levels + i -1; + nr++; + iarray[nr] = vsize -1; + nr++; + } + + + vbo = new VBO(descriptor, varray, vsize, iarray, isize); + vbo->init(); + + delete[] varray; + delete[] iarray; + +} + +Planet::~Planet() +{ + if(vbo) + delete vbo; +} + +void Planet::setHeightMap(const std::string &path) { + +} + +void Planet::render() { + assert(vbo); + vbo->render(); +} + + +} // namespace openspace + diff --git a/src/util/planet.h b/src/util/planet.h new file mode 100644 index 0000000000..f05a46abfe --- /dev/null +++ b/src/util/planet.h @@ -0,0 +1,49 @@ +/** +Copyright (C) 2012-2014 Jonas Strandstedt + +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. +*/ +#ifndef PLANET_H +#define PLANET_H + +// open space includes +#include "Object.h" +#include "util/Pss.h" +#include "util/VBO_template.h" + +// std includes +#include + +namespace openspace +{ + +typedef struct +{ + GLfloat location[4]; + GLfloat tex[2]; + GLfloat normal[3]; + GLubyte padding[28]; // Pads the struct out to 64 bytes for performance increase +} Vertex; + +class Planet +{ +public: + //initializers + Planet(pss radius, int levels = 4); + ~Planet(); + + void setHeightMap(const std::string &path); + void render(); + +private: + + VBO *vbo; +}; + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/util/psc.cpp b/src/util/psc.cpp new file mode 100644 index 0000000000..7fe3e352fd --- /dev/null +++ b/src/util/psc.cpp @@ -0,0 +1,279 @@ + +// open space includes +#include "util/Psc.h" +#include "util/Pss.h" + +// std includes +#include +#include +#include + +namespace openspace { + +psc::psc() { + +} + +psc::psc(const glm::vec4 &v) { + vec_ = glm::dvec4(v); +} + +psc::psc(const glm::dvec4 &v) { + vec_ = v; +} + +psc::psc(const glm::vec3 &v) { + vec_ = glm::dvec4(v[0],v[1],v[2],0.0); +} + +psc::psc(const glm::dvec3 &v) { + vec_ = glm::dvec4(v[0],v[1],v[2],0.0); +} + +psc::psc(const float &f1,const float &f2,const float &f3,const float &f4) { + vec_ = glm::dvec4(f1, f2, f3, f4); +} + +psc::psc(const double &d1,const double &d2,const double &d3,const double &d4) { + vec_ = glm::dvec4(d1, d2, d3, d4); +} + +psc psc::CreatePSC(double d1, double d2, double d3) { + char buff[30]; + + // find the number with maximum number of digits + double ad1 = abs(d1); + double ad2 = abs(d2); + double ad3 = abs(d3); + double max = (ad2 > ad1) ? ad2 : (ad3 > ad1) ? ad3 : ad1; + + // find out how many digits + sprintf ( buff, "%.0f", max); + unsigned int digits = static_cast(strlen(buff))-1; + + // rescale and return + double tp = 1.0 / pow(k, digits); + return psc(d1*tp, d2*tp, d3*tp, digits); +} + +void psc::print() const { + std::printf("[\n %f\n %f\n %f\n %f\n]\n",vec_[0], vec_[1], vec_[2], vec_[3]); +} +void psc::print(const char *name) const { + std::printf("%s = [\n %.15f\n %.15f\n %.15f\n %.15f\n]\n", name, vec_[0], vec_[1], vec_[2], vec_[3]); +} + +const double * psc::value_ptr() { + return glm::value_ptr(vec_); +} + +const float * psc::value_ptrf() { + // need existing variable to return pointer to, local variables perish.. + vecf_ = glm::vec4(vec_); + return glm::value_ptr(vecf_); +} + +glm::dvec4 psc::getVec4() const{ + return vec_; +} + +glm::vec4 psc::getVec4f() { + vecf_ = glm::vec4(vec_); + return vecf_; +} + +glm::dvec3 psc::getVec3() const { + return glm::dvec3(vec_[0]*pow(k,vec_[3]),vec_[1]*pow(k,vec_[3]),vec_[2]*pow(k,vec_[3])); +} + +glm::vec3 psc::getVec3f() { + return glm::vec3(vec_[0]*pow(k,vec_[3]),vec_[1]*pow(k,vec_[3]),vec_[2]*pow(k,vec_[3])); +} + +pss psc::length() const { + return pss(glm::length(glm::dvec3(vec_[0],vec_[1],vec_[2])),vec_[3]); +} + +glm::dvec3 psc::getDirection() const{ + if (vec_[0] == 0.0 && vec_[1] == 0.0 && vec_[2] == 0.0) + return glm::dvec3(0.0, 0.0, 1.0); + glm::dvec3 tmp(vec_[0],vec_[1],vec_[2]); + return glm::normalize(tmp); +} + +glm::vec3 psc::getDirectionf() const { + glm::vec3 tmp(vec_[0],vec_[1],vec_[2]); + return glm::normalize(tmp); +} + + +psc psc::mul(const glm::mat4 &m) const { + return mul(glm::dmat4(m)); +} +psc psc::mul(const glm::dmat4 &m) const { + glm::dvec4 tmp = m * vec_; + return psc(tmp[0],tmp[1],tmp[2],vec_[3]); +} + +psc& psc::operator=(const psc &rhs) { + if (this != &rhs){ + this->vec_ = rhs.vec_; + } + return *this; // Return a reference to myself. +} + +psc & psc::operator=(const glm::vec4 &rhs) { + this->vec_ = glm::dvec4(rhs); + return *this; // Return a reference to myself. +} + +psc & psc::operator=(const glm::vec3 &rhs) { + this->vec_ = glm::dvec4(rhs[0],rhs[1],rhs[2],0.0); + return *this; // Return a reference to myself. +} + +psc & psc::operator=(const glm::dvec4 &rhs) { + this->vec_ = rhs; + return *this; // Return a reference to myself. +} + +psc & psc::operator=(const glm::dvec3 &rhs) { + this->vec_ = glm::dvec4(rhs[0],rhs[1],rhs[2],0.0); + return *this; // Return a reference to myself. +} + +psc & psc::operator+=(const psc &rhs) { + + double ds = this->vec_[3] - rhs.vec_[3]; + if(ds >= 0) { + double p = pow(k,-ds); + *this = psc(rhs.vec_[0]*p + this->vec_[0], rhs.vec_[1]*p + this->vec_[1], rhs.vec_[2]*p + this->vec_[2], this->vec_[3]); + } else { + double p = pow(k,ds); + *this = psc(rhs.vec_[0] + this->vec_[0]*p, rhs.vec_[1] + this->vec_[1]*p, rhs.vec_[2] + this->vec_[2]*p, rhs.vec_[3]); + } + + return *this; +} + +const psc psc::operator+(const psc &rhs) const { + return psc(*this) += rhs; +} + +psc & psc::operator-=(const psc &rhs) { + + double ds = this->vec_[3] - rhs.vec_[3]; + if(ds >= 0) { + double p = pow(k,-ds); + *this = psc(-rhs.vec_[0]*p + this->vec_[0], -rhs.vec_[1]*p + this->vec_[1], -rhs.vec_[2]*p + this->vec_[2], this->vec_[3]); + } else { + double p = pow(k,ds); + *this = psc(-rhs.vec_[0] + this->vec_[0]*p, -rhs.vec_[1] + this->vec_[1]*p, -rhs.vec_[2] + this->vec_[2]*p, rhs.vec_[3]); + } + + return *this; +} + +const psc psc::operator*(const double &rhs) const { + return psc(vec_[0]*rhs,vec_[1]*rhs,vec_[2]*rhs,vec_[3]); +} + +const psc psc::operator*(const float &rhs) const { + return psc(vec_[0]*rhs,vec_[1]*rhs,vec_[2]*rhs,vec_[3]); +} + +psc& psc::operator*=(const pss &rhs) { + double ds = this->vec_[3] - rhs.vec_[1]; + if(ds >= 0) { + double p = pow(k,-ds); + *this = psc(rhs.vec_[0]*p * this->vec_[0], rhs.vec_[0]*p * this->vec_[1], rhs.vec_[0]*p * this->vec_[2], this->vec_[3] +this->vec_[3]); + } else { + double p = pow(k,ds); + *this = psc(rhs.vec_[0] * this->vec_[0]*p, rhs.vec_[0] * this->vec_[1]*p, rhs.vec_[0] * this->vec_[2]*p, rhs.vec_[1]+ rhs.vec_[1]); + } + return *this; +} + +const psc psc::operator*(const pss &rhs) const { + return psc(*this) *= rhs; +} + +const psc psc::operator-(const psc &rhs) const { + return psc(*this) -= rhs; +} + +double& psc::operator[](unsigned int idx) { + return vec_[idx]; +} +const double& psc::operator[](unsigned int idx) const { + return vec_[idx]; +} + +const double psc::dot(const psc &rhs) const { + double ds = this->vec_[3] - rhs.vec_[3]; + if(ds >= 0) { + double p = pow(k,-ds); + glm::dvec3 upscaled(rhs.vec_[0]*p,rhs.vec_[1]*p,rhs.vec_[2]*p); + glm::dvec3 shortened(vec_[0],vec_[1],vec_[2]); + return glm::dot(upscaled,shortened); + } else { + double p = pow(k,ds); + glm::dvec3 upscaled(vec_[0]*p,vec_[1]*p,vec_[2]*p); + glm::dvec3 shortened(rhs.vec_[0],rhs.vec_[1],rhs.vec_[2]); + return glm::dot(upscaled,shortened); + } +} + +const double psc::angle(const psc &rhs) const { + glm::dvec3 upscaled(rhs.vec_[0],rhs.vec_[1],rhs.vec_[2]); + glm::dvec3 shortened(vec_[0],vec_[1],vec_[2]); + upscaled = glm::normalize(upscaled); + shortened = glm::normalize(shortened); + + return acos(glm::dot(upscaled,shortened)); +} + +bool psc::operator==(const psc &other) const { + return vec_ == other.vec_; +} + +bool psc::operator<(const psc &other) const { + double ds = this->vec_[3] - other.vec_[3]; + if(ds >= 0) { + double p = pow(k,-ds); + glm::dvec3 upscaled(other.vec_[0]*p,other.vec_[1]*p,other.vec_[2]*p); + glm::dvec3 shortened(vec_[0],vec_[1],vec_[2]); + return glm::length(shortened) < glm::length(upscaled); + } else { + double p = pow(k,ds); + glm::dvec3 upscaled(vec_[0]*p,vec_[1]*p,vec_[2]*p); + glm::dvec3 shortened(other.vec_[0],other.vec_[1],other.vec_[2]); + return glm::length(shortened) < glm::length(upscaled); + } +} + +bool psc::operator>(const psc &other) const { + double ds = this->vec_[3] - other.vec_[3]; + if(ds >= 0) { + double p = pow(k,-ds); + glm::dvec3 upscaled(other.vec_[0]*p,other.vec_[1]*p,other.vec_[2]*p); + glm::dvec3 shortened(vec_[0],vec_[1],vec_[2]); + return glm::length(shortened) > glm::length(upscaled); + } else { + double p = pow(k,ds); + glm::dvec3 upscaled(vec_[0]*p,vec_[1]*p,vec_[2]*p); + glm::dvec3 shortened(other.vec_[0],other.vec_[1],other.vec_[2]); + return glm::length(shortened) > glm::length(upscaled); + } +} + +bool psc::operator<=(const psc &other) const { + return *this < other || *this == other; +} + +bool psc::operator>=(const psc &other) const { + return *this > other || *this == other; +} + + +} // namespace openspace diff --git a/src/util/psc.h b/src/util/psc.h new file mode 100644 index 0000000000..77b8cd56fd --- /dev/null +++ b/src/util/psc.h @@ -0,0 +1,98 @@ +#ifndef PSC_H +#define PSC_H + +// open space includes +#include "Object.h" + +// glm includes +#include +#include +#include + +namespace openspace +{ + +#define k 10.0 + +// forward declare the power scaled scalars +class pss; + +class psc: public Object { +public: + + // constructors + psc(); + psc(const glm::vec4 &v); + psc(const glm::dvec4 &v); + psc(const glm::vec3 &v); + psc(const glm::dvec3 &v); + psc(const float &f1,const float &f2,const float &f3,const float &f4); + psc(const double &d1,const double &d2,const double &d3,const double &d4); + + static psc CreatePSC(double d1, double d2, double d3); + + // print n' debug + void print() const; + void print(const char *name) const; + + // get functions + const double * value_ptr(); + const float * value_ptrf(); + glm::dvec4 getVec4() const; + glm::vec4 getVec4f(); + glm::dvec3 getVec3() const; + glm::vec3 getVec3f(); + pss length() const; + glm::dvec3 getDirection() const; + glm::vec3 getDirectionf() const; + + // multiplication + psc mul(const glm::mat4 &m) const; + psc mul(const glm::dmat4 &m) const; + + // operator overloading + psc & operator=(const psc &rhs); + psc & operator+=(const psc &rhs); + const psc operator+(const psc &rhs) const; + psc & operator-=(const psc &rhs); + const psc operator-(const psc &rhs) const; + double& operator[](unsigned int idx); + const double& operator[](unsigned int idx) const; + const double dot(const psc &rhs) const; + const double angle(const psc &rhs) const; + + // scalar operators + const psc operator*(const double &rhs) const; + const psc operator*(const float &rhs) const; + psc &operator*=(const pss &rhs); + const psc operator*(const pss &rhs) const; + + // comparasion + bool operator==(const psc &other) const; + bool operator<(const psc &other) const; + bool operator>(const psc &other) const; + bool operator<=(const psc &other) const; + bool operator>=(const psc &other) const; + + // glm integration + psc & operator=(const glm::vec4 &rhs); + psc & operator=(const glm::vec3 &rhs); + psc & operator=(const glm::dvec4 &rhs); + psc & operator=(const glm::dvec3 &rhs); + + // allow the power scaled scalars to acces private members + friend class pss; +private: + + // internal glm vector + glm::dvec4 vec_; + + // float vector used when returning float values + glm::vec4 vecf_; + +}; + + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/util/pss.cpp b/src/util/pss.cpp new file mode 100644 index 0000000000..787937bae8 --- /dev/null +++ b/src/util/pss.cpp @@ -0,0 +1,270 @@ + +// open space includes +#include "util/Pss.h" + +// std includes +#include +#include +#include + +namespace openspace { + +pss::pss() { + +} + +pss::pss(const glm::vec2 &v) { + vec_ = glm::dvec2(v); +} + +pss::pss(const glm::dvec2 &v) { + vec_ = v; +} + +pss::pss(const float &f1,const float &f2) { + vec_ = glm::dvec2(f1, f2); +} + +pss::pss(const double &d1,const double &d2) { + vec_ = glm::dvec2(d1, d2); +} + +pss pss::CreatePSS(double d1) { + char buff[30]; + + // find the number with maximum number of digits + double ad1 = abs(d1); + + // find out how many digits + sprintf ( buff, "%.0f", ad1); + unsigned int digits = static_cast(strlen(buff))-1; + + // rescale and return + double tp = 1.0 / pow(k, digits); + return pss(d1*tp, digits); +} + +void pss::print() const { + std::printf("[\n %f\n %f\n]\n",vec_[0], vec_[1]); +} +void pss::print(const char *name) const { + std::printf("%s = [\n %f\n %f\n]\n", name, vec_[0], vec_[1]); +} + +const double * pss::value_ptr() { + return glm::value_ptr(vec_); +} + +const float * pss::value_ptrf() { + // need existing variable to return pointer to, local variables perish.. + vecf_ = glm::vec2(vec_); + return glm::value_ptr(vecf_); +} + +glm::dvec2 pss::getVec2() const{ + return vec_; +} + +glm::vec2 pss::getVec2f() { + vecf_ = glm::vec2(vec_); + return vecf_; +} + +double pss::length() const { + return vec_[0] * pow(k,vec_[1]); +} + +float pss::lengthf() const { + return static_cast(vec_[0] * pow(k,vec_[1])); +} + +pss& pss::operator=(const pss &rhs) { + if (this != &rhs){ + this->vec_ = rhs.vec_; + } + return *this; // Return a reference to myself. +} + +pss & pss::operator=(const glm::vec2 &rhs) { + this->vec_ = glm::dvec2(rhs); + return *this; // Return a reference to myself. +} + +pss & pss::operator=(const float &rhs) { + this->vec_ = glm::dvec2(rhs,0.0); + return *this; // Return a reference to myself. +} + +pss & pss::operator=(const glm::dvec2 &rhs) { + this->vec_ = rhs; + return *this; // Return a reference to myself. +} + +pss & pss::operator=(const double&rhs) { + this->vec_ = glm::dvec2(rhs,0.0); + return *this; // Return a reference to myself. +} + +pss & pss::operator+=(const pss &rhs) { + + double ds = this->vec_[1] - rhs.vec_[1]; + if(ds >= 0) { + *this = pss(rhs.vec_[0]*pow(k,-ds) + this->vec_[0], this->vec_[1]); + } else { + *this = pss(rhs.vec_[0] + this->vec_[0]*pow(k,ds), rhs.vec_[1]); + } + + return *this; +} + +const pss pss::operator+(const pss &rhs) const { + return pss(*this) += rhs; +} + +pss & pss::operator-=(const pss &rhs) { + + double ds = this->vec_[1] - rhs.vec_[1]; + if(ds >= 0) { + *this = pss(-rhs.vec_[0]*pow(k,-ds) + this->vec_[0], this->vec_[1]); + } else { + *this = pss(-rhs.vec_[0] + this->vec_[0]*pow(k,ds), rhs.vec_[1]); + } + + return *this; +} + +const pss pss::operator-(const pss &rhs) const { + return pss(*this) -= rhs; +} + +pss & pss::operator*=(const pss &rhs) { + double ds = this->vec_[1] - rhs.vec_[1]; + if(ds >= 0) { + *this = pss(rhs.vec_[0]*pow(k,-ds) * this->vec_[0], this->vec_[1]+this->vec_[1]); + } else { + *this = pss(rhs.vec_[0] * this->vec_[0]*pow(k,ds), rhs.vec_[1]+rhs.vec_[1]); + } + + return *this; +} + + +const pss pss::operator*(const pss &rhs) const { + return pss(*this) *= rhs; +} + +pss & pss::operator*=(const double &rhs) { + double ds = this->vec_[1]; + if(ds >= 0) { + *this = pss(rhs*pow(k,-ds) * this->vec_[0], this->vec_[1]); + } else { + *this = pss(rhs * this->vec_[0]*pow(k,ds), 0.0); + } + + return *this; +} + + +const pss pss::operator*(const double &rhs) const { + return pss(*this) *= rhs; +} + +pss & pss::operator*=(const float &rhs) { + double ds = this->vec_[1]; + if(ds >= 0) { + *this = pss(rhs*pow(k,-ds) * this->vec_[0],this->vec_[1]+this->vec_[1]); + } else { + *this = pss(rhs * this->vec_[0]*pow(k,ds), 0.0); + } + + return *this; +} + +const pss pss::operator*(const float &rhs) const { + return pss(*this) *= rhs; +} + +double& pss::operator[](unsigned int idx) { + return vec_[idx]; +} +const double& pss::operator[](unsigned int idx) const { + return vec_[idx]; +} + +bool pss::operator==(const pss &other) const { + return vec_ == other.vec_; +} + +bool pss::operator<(const pss &other) const { + double ds = this->vec_[1] - other.vec_[1]; + if(ds >= 0) { + double upscaled = other.vec_[0]*pow(k,-ds); + return vec_[0] < upscaled; + } else { + double upscaled = vec_[0]*pow(k,-ds); + return other.vec_[0] > upscaled; + } +} + +bool pss::operator>(const pss &other) const { + double ds = this->vec_[1] - other.vec_[1]; + if(ds >= 0) { + double upscaled = other.vec_[0]*pow(k,-ds); + return vec_[0] > upscaled; + } else { + double upscaled = vec_[0]*pow(k,-ds); + return other.vec_[0] < upscaled; + } +} + +bool pss::operator<=(const pss &other) const { + return *this < other || *this == other; +} + +bool pss::operator>=(const pss &other) const { + return *this > other || *this == other; +} + +bool pss::operator==(const double &other) const { + double ds = this->vec_[1]; + if(ds >= 0) { + double upscaled = other*pow(k,-ds); + return vec_[0] == upscaled; + } else { + double upscaled = vec_[0]*pow(k,-ds); + return other == upscaled; + } +} + +bool pss::operator<(const double &other) const { + double ds = this->vec_[1]; + if(ds >= 0) { + double upscaled = other*pow(k,-ds); + return vec_[0] < upscaled; + } else { + double upscaled = vec_[0]*pow(k,-ds); + return other > upscaled; + } +} + +bool pss::operator>(const double &other) const { + double ds = this->vec_[1]; + if(ds >= 0) { + double upscaled = other*pow(k,-ds); + return vec_[0] > upscaled; + } else { + double upscaled = vec_[0]*pow(k,-ds); + return other < upscaled; + } +} + +bool pss::operator<=(const double &other) const { + return *this < other || *this == other; +} + +bool pss::operator>=(const double &other) const { + return *this > other || *this == other; +} + + +} // namespace openspace diff --git a/src/util/pss.h b/src/util/pss.h new file mode 100644 index 0000000000..0784bf6fb6 --- /dev/null +++ b/src/util/pss.h @@ -0,0 +1,92 @@ +#ifndef PSS_H +#define PSS_H + +// open space includes +#include "Object.h" + +// glm includes +#include +#include +#include + +namespace openspace +{ + +#define k 10.0 + +// forward declare the power scaled coordinates +class psc; + +class pss: public Object { +public: + + // constructors + pss(); + pss(const glm::vec2 &v); + pss(const glm::dvec2 &v); + pss(const float &f1,const float &f2); + pss(const double &d1,const double &d2); + static pss CreatePSS(double d1); + + // print n' debug + void print() const; + void print(const char *name) const; + + // get functions + const double * value_ptr(); + const float * value_ptrf(); + glm::dvec2 getVec2() const; + glm::vec2 getVec2f(); + double length() const; + float lengthf() const; + + // operator overloading + pss & operator=(const pss &rhs); + pss & operator+=(const pss &rhs); + const pss operator+(const pss &rhs) const; + pss & operator-=(const pss &rhs); + const pss operator-(const pss &rhs) const; + pss & operator*=(const pss &rhs); + const pss operator*(const pss &rhs) const; + pss & operator*=(const double &rhs); + const pss operator*(const double &rhs) const; + pss & operator*=(const float &rhs); + const pss operator*(const float &rhs) const; + double& operator[](unsigned int idx); + const double& operator[](unsigned int idx) const; + + // comparasion + bool operator==(const pss &other) const; + bool operator<(const pss &other) const; + bool operator>(const pss &other) const; + bool operator<=(const pss &other) const; + bool operator>=(const pss &other) const; + + bool operator==(const double &other) const; + bool operator<(const double &other) const; + bool operator>(const double &other) const; + bool operator<=(const double &other) const; + bool operator>=(const double &other) const; + + // glm integration + pss & operator=(const glm::vec2 &rhs); + pss & operator=(const float &rhs); + pss & operator=(const glm::dvec2 &rhs); + pss & operator=(const double &rhs); + + // allow the power scaled coordinates to acces private members + friend class psc; +private: + + // internal glm vector + glm::dvec2 vec_; + + // float vector used when returning float values + glm::vec2 vecf_; + +}; + + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/util/sphere.cpp b/src/util/sphere.cpp new file mode 100644 index 0000000000..dd7f4a1592 --- /dev/null +++ b/src/util/sphere.cpp @@ -0,0 +1,169 @@ +/** +Copyright (C) 2012-2014 Jonas Strandstedt + +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. +*/ + +// open space includes +#include "util/Sphere.h" + +gl4::Sphere::Sphere(float radius, int segments, bool tessellation) +{ + // use patches if using a tessellation shader + if (tessellation) + { + _mode = GL_PATCHES; + } else { + _mode = GL_TRIANGLES; + } + + // calculate and allocate memory for number of vertices and incicies + _vsize = segments * segments + 1; + _isize = 2 * segments * 3 + (segments -1) * (segments +1) * 6-3; + _varray = (Vertex*) std::malloc(_vsize*sizeof(Vertex)); + _iarray = (int*) std::malloc(_isize*sizeof(int)); + + + //LOG("Initializing sphere with:\n"); + //LOG(" segments = %d\n", segments); + //LOG(" radius = %f\n", radius); + //LOG(" _vsize = %d\n", _vsize); + //LOG(" _isize = %d\n", _isize); + + // define PI + const float PI = 3.14159265f; + int nr = 0; + + // define top vertex + _varray[nr].location[0] = 0.0f; + _varray[nr].location[1] = radius; + _varray[nr].location[2] = 0.0f; + _varray[nr].normal[0] = 0.0f; + _varray[nr].normal[1] = 1.0f; + _varray[nr].normal[2] = 0.0f; + _varray[nr].tex[0] = 0.5f; + _varray[nr].tex[1] = 1.0f; + _varray[nr].color[0] = 1.0f; + _varray[nr].color[1] = 0.0f; + _varray[nr].color[2] = 0.0f; + _varray[nr].color[3] = 1.0f; + _varray[nr].attribute[0] = 0.0f; + _varray[nr].attribute[1] = 0.0f; + _varray[nr].attribute[2] = 0.0f; + _varray[nr].float_attribute = 0.0f; + + nr++; + for (int i = 1; i < segments; i++) + { + // define an extra vertex around the y-axis due to texture mapping + for (int j = 0; j <= segments; j++) + { + + float theta = static_cast(i)*PI/static_cast(segments); + float phi = static_cast(j)*PI*2.0f/static_cast(segments); + + float z = radius*cos(phi)*sin(theta); + float x = radius*sin(phi)*sin(theta); + float y = radius*cos(theta); + + glm::vec3 normal = glm::normalize(glm::vec3(x,y,z)); + + float t1 = static_cast(j)/static_cast(segments); + float t2 = 1.0f-static_cast(i)/static_cast(segments); + + _varray[nr].location[0] = x; + _varray[nr].location[1] = y; + _varray[nr].location[2] = z; + _varray[nr].normal[0] = normal[0]; + _varray[nr].normal[1] = normal[1]; + _varray[nr].normal[2] = normal[2]; + + _varray[nr].tex[0] = t1; + _varray[nr].tex[1] = t2; + + _varray[nr].color[0] = 1.0f; + _varray[nr].color[1] = 0.0f; + _varray[nr].color[2] = 0.0f; + _varray[nr].color[3] = 1.0f; + _varray[nr].attribute[0] = 0.0f; + _varray[nr].attribute[1] = 0.0f; + _varray[nr].attribute[2] = 0.0f; + _varray[nr].float_attribute = 0.0f; + + nr++; + + } + } + // define bottom vertex + _varray[nr].location[0] = 0.0f; + _varray[nr].location[1] = -radius; + _varray[nr].location[2] = 0.0f; + _varray[nr].normal[0] = 0.0f; + _varray[nr].normal[1] = -1.0f; + _varray[nr].normal[2] = 0.0f; + _varray[nr].tex[0] = 0.5f; + _varray[nr].tex[1] = 0.0f; + _varray[nr].color[0] = 1.0f; + _varray[nr].color[1] = 0.0f; + _varray[nr].color[2] = 0.0f; + _varray[nr].color[3] = 1.0f; + _varray[nr].attribute[0] = 0.0f; + _varray[nr].attribute[1] = 0.0f; + _varray[nr].attribute[2] = 0.0f; + _varray[nr].float_attribute = 0.0f; + nr++; + + nr = 0; + // define indicies for top cap + for (int i = 0; i < segments; ++i) + { + _iarray[nr] = 0; + nr++; + _iarray[nr] = 1 + i; + nr++; + _iarray[nr] = 2 + i; + nr++; + } + + // define indicies for middle + for (int i = 1; i < segments ; ++i) + { + for (int j = 0; j < segments; ++j) + { + _iarray[nr] = (segments+1)*(i-1) + j +1; + nr++; + _iarray[nr] = (segments+1)*i + 1 + j; + nr++; + _iarray[nr] = (segments+1)*i+ 1 + j+1; + nr++; + + _iarray[nr] = (segments+1)*(i-1) + j +2; + nr++; + _iarray[nr] = (segments+1)*(i-1) + j +1; + nr++; + _iarray[nr] = (segments+1)*i+ 1 + j+1; + nr++; + } + } + + // define indices for bottom cap + for (int i = 0; i < segments; ++i) + { + _iarray[nr] = _vsize - segments + i-2; + nr++; + _iarray[nr] = _vsize - segments + i -1; + nr++; + _iarray[nr] = _vsize -1; + nr++; + } + +} + +gl4::Sphere::~Sphere() +{ + +} diff --git a/src/util/sphere.h b/src/util/sphere.h new file mode 100644 index 0000000000..ab9478ded4 --- /dev/null +++ b/src/util/sphere.h @@ -0,0 +1,29 @@ +/** +Copyright (C) 2012-2014 Jonas Strandstedt + +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. +*/ +#ifndef SPHERE_H +#define SPHERE_H + +// open space includes +#include "util/Geometry.h" + +namespace gl4 +{ + class Sphere: public Geometry + { + public: + //initializers + Sphere(float radius = 1.0f, int segments = 8, bool tessellation = false); + ~Sphere(); + + private: + }; +} + +#endif \ No newline at end of file diff --git a/src/util/spice.cpp b/src/util/spice.cpp new file mode 100644 index 0000000000..828d67609f --- /dev/null +++ b/src/util/spice.cpp @@ -0,0 +1,196 @@ + +// openspace stuff +#include "util/Spice.h" +#include "util/Time.h" +#include "util/Psc.h" +#include "InteractionHandler.h" + +// spice +#include "SpiceUsr.h" + +// other +#include +#include +#include "ghoul/logging/logmanager.h" +#include "ghoul/logging/consolelog.h" +#include + +namespace openspace { + +#define lenout 81 +#define shrtms_len 81 + +Spice* Spice::this_ = nullptr; + +Spice::Spice() { + + // logger string + std::string _loggerCat = "Spice::Spice()"; + + // print spice toolkit version + ConstSpiceChar * versn; + versn = tkvrsn_c( "TOOLKIT" ); + LINFO_SAFE("Spice Toolkit version: " << versn); + + // make the spice framework not exit on error + erract_c (const_cast("SET"), lenout, const_cast("RETURN")); + + // make spice print the errors to a log file + errdev_c (const_cast("SET"), lenout, const_cast("NULL") ); + +} + +Spice::~Spice() { + +} + +void Spice::init() { + assert( ! this_); + this_ = new Spice(); +} + +void Spice::deinit() { + assert(this_); + delete this_; + this_ = nullptr; +} + +Spice& Spice::ref() { + assert(this_); + return *this_; +} + +bool Spice::isInitialized() { + return this_ != nullptr; +} + +void Spice::loadDefaultKernels() { + assert(this_); + + // load + loadKernel(p("${BASE_PATH}/data/spice/de430_1850-2150.bsp")); + //Summary for: de430_1850-2150.bsp + //Bodies: MERCURY BARYCENTER (1) SATURN BARYCENTER (6) MERCURY (199) + // VENUS BARYCENTER (2) URANUS BARYCENTER (7) VENUS (299) + // EARTH BARYCENTER (3) NEPTUNE BARYCENTER (8) MOON (301) + // MARS BARYCENTER (4) PLUTO BARYCENTER (9) EARTH (399) + // JUPITER BARYCENTER (5) SUN (10) + // Start of Interval (ET) End of Interval (ET) + // ----------------------------- ----------------------------- + // 1849 DEC 26 00:00:00.000 2150 JAN 22 00:00:00.000 + + loadKernel(p("${BASE_PATH}/data/spice/pck00010.tpc")); +} + +bool Spice::loadKernel(const std::string &path) { + assert(this_); + + // ghoul logging + std::string _loggerCat = "Spice::loadKernel"; + + furnsh_c ( path.c_str() ); + int failed = failed_c(); + if(failed) { + char shrtms[shrtms_len]; + getmsg_c ( "SHORT", shrtms_len, shrtms ); + LERROR_SAFE("Error when loading kernel with path: " << path); + LERROR_SAFE("Spice reported: " << shrtms); + reset_c(); + } + return ( ! failed); +} + +void Spice::bod_NameToInt(const std::string & name, int *id, int *success) { + assert(this_); + bodn2c_c (name.c_str(), id, success); +} + +bool Spice::getRadii(const std::string & name, double radii[3], int *n) { + assert(this_); + + // ghoul logging + std::string _loggerCat = "Spice::getRadii"; + + bodvrd_c (name.c_str(), "RADII", 3, n, radii ); + int failed = failed_c(); + if(failed) { + char shrtms[shrtms_len]; + getmsg_c ( "SHORT", shrtms_len, shrtms ); + LERROR_SAFE("Error when fetching radii"); + LERROR_SAFE("Spice reported: " << shrtms); + reset_c(); + } + return ( ! failed); +} + +// has error checking +bool Spice::spk_getPosition(const std::string &target, const std::string &origin, double state[3]) { + assert(this_); + assert(Time::ref().isInitialized()); + + SpiceDouble et = Time::ref().getTime(); + SpiceDouble lt; + spkpos_c(target.c_str(), et, "J2000", "LT+S", origin.c_str(), state, <); + int failed = failed_c(); + if(failed) { + reset_c(); + } + return ( ! failed); +} + +// no error checking +void Spice::spk_getPosition(int target, int origin, double state[3]) { + assert(this_); + assert(Time::ref().isInitialized()); + + SpiceDouble et = Time::ref().getTime(); + SpiceDouble lt; + spkezp_c (target, et, "J2000", "NONE", origin, state, <); +} + +// has error checking +bool Spice::spk_getOrientation(const std::string &target, double state[3][3]) { + assert(this_); + assert(Time::ref().isInitialized()); + + // ghoul logging + std::string _loggerCat = "Spice::spk_getOrientation"; + + SpiceDouble et = Time::ref().getTime(); + std::string newname = "IAU_"; + newname += target; + pxform_c ( "J2000", newname.c_str(), et, state ); + int failed = failed_c(); + if(failed) { + char shrtms[shrtms_len]; + getmsg_c ( "SHORT", shrtms_len, shrtms ); + LERROR_SAFE("Error when fetching orientation"); + LERROR_SAFE("Spice reported: " << shrtms); + reset_c(); + } + return ( ! failed); +} + +/* +The following example retrieves radii for Mars and computes + orientation of the Mars body-fixed frame: + + SpiceDouble et; + SpiceDouble mat[3][3]; + SpiceDouble radii[3]; + SpiceInt n; + + furnsh_c ( "naif0008.tls" ); + furnsh_c ( "pck00008.tpc" ); + + // retrieve Mars radii + bodvrd_c ( "MARS", "RADII", 3, &n, radii ); + + // convert UTC to ET + str2et_c ( "2005-DEC-28 12:00", &et ); + + // compute Mars orientation relative to the J2000 frame + pxform_c ( "J2000", "IAU_MARS", et, mat ); +*/ + +} // namespace openspace diff --git a/src/util/spice.h b/src/util/spice.h new file mode 100644 index 0000000000..ae7f2e2039 --- /dev/null +++ b/src/util/spice.h @@ -0,0 +1,45 @@ +#ifndef SPICE_H +#define SPICE_H + +// open space includes +#include "Object.h" + +// std includes +#include + +namespace openspace +{ + +class Spice: public Object { +public: + virtual ~Spice(); + + static void init(); + static void deinit(); + static Spice& ref(); + static bool isInitialized(); + + void loadDefaultKernels(); + bool loadKernel(const std::string &path); + + void bod_NameToInt(const std::string &name, int *id, int *success); + bool getRadii(const std::string & name, double radii[3], int *n); + + bool spk_getPosition(const std::string &target, const std::string &origin, double state[3]); + void spk_getPosition(int target, int origin, double state[3]); + bool spk_getOrientation(const std::string &target, double state[3][3]); + +private: + static Spice* this_; + Spice(void); + Spice(const Spice& src); + Spice& operator=(const Spice& rhs); + + + +}; + + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/util/time.cpp b/src/util/time.cpp new file mode 100644 index 0000000000..f1b5e0f0dc --- /dev/null +++ b/src/util/time.cpp @@ -0,0 +1,62 @@ + +// open space includes +#include "util/Time.h" +#include "InteractionHandler.h" + +// std includes +#include + +// spice includes +#include "SpiceUsr.h" +#include + +namespace openspace { + +Time* Time::this_ = nullptr; + +Time::Time() { + time_ = 0.0; + + // load spice time kernel + furnsh_c (p("${BASE_PATH}/data/spice/naif0010.tls").c_str()); + + // convert UTC to ET + str2et_c ( "2006 JAN 31 01:00", &time_ ); +} + +Time::~Time() { + +} + +void Time::init() { + assert( ! this_); + this_ = new Time(); +} + +void Time::deinit() { + assert(this_); + delete this_; + this_ = nullptr; +} + +Time& Time::ref() { + assert(this_); + return *this_; +} + +bool Time::isInitialized() { + return this_ != nullptr; +} + +void Time::setTime(const char* stringTime) { + assert(this_); + // convert UTC to ET + str2et_c ( stringTime, &time_ ); +} + +double Time::getTime() { + assert(this_); + return time_; +} + +} // namespace openspace diff --git a/src/util/time.h b/src/util/time.h new file mode 100644 index 0000000000..eecd19a3ba --- /dev/null +++ b/src/util/time.h @@ -0,0 +1,35 @@ +#ifndef ENGINETIME_H +#define ENGINETIME_H + +// open space includes +#include "Object.h" + + +namespace openspace +{ + +class Time: public Object { +public: + virtual ~Time(); + + static void init(); + static void deinit(); + static Time& ref(); + static bool isInitialized(); + + void setTime(const char* stringTime); + double getTime(); + +private: + static Time* this_; + Time(void); + Time(const Time& src); + Time& operator=(const Time& rhs); + + double time_; +}; + + +} // namespace openspace + +#endif \ No newline at end of file diff --git a/src/util/vbo.cpp b/src/util/vbo.cpp new file mode 100644 index 0000000000..e558b6582e --- /dev/null +++ b/src/util/vbo.cpp @@ -0,0 +1,179 @@ +/** +Copyright (C) 2012-2014 Jonas Strandstedt + +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. +*/ + +// open space includes +#include "util/VBO.h" + +// ghoul includes +#include "ghoul/logging/logmanager.h" +#include "ghoul/logging/consolelog.h" + +// std includes +#include +#include +#include + +gl4::VBO::VBO() +{ + _vBufferID = 0; + _iBufferID = 0; + _vaoID = 0; + _isize = 0; + _vsize = 0; + _varray = NULL; + _iarray = NULL; + _mode = GL_POINTS; + _w = 1.0f; + _h = 1.0f; +} +gl4::VBO::~VBO() +{ + free(_varray); + free(_iarray); +} + +void gl4::VBO::init() +{ + + //ghoul logging + std::string _loggerCat = "VBO::init"; + + //LOG("VBO Init()\n"); + //LOG(" _vsize = %d\n", _vsize); + //LOG(" _isize = %d\n", _isize); + + // if arrays not set from sub-class initialize with a colored quad + if(_vsize == 0 || _isize == 0 || _varray == NULL || _iarray == NULL) { + + //LOG("VBO: Init color quad\n"); + _mode = GL_TRIANGLES; + + _vsize = 4; + _isize = 6; + _varray = (Vertex*) std::malloc(_vsize*sizeof(Vertex)); + _iarray = (int*) std::malloc(_isize*sizeof(int)); + + _varray[0].location[0] = 0.0f; + _varray[0].location[1] = 0.0f; + _varray[0].location[2] = 0.0f; + _varray[1].location[0] = _w; + _varray[1].location[1] = 0.0f; + _varray[1].location[2] = 0.0f; + _varray[2].location[0] = 0.0f; + _varray[2].location[1] = _h; + _varray[2].location[2] = 0.0f; + _varray[3].location[0] = _w; + _varray[3].location[1] = _h; + _varray[3].location[2] = 0.0f; + + _varray[0].tex[0] = 0.0f; + _varray[0].tex[1] = 0.0f; + _varray[1].tex[0] = 1.0f; + _varray[1].tex[1] = 0.0f; + _varray[2].tex[0] = 0.0f; + _varray[2].tex[1] = 1.0f; + _varray[3].tex[0] = 1.0f; + _varray[3].tex[1] = 1.0f; + + _iarray[0] = 0; + _iarray[1] = 1; + _iarray[2] = 2; + _iarray[3] = 2; + _iarray[4] = 1; + _iarray[5] = 3; + + for (int i = 0; i < 4; ++i) + { + _varray[i].normal[0] = 1.0f; + _varray[i].normal[1] = 0.0f; + _varray[i].normal[2] = 0.0f; + _varray[i].color[3] = 1.0f; + _varray[i].attribute[0] = 1.0f; + _varray[i].attribute[1] = 0.0f; + _varray[i].attribute[2] = 0.0f; + _varray[i].float_attribute = 0.0f; + } + // red + _varray[0].color[0] = 1.0f; + _varray[0].color[1] = 0.0f; + _varray[0].color[2] = 0.0f; + + // green + _varray[1].color[0] = 0.0f; + _varray[1].color[1] = 1.0f; + _varray[1].color[2] = 0.0f; + + // blue + _varray[2].color[0] = 0.0f; + _varray[2].color[1] = 0.0f; + _varray[2].color[2] = 1.0f; + + // white + _varray[3].color[0] = 1.0f; + _varray[3].color[1] = 1.0f; + _varray[3].color[2] = 1.0f; + + } + + GLuint errorID = glGetError(); + glGenVertexArrays(1, &_vaoID); + + // First VAO setup + glBindVertexArray(_vaoID); + + glGenBuffers(1, &_vBufferID); + + glBindBuffer(GL_ARRAY_BUFFER, _vBufferID); + glBufferData(GL_ARRAY_BUFFER, _vsize*sizeof(Vertex), _varray, GL_STATIC_DRAW); + + glVertexAttribPointer(0, 3, GL_FLOAT, GL_FALSE, sizeof(Vertex), BUFFER_OFFSET(0)); + glEnableVertexAttribArray(0); + glVertexAttribPointer(1, 2, GL_FLOAT, GL_FALSE, sizeof(Vertex), BUFFER_OFFSET(12)); + glEnableVertexAttribArray(1); + glVertexAttribPointer(2, 3, GL_FLOAT, GL_FALSE, sizeof(Vertex), BUFFER_OFFSET(20)); + glEnableVertexAttribArray(2); + glVertexAttribPointer(3, 4, GL_FLOAT, GL_FALSE, sizeof(Vertex), BUFFER_OFFSET(32)); + glEnableVertexAttribArray(3); + glVertexAttribPointer(4, 3, GL_FLOAT, GL_FALSE, sizeof(Vertex), BUFFER_OFFSET(48)); + glEnableVertexAttribArray(4); + glVertexAttribPointer(5, 1, GL_FLOAT, GL_FALSE, sizeof(Vertex), BUFFER_OFFSET(60)); + glEnableVertexAttribArray(5); + + glGenBuffers(1, &_iBufferID); + glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, _iBufferID); + glBufferData(GL_ELEMENT_ARRAY_BUFFER, _isize*sizeof(int), _iarray, GL_STATIC_DRAW); + + if(_vBufferID == 0) + { + LERROR_SAFE("Vertex buffer not initialized"); + } + if(_iBufferID == 0) + { + LERROR_SAFE("Index buffer not initialized"); + } + + glBindVertexArray(0); + + errorID = glGetError(); + if(errorID != GL_NO_ERROR) + { + LERROR_SAFE("OpenGL error: " << glewGetErrorString(errorID)); + LERROR_SAFE("Attempting to proceed anyway. Expect rendering errors or a crash."); + } + +} + +void gl4::VBO::render() +{ + glBindVertexArray(_vaoID); // select first VAO + glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, _iBufferID); + glDrawElements(_mode, _isize, GL_UNSIGNED_INT, BUFFER_OFFSET(0)); + glBindVertexArray(0); +} \ No newline at end of file diff --git a/src/util/vbo.h b/src/util/vbo.h new file mode 100644 index 0000000000..8d2c8b2026 --- /dev/null +++ b/src/util/vbo.h @@ -0,0 +1,63 @@ +/** +Copyright (C) 2012-2014 Jonas Strandstedt + +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. +*/ +#ifndef VBO_H +#define VBO_H + +// sgct includes +#include "sgct.h" + + +#define BUFFER_OFFSET(i) ((char *)NULL + (i)) + +typedef struct +{ + GLfloat location[3]; + GLfloat tex[2]; + GLfloat normal[3]; + GLfloat color[4]; + GLfloat attribute[3]; + GLfloat float_attribute; + //GLubyte padding[4]; // Pads the struct out to 64 bytes for performance increase +} Vertex; + +namespace gl4 +{ + class VBO + { + public: + //initializers + VBO(); + ~VBO(); + + // init VBO + virtual void init(); + void setProportions(float w, float h) { _w = w; _h = h;}; + + // render + void render(); + private: + + GLuint _vaoID; + GLuint _vBufferID; + GLuint _iBufferID; + float _w; + float _h; + + protected: + // arrays with all triangles and indices + GLenum _mode; + unsigned int _isize; + unsigned int _vsize; + Vertex *_varray; + int *_iarray; + }; +} + +#endif \ No newline at end of file diff --git a/src/util/vbo_template.h b/src/util/vbo_template.h new file mode 100644 index 0000000000..89afc6f6c3 --- /dev/null +++ b/src/util/vbo_template.h @@ -0,0 +1,110 @@ +/** +Copyright (C) 2012-2014 Jonas Strandstedt + +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. +*/ +#ifndef VBOTEMPLATE_H +#define VBOTEMPLATE_H + +// std includes +#include +#include +#include + +// sgct includes +#include "ghoul/logging/consolelog.h" + +// sgct includes +#include "sgct.h" + + +#define BUFFER_OFFSET(i) ((char *)NULL + (i)) + +namespace openspace +{ + +template +class VBO { +public: + //initializers + VBO(const std::vector > descriptor, T *varray, int vsize, int *iarray, int isize): descriptor_(descriptor), isize_(isize), vsize_(vsize), varray_(varray), iarray_(iarray) { + static_assert(std::is_pod::value, "Template typename should be a POD"); + vBufferID_ = 0; + iBufferID_ = 0; + vaoID_ = 0; + } + ~VBO() {}; + + // init VBO + void init() { + + //ghoul logging + std::string _loggerCat = "VBO::init"; + + GLuint errorID = glGetError(); + glGenVertexArrays(1, &vaoID_); + + // First VAO setup + glBindVertexArray(vaoID_); + + glGenBuffers(1, &vBufferID_); + + glBindBuffer(GL_ARRAY_BUFFER, vBufferID_); + glBufferData(GL_ARRAY_BUFFER, vsize_*sizeof(T), varray_, GL_STATIC_DRAW); + + + for(size_t i = 0; i < descriptor_.size(); ++i) { + glVertexAttribPointer(i,std::get<0>(descriptor_.at(i)), std::get<1>(descriptor_.at(i)), GL_FALSE, sizeof(T), BUFFER_OFFSET(std::get<2>(descriptor_.at(i)))); + glEnableVertexAttribArray(i); + } + + glGenBuffers(1, &iBufferID_); + glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, iBufferID_); + glBufferData(GL_ELEMENT_ARRAY_BUFFER, isize_*sizeof(int), iarray_, GL_STATIC_DRAW); + + if(vBufferID_ == 0) { + LERROR_SAFE("Vertex buffer not initialized"); + } + if(iBufferID_ == 0) { + LERROR_SAFE("Index buffer not initialized"); + } + + glBindVertexArray(0); + + errorID = glGetError(); + if(errorID != GL_NO_ERROR) + { + LERROR_SAFE("OpenGL error: " << glewGetErrorString(errorID)); + LERROR_SAFE("Attempting to proceed anyway. Expect rendering errors or a crash."); + } + + }; + + // render + void render() { + glBindVertexArray(vaoID_); // select first VAO + glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, iBufferID_); + glDrawElements(GL_TRIANGLES, isize_, GL_UNSIGNED_INT, BUFFER_OFFSET(0)); + glBindVertexArray(0); + }; +private: + + GLuint vaoID_; + GLuint vBufferID_; + GLuint iBufferID_; + + unsigned int isize_; + unsigned int vsize_; + + std::vector > descriptor_; + T *varray_; + int *iarray_; +}; + +} // namespace openspace + +#endif \ No newline at end of file