/* $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_ */
/* $Procedure SAELGV ( Semi-axes of ellipse from generating vectors ) */
/* Subroutine */ int saelgv_(doublereal *vec1, doublereal *vec2, doublereal *
smajor, doublereal *sminor)
{
/* System generated locals */
integer i__1, i__2;
doublereal d__1, d__2;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer);
/* Local variables */
extern doublereal vdot_(doublereal *, doublereal *);
doublereal c__[4] /* was [2][2] */;
integer i__;
doublereal s[4] /* was [2][2] */, scale;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer major;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
vlcom_(doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *);
integer minor;
extern doublereal vnorm_(doublereal *);
extern /* Subroutine */ int diags2_(doublereal *, doublereal *,
doublereal *);
doublereal tmpvc1[3], tmpvc2[3];
extern /* Subroutine */ int cleard_(integer *, doublereal *);
doublereal eigval[4] /* was [2][2] */;
extern /* Subroutine */ int chkout_(char *, ftnlen), vsclip_(doublereal *,
doublereal *);
extern logical return_(void);
/* $ 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 */
/* $ Declarations */
/* $ 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. */
/* $ 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 */
/* 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.D0, 1.D0, 1.D0 ) */
/* VEC2 = ( 1.D0, -1.D0, 1.D0 ) */
/* The subroutine call */
/* CALL SAELGV ( VEC1, VEC2, SMAJOR, SMINOR ) */
/* returns */
/* SMAJOR = ( -1.414213562373095D0, */
/* 0.0D0, */
/* -1.414213562373095D0 ) */
/* and */
/* SMINOR = ( -2.4037033579794549D-17 */
/* 1.414213562373095D0, */
/* -2.4037033579794549D-17 ) */
/* 2) This example is taken from the code of the SPICELIB routine */
/* PJELPL, 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. */
/* C */
/* C Project vectors defining axes of ellipse onto plane. */
/* C */
/* CALL VPERP ( VEC1, NORMAL, PROJ1 ) */
/* CALL VPERP ( VEC2, NORMAL, PROJ2 ) */
/* . */
/* . */
/* . */
/* CALL SAELGV ( PROJ1, PROJ2, SMAJOR, SMINOR ) */
/* The call to SAELGV 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 */
/* - 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, 02-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VSCL 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) (WLT) */
/* -& */
/* $ Index_Entries */
/* semi-axes of ellipse from generating vectors */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 02-SEP-2005 (NJB) */
/* Updated to remove non-standard use of duplicate arguments */
/* in VSCL calls. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SAELGV", (ftnlen)6);
}
/* 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(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_ */
/* $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_ */
/* $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_ */
/* $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)
{
/* Initialized data */
static logical first = TRUE_;
/* 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 *), zznamfrm_(integer *, char *,
integer *, char *, integer *, ftnlen, ftnlen), zzctruin_(integer
*);
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;
static char svref[32];
doublereal stemp[6];
integer ctpos;
doublereal vtemp[6];
extern doublereal vnorm_(doublereal *);
extern /* Subroutine */ int bodc2n_(integer *, char *, logical *, ftnlen);
static integer svctr1[2];
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 integer isrchi_(integer *, integer *, integer *);
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen);
static integer svrefi;
extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), prefix_(
char *, integer *, char *, ftnlen, 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) */
/* -& */
/* $ Abstract */
/* This include file defines the dimension of the counter */
/* array used by various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, 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 */
/* CTRSIZ is the dimension of the counter array used by */
/* various SPICE subsystems to uniquely identify */
/* changes in their states. */
/* $ Author_and_Institution */
/* B.V. Semenov (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.0, 29-JUL-2013 (BVS) */
/* -& */
/* End of include file. */
/* $ 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 I */
/* CHARACTER*(20) UTC */
/* DOUBLE PRECISION BEGIN */
/* DOUBLE PRECISION DELTA */
/* DOUBLE PRECISION END */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION POS ( 3 ) */
/* DOUBLE PRECISION LT */
/* DOUBLE PRECISION VNORM */
/* C */
/* C Load the binary SPK ephemeris file. */
/* C */
/* CALL FURNSH ( 'SAMPLE.BSP' ) */
/* . */
/* . */
/* . */
/* 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 */
/* N.J. Bachman (JPL) */
/* B.V. Semenov (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 08-JAN-2014 (BVS) */
/* Updated to save the input frame name and POOL state counter */
/* and to do frame name-ID conversion only if the counter has */
/* changed. */
/* Updated to map the input frame name to its ID by first calling */
/* ZZNAMFRM, and then calling IRFNUM. The side effect of this */
/* change is that now the frame with the fixed name 'DEFAULT' */
/* that can be associated with any code via CHGIRF's entry point */
/* IRFDEF will be fully masked by a frame with indentical name */
/* defined via a text kernel. Previously the CHGIRF's 'DEFAULT' */
/* frame masked the text kernel frame with the same name. */
/* Replaced SPKLEF with FURNSH and fixed errors in Examples. */
/* - 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. */
/* Saved frame name length. */
/* Local variables */
/* Saved frame name/ID item declarations. */
/* Saved frame name/ID items. */
/* Initial values. */
/* In-line Function Definitions */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPKGPS", (ftnlen)6);
}
/* Initialization. */
if (first) {
/* Initialize counter. */
zzctruin_(svctr1);
first = FALSE_;
}
/* 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 the upgrade to use hashes and counter bypass ZZNAMFRM */
/* became more efficient in looking up frame IDs than IRFNUM. So the */
/* original order of calls "IRFNUM first, NAMFRM second" was */
/* switched to "ZZNAMFRM first, IRFNUM second". */
/* The call to IRFNUM, now redundant for built-in inertial frames, */
/* was preserved to for a sole reason -- to still support the */
/* ancient and barely documented ability for the users to associate */
/* a frame with the fixed name 'DEFAULT' with any CHGIRF inertial */
/* frame code via CHGIRF's entry point IRFDEF. */
/* Note that in the case of ZZNAMFRM's failure to resolve name and */
/* IRFNUM's success to do so, the code returned by IRFNUM for */
/* 'DEFAULT' frame is *not* copied to the saved code SVREFI (which */
/* would be set to 0 by ZZNAMFRM) to make sure that on subsequent */
/* calls ZZNAMFRM does not do a bypass (as SVREFI always forced look */
/* up) and calls IRFNUM again to reset the 'DEFAULT's frame ID */
/* should it change between the calls. */
zznamfrm_(svctr1, svref, &svrefi, ref, &refid, (ftnlen)32, ref_len);
if (refid == 0) {
irfnum_(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)603)] = *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)606)]);
while(found && i__ < 20 && ctarg[(i__1 = i__ - 1) < 20 && 0 <= i__1 ?
i__1 : s_rnge("ctarg", i__1, "spkgps_", (ftnlen)608)] != *obs &&
ctarg[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("ctarg",
i__2, "spkgps_", (ftnlen)608)] != 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)617)], 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)
627)], &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ?
i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)627)], &
ctarg[(i__3 = i__ - 1) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"ctarg", i__3, "spkgps_", (ftnlen)627)]);
/* 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)762)] == cobs) {
ctpos = nct;
cframe = tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)764)];
} 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)960)] == tframe[(i__3 = i__) < 20
&& 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spkgps_", (
ftnlen)960)]) {
vadd_(&starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 :
s_rnge("starg", i__2, "spkgps_", (ftnlen)962)], &starg[(
i__3 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__3 ? i__3 :
s_rnge("starg", i__3, "spkgps_", (ftnlen)962)], 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)
963)]);
} else if (tframe[(i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge(
"tframe", i__3, "spkgps_", (ftnlen)965)] > 0 && tframe[(i__3 =
i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe", i__3, "spk"
"gps_", (ftnlen)965)] <= 21 && tframe[(i__2 = i__ - 1) < 20 &&
0 <= i__2 ? i__2 : s_rnge("tframe", i__2, "spkgps_", (ftnlen)
965)] > 0 && tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2
: s_rnge("tframe", i__2, "spkgps_", (ftnlen)965)] <= 21) {
irfrot_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 :
s_rnge("tframe", i__2, "spkgps_", (ftnlen)967)], &tframe[(
i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe",
i__3, "spkgps_", (ftnlen)967)], rot);
mxv_(rot, &starg[(i__2 = i__ * 6 - 6) < 120 && 0 <= i__2 ? i__2 :
s_rnge("starg", i__2, "spkgps_", (ftnlen)968)], stemp);
vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2
? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)969)],
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)
970)]);
} else {
refchg_(&tframe[(i__2 = i__ - 1) < 20 && 0 <= i__2 ? i__2 :
s_rnge("tframe", i__2, "spkgps_", (ftnlen)974)], &tframe[(
i__3 = i__) < 20 && 0 <= i__3 ? i__3 : s_rnge("tframe",
i__3, "spkgps_", (ftnlen)974)], 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)981)],
stemp);
vadd_(stemp, &starg[(i__2 = (i__ + 1) * 6 - 6) < 120 && 0 <= i__2
? i__2 : s_rnge("starg", i__2, "spkgps_", (ftnlen)982)],
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)
983)]);
}
}
/* 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)996)] == cframe) {
vsub_(&starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)998)], sobs, pos);
} else if (tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
"tframe", i__1, "spkgps_", (ftnlen)1000)] == 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)1031)], 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)
1034)] > 0 && tframe[(i__1 = ctpos - 1) < 20 && 0 <= i__1 ? i__1 :
s_rnge("tframe", i__1, "spkgps_", (ftnlen)1034)] <= 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)1040)], &cframe, rot);
mxv_(rot, &starg[(i__1 = ctpos * 6 - 6) < 120 && 0 <= i__1 ? i__1 :
s_rnge("starg", i__1, "spkgps_", (ftnlen)1041)], 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)1048)], &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)1055)], 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_ */
/* $Procedure SPKCPT ( SPK, constant position target state ) */
/* Subroutine */ int spkcpt_(doublereal *trgpos, char *trgctr, char *trgref,
doublereal *et, char *outref, char *refloc, char *abcorr, char *
obsrvr, doublereal *state, doublereal *lt, ftnlen trgctr_len, ftnlen
trgref_len, ftnlen outref_len, ftnlen refloc_len, ftnlen abcorr_len,
ftnlen obsrvr_len)
{
extern /* Subroutine */ int vequ_(doublereal *, doublereal *), chkin_(
char *, ftnlen), cleard_(integer *, doublereal *);
doublereal trgepc;
extern /* Subroutine */ int chkout_(char *, ftnlen);
doublereal trgsta[6];
extern /* Subroutine */ int spkcvt_(doublereal *, doublereal *, char *,
char *, doublereal *, char *, char *, char *, char *, doublereal *
, doublereal *, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Return the state, relative to a specified observer, of a target */
/* having constant position in a specified reference frame. The */
/* target's position is provided by the calling program rather than */
/* by loaded SPK 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 */
/* FRAMES */
/* PCK */
/* SPK */
/* TIME */
/* $ 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 */
/* -------- --- -------------------------------------------------- */
/* TRGPOS I Target position relative to center of motion. */
/* TRGCTR I Center of motion of target. */
/* TRGREF I Frame of target position. */
/* ET I Observation epoch. */
/* OUTREF I Reference frame of output state. */
/* REFLOC I Output reference frame evaluation locus. */
/* ABCORR I Aberration correction. */
/* OBSRVR I Name of observing ephemeris object. */
/* STATE O State of target with respect to observer. */
/* LT O One way light time between target and */
/* observer. */
/* $ Detailed_Input */
/* TRGPOS is the fixed (constant) geometric position of a */
/* target relative to its "center of motion" TRGCTR, */
/* expressed in the reference frame TRGREF. */
/* Units are always km. */
/* TRGCTR is the name of the center of motion of TRGPOS. The */
/* ephemeris of TRGCTR is provided by loaded SPK files. */
/* 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 center of motion. */
/* Case and leading and trailing blanks are not */
/* significant in the string TRGCTR. */
/* TRGREF is the name of the reference frame relative to which */
/* the input position TRGPOS is expressed. The target has */
/* constant position relative to its center of motion */
/* in this reference frame. */
/* Case and leading and trailing blanks are not */
/* significant in the string TRGREF. */
/* ET is the ephemeris time at which the state of the */
/* target relative to the observer is to be */
/* computed. ET is expressed as seconds past J2000 TDB. */
/* ET refers to time at the observer's location. */
/* OUTREF is the name of the reference frame with respect to */
/* which the output state is expressed. */
/* When OUTREF is time-dependent (non-inertial), its */
/* orientation relative to the J2000 frame is evaluated */
/* in the manner commanded by the input argument REFLOC */
/* (see description below). */
/* Case and leading and trailing blanks are not */
/* significant in the string OUTREF. */
/* REFLOC is a string indicating the output reference frame */
/* evaluation locus: this is the location associated */
/* with the epoch at which this routine is to evaluate */
/* the orientation, relative to the J2000 frame, of the */
/* output frame OUTREF. The values and meanings of */
/* REFLOC are: */
/* 'OBSERVER' Evaluate OUTREF at the observer's */
/* epoch ET. */
/* Normally the locus 'OBSERVER' should */
/* be selected when OUTREF is centered */
/* at the observer. */
/* 'TARGET' Evaluate OUTREF at the target epoch; */
/* letting LT be the one-way light time */
/* between the target and observer, the */
/* target epoch is */
/* ET-LT if reception aberration */
/* corrections are used */
/* ET+LT if transmission aberration */
/* corrections are used */
/* ET if no aberration corrections */
/* are used */
/* Normally the locus 'TARGET' should */
/* be selected when OUTREF is TRGREF, */
/* the frame in which the target position */
/* is specified. */
/* 'CENTER' Evaluate the frame OUTREF at the epoch */
/* associated its center. This epoch, */
/* which we'll call ETCTR, is determined */
/* as follows: */
/* Let LTCTR be the one-way light time */
/* between the observer and the center */
/* of OUTREF. Then ETCTR is */
/* ET-LTCTR if reception */
/* aberration corrections */
/* are used */
/* ET+LTCTR if transmission */
/* aberration corrections */
/* are used */
/* ET if no aberration */
/* corrections are used */
/* The locus 'CENTER' should be selected */
/* when the user intends to obtain */
/* results compatible with those produced */
/* by SPKEZR. */
/* When OUTREF is inertial, all choices of REFLOC */
/* yield the same results. */
/* Case and leading and trailing blanks are not */
/* significant in the string REFLOC. */
/* ABCORR indicates the aberration corrections to be applied to */
/* the observer-target state to account for one-way */
/* light time and stellar aberration. */
/* ABCORR may be any of the following: */
/* 'NONE' Apply no correction. Return the */
/* geometric state of the target */
/* 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. 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. */
/* '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 leading and 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 and trailing blanks are not */
/* significant in the string OBSRVR. */
/* $ Detailed_Output */
/* STATE is a Cartesian state vector representing the position */
/* and velocity of the target relative to the specified */
/* observer. STATE is corrected for the specified */
/* aberrations and is expressed with respect to the */
/* reference frame specified by OUTREF. The first three */
/* components of STATE 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 STATE 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 STATE is the derivative */
/* with respect to time of the position component of */
/* STATE. */
/* Units are always km and km/sec. */
/* When STATE is expressed in a time-dependent */
/* (non-inertial) output frame, the orientation of that */
/* frame relative to the J2000 frame is evaluated in the */
/* manner indicated by the input argument REFLOC (see */
/* description above). */
/* 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 either the name of the center of motion or the observer */
/* cannot be translated to its NAIF ID code, the error will be */
/* diagnosed by a routine in the call tree of this routine. */
/* 2) If the reference frame OUTREF is unrecognized, the error */
/* will be diagnosed by a routine in the call tree of this */
/* routine. */
/* 3) If the reference frame TRGREF is unrecognized, the error will */
/* be diagnosed by a routine in the call tree of this routine. */
/* 4) If the frame evaluation locus REFLOC is not recognized, the */
/* error will be diagnosed by a routine in the call tree of this */
/* routine. */
/* 5) 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. */
/* 6) 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. */
/* 7) If the aberration correction ABCORR is not recognized, */
/* 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 center and observer */
/* must be loaded. If aberration corrections are used, the */
/* states of target center 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. */
/* The following data may be required: */
/* - PCK data: if the target frame is a PCK frame, rotation data */
/* for the target frame must be loaded. These may be provided */
/* in a text or binary PCK file. */
/* - Frame data: if a frame definition not built into SPICE is */
/* required, for example to convert the observer-target state */
/* to the output frame, that definition must be available in */
/* the kernel pool. Typically frame definitions are supplied */
/* by loading a frame kernel using FURNSH. */
/* - Additional kernels: if any frame used in this routine's */
/* state computation is a CK frame, then at least one CK and */
/* corresponding SCLK kernel is required. If dynamic frames */
/* are used, additional SPK, PCK, CK, or SCLK kernels may be */
/* required. */
/* In all cases, kernel data are normally loaded once per program */
/* run, NOT every time this routine is called. */
/* $ Particulars */
/* This routine computes observer-target states for targets whose */
/* trajectories are not provided by SPK files. */
/* Targets supported by this routine must have constant position */
/* with respect to a specified center of motion, expressed in a */
/* caller-specified reference frame. The state of the center of */
/* motion relative to the observer must be computable using */
/* loaded SPK data. */
/* For applications in which the target has non-zero, constant */
/* velocity relative to its center of motion, the SPICELIB routine */
/* SPKCVT { SPK, constant velocity target } */
/* can be used. */
/* This routine is suitable for computing states of landmarks on the */
/* surface of an extended object, as seen by a specified observer, */
/* in cases where no SPK data are available for those landmarks. */
/* This routine's treatment of the output reference frame differs */
/* from that of the principal SPK API routines */
/* SPKEZR */
/* SPKEZ */
/* SPKPOS */
/* SPKEZP */
/* which require both observer and target ephemerides to be provided */
/* by loaded SPK files: */
/* The SPK API routines listed above evaluate the orientation of */
/* the output reference frame (with respect to the J2000 frame) */
/* at an epoch corrected for one-way light time between the */
/* observer and the center of the output frame. When the center */
/* of the output frame is not the target (for example, when the */
/* target is on the surface of Mars and the output frame is */
/* centered at Mars' center), the epoch of evaluation may not */
/* closely match the light-time corrected epoch associated with */
/* the target itself. */
/* This routine allows the caller to dictate how the orientation */
/* of the output reference frame is to be evaluated. The caller */
/* passes to this routine an input string called the output */
/* frame's evaluation "locus." This string specifies the location */
/* associated with the output frame's evaluation epoch. The three */
/* possible values of the locus are */
/* 'TARGET' */
/* 'OBSERVER' */
/* 'CENTER' */
/* The choice of locus has an effect when aberration corrections */
/* are used and the output frame is non-inertial. */
/* When the locus is 'TARGET' and light time corrections are */
/* used, the orientation of the output frame is evaluated at the */
/* epoch obtained by correcting the observation epoch ET for */
/* one-way light time LT. The evaluation epoch will be either */
/* ET-LT or ET+LT for reception or transmission corrections */
/* respectively. */
/* For remote sensing applications where the target is a surface */
/* point on an extended object, and the orientation of that */
/* object should be evaluated at the emission time, the locus */
/* 'TARGET' should be used. */
/* When the output frame's orientation should be evaluated at */
/* the observation epoch ET, which is the case when the */
/* output frame is centered at the observer, the locus */
/* 'OBSERVER' should be used. */
/* The locus option 'CENTER' is provided for compatibility */
/* with existing SPK state computation APIs such as SPKEZR. */
/* Note that the output frame evaluation locus does not affect */
/* the computation of light time between the target and */
/* observer. */
/* The SPK routines that compute observer-target states for */
/* combinations of objects having ephemerides provided by the SPK */
/* system and objects having constant position or constant velocity */
/* are */
/* SPKCPO {SPK, Constant position observer} */
/* SPKCPT {SPK, Constant position target} */
/* SPKCVO {SPK, Constant velocity observer} */
/* SPKCVT {SPK, Constant velocity target} */
/* $ 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) Demonstrate use of this routine; in particular demonstrate */
/* applications of the output frame evaluation locus. */
/* The following program is not necessarily realistic: for */
/* brevity, it combines several unrelated computations. */
/* Task Description */
/* ================ */
/* Find the state of a given surface point on earth, corrected */
/* for light time and stellar aberration, relative to the Mars */
/* Global Surveyor spacecraft, expressed in the earth fixed */
/* reference frame ITRF93. The selected point is the position */
/* of the DSN station DSS-14. */
/* Contrast the states computed by setting the output frame */
/* evaluation locus to 'TARGET' and to 'CENTER'. Show that the */
/* latter choice produces results very close to those that */
/* can be obtained using SPKEZR. */
/* Also compute the state of a selected Mars surface point as */
/* seen from MGS. The point we'll use is the narrow angle MOC */
/* boresight surface intercept corresponding to the chosen */
/* observation time. Express the state in a spacecraft-centered */
/* reference frame. Use the output frame evaluation locus */
/* 'OBSERVER' for this computation. */
/* The observation epoch is 2003 OCT 13 06:00:00 UTC. */
/* Kernels */
/* ======= */
/* Use the meta-kernel shown below to load the required SPICE */
/* kernels. */
/* KPL/MK */
/* File name: spkcpt.tm */
/* This is the meta-kernel file for the header code example for */
/* the subroutine SPKCPT. The kernel files referenced by this */
/* meta-kernel can be found on the NAIF website. */
/* 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 */
/* pck00010.tpc Planet orientation and */
/* radii */
/* naif0010.tls Leapseconds */
/* earth_720101_070426.bpc Earth historical */
/* binary PCK */
/* earthstns_itrf93_050714.bsp DSN station SPK */
/* 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 = ( 'de421.bsp', */
/* 'pck00010.tpc', */
/* 'naif0010.tls', */
/* 'earth_720101_070426.bpc', */
/* 'earthstns_itrf93_050714.bsp', */
/* 'mgs_moc_v20.ti', */
/* 'mgs_sclkscet_00061.tsc', */
/* 'mgs_sc_ext12.bc', */
/* 'mgs_ext12_ipng_mgs95j.bsp' ) */
/* \begintext */
/* End of meta-kernel. */
/* Example code begins here. */
/* C */
/* C Program: EX1 */
/* C */
/* C This program demonstrates the use of SPKCPT. */
/* C Computations are performed using all three possible */
/* C values of the output frame evaluation locus REFLOC: */
/* C */
/* C 'TARGET' */
/* C 'OBSERVER' */
/* C 'CENTER' */
/* C */
/* C Several unrelated computations are performed in */
/* C this program. In particular, computations */
/* C involving a surface point on Mars are included */
/* C simply to demonstrate use of the 'OBSERVER' */
/* C option. */
/* C */
/* PROGRAM EX1 */
/* IMPLICIT NONE */
/* C */
/* C SPICELIB functions */
/* C */
/* DOUBLE PRECISION VDIST */
/* DOUBLE PRECISION VNORM */
/* C */
/* C Local parameters */
/* C */
/* CHARACTER*(*) CAMERA */
/* PARAMETER ( CAMERA = 'MGS_MOC_NA' ) */
/* CHARACTER*(*) FMT0 */
/* PARAMETER ( FMT0 = '(1X,A,3F20.8)' ) */
/* CHARACTER*(*) FMT1 */
/* PARAMETER ( FMT1 = '(1X,A, F20.8)' ) */
/* CHARACTER*(*) META */
/* PARAMETER ( META = 'spkcpt.tm' ) */
/* CHARACTER*(*) TIMFMT */
/* PARAMETER ( TIMFMT = */
/* . 'YYYY MON DD HR:MN:SC.###### UTC' ) */
/* INTEGER BDNMLN */
/* PARAMETER ( BDNMLN = 36 ) */
/* INTEGER CORLEN */
/* PARAMETER ( CORLEN = 10 ) */
/* INTEGER LOCLEN */
/* PARAMETER ( LOCLEN = 25 ) */
/* INTEGER FRNMLN */
/* PARAMETER ( FRNMLN = 32 ) */
/* INTEGER MAXBND */
/* PARAMETER ( MAXBND = 10 ) */
/* INTEGER SHPLEN */
/* PARAMETER ( SHPLEN = 80 ) */
/* INTEGER TIMLEN */
/* PARAMETER ( TIMLEN = 40 ) */
/* C */
/* C Local variables */
/* C */
/* CHARACTER*(CORLEN) ABCORR */
/* CHARACTER*(FRNMLN) CAMREF */
/* CHARACTER*(TIMLEN) EMITIM */
/* CHARACTER*(LOCLEN) REFLOC */
/* CHARACTER*(BDNMLN) OBSRVR */
/* CHARACTER*(TIMLEN) OBSTIM */
/* CHARACTER*(FRNMLN) OUTREF */
/* CHARACTER*(SHPLEN) SHAPE */
/* CHARACTER*(BDNMLN) TARGET */
/* CHARACTER*(BDNMLN) TRGCTR */
/* CHARACTER*(FRNMLN) TRGREF */
/* DOUBLE PRECISION BOUNDS ( 3, MAXBND ) */
/* DOUBLE PRECISION BSIGHT ( 3 ) */
/* DOUBLE PRECISION ET */
/* DOUBLE PRECISION LT0 */
/* DOUBLE PRECISION LT1 */
/* DOUBLE PRECISION LT2 */
/* DOUBLE PRECISION LT3 */
/* DOUBLE PRECISION SPOINT ( 3 ) */
/* DOUBLE PRECISION SRFVEC ( 3 ) */
/* DOUBLE PRECISION STATE0 ( 6 ) */
/* DOUBLE PRECISION STATE1 ( 6 ) */
/* DOUBLE PRECISION STATE2 ( 6 ) */
/* DOUBLE PRECISION STATE3 ( 6 ) */
/* DOUBLE PRECISION TRGEPC */
/* DOUBLE PRECISION TRGPOS ( 3 ) */
/* INTEGER CAMID */
/* INTEGER I */
/* INTEGER N */
/* LOGICAL FOUND */
/* C */
/* C Load SPICE kernels. */
/* C */
/* CALL FURNSH ( META ) */
/* C */
/* C Convert the observation time to seconds past J2000 TDB. */
/* C */
/* OBSTIM = '2003 OCT 13 06:00:00.000000 UTC' */
/* CALL STR2ET ( OBSTIM, ET ) */
/* C */
/* C Set the observer, target center, target frame, and */
/* C target state relative to its center. */
/* C */
/* OBSRVR = 'MGS' */
/* TRGCTR = 'EARTH' */
/* TRGREF = 'ITRF93' */
/* C */
/* C Set the position of DSS-14 relative to the earth's */
/* C center at the J2000 epoch, expressed in the */
/* C ITRF93 reference frame. Values come from the */
/* C earth station SPK specified in the meta-kernel. */
/* C */
/* C The actual station velocity is non-zero due */
/* C to tectonic plate motion; we ignore the motion */
/* C in this example. See the routine SPKCVT for an */
/* C example in which the plate motion is accounted for. */
/* C */
/* TRGPOS(1) = -2353.6213656676991D0 */
/* TRGPOS(2) = -4641.3414911499403D0 */
/* TRGPOS(3) = 3677.0523293197439D0 */
/* C */
/* C Find the apparent state of the station relative */
/* C to the spacecraft in the ITRF93 reference frame. */
/* C Evaluate the earth's orientation, that is the */
/* C orientation of the ITRF93 frame relative to the */
/* C J2000 frame, at the epoch obtained by correcting */
/* C the observation time for one-way light time. This */
/* C correction is obtained by setting REFLOC to 'TARGET'. */
/* C */
/* OUTREF = 'ITRF93' */
/* ABCORR = 'CN+S' */
/* REFLOC = 'TARGET' */
/* C */
/* C Compute the observer-target state. */
/* C */
/* CALL SPKCPT ( TRGPOS, TRGCTR, TRGREF, */
/* . ET, OUTREF, REFLOC, ABCORR, */
/* . OBSRVR, STATE0, LT0 ) */
/* C */
/* C Display the computed state and light time. */
/* C */
/* CALL TIMOUT ( ET-LT0, TIMFMT, EMITIM ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Frame evaluation locus: ', REFLOC */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Observer: ', OBSRVR */
/* WRITE (*,*) 'Observation time: ', OBSTIM */
/* WRITE (*,*) 'Target center: ', TRGCTR */
/* WRITE (*,*) 'Target frame: ', TRGREF */
/* WRITE (*,*) 'Emission time: ', EMITIM */
/* WRITE (*,*) 'Output reference frame: ', OUTREF */
/* WRITE (*,*) 'Aberration correction: ', ABCORR */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Observer-target position (km): ' */
/* WRITE (*,FMT0) ' ', ( STATE0(I), I = 1, 3 ) */
/* WRITE (*,*) 'Observer-target velocity (km/s): ' */
/* WRITE (*,FMT0) ' ', ( STATE0(I), I = 4, 6 ) */
/* WRITE (*,FMT1) 'Light time (s): ', LT0 */
/* WRITE (*,*) ' ' */
/* C */
/* C Repeat the computation, this time evaluating the */
/* C earth's orientation at the epoch obtained by */
/* C subtracting from the observation time the one way */
/* C light time from the earth's center. */
/* C */
/* C This is equivalent to looking up the observer-target */
/* C state using SPKEZR. */
/* C */
/* REFLOC = 'CENTER' */
/* CALL SPKCPT ( TRGPOS, TRGCTR, TRGREF, */
/* . ET, OUTREF, REFLOC, ABCORR, */
/* . OBSRVR, STATE1, LT1 ) */
/* C */
/* C Display the computed state and light time. */
/* C */
/* CALL TIMOUT ( ET-LT1, TIMFMT, EMITIM ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Frame evaluation locus: ', REFLOC */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Observer: ', OBSRVR */
/* WRITE (*,*) 'Observation time: ', OBSTIM */
/* WRITE (*,*) 'Target center: ', TRGCTR */
/* WRITE (*,*) 'Target frame: ', TRGREF */
/* WRITE (*,*) 'Emission time: ', EMITIM */
/* WRITE (*,*) 'Output reference frame: ', OUTREF */
/* WRITE (*,*) 'Aberration correction: ', ABCORR */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Observer-target position (km): ' */
/* WRITE (*,FMT0) ' ', ( STATE1(I), I = 1, 3 ) */
/* WRITE (*,*) 'Observer-target velocity (km/s): ' */
/* WRITE (*,FMT0) ' ', ( STATE1(I), I = 4, 6 ) */
/* WRITE (*,FMT1) 'Light time (s): ', LT1 */
/* WRITE (*,*) ' ' */
/* WRITE (*,FMT1) 'Distance between above positions ' */
/* .// '(km): ', VDIST( STATE0, STATE1 ) */
/* WRITE (*,FMT1) 'Velocity difference magnitude ' */
/* .// ' (km/s): ', */
/* . VDIST( STATE0(4), STATE1(4) ) */
/* C */
/* C Check: compare the state computed directly above */
/* C to one produced by SPKEZR. */
/* C */
/* TARGET = 'DSS-14' */
/* CALL SPKEZR ( TARGET, ET, OUTREF, ABCORR, */
/* . OBSRVR, STATE2, LT2 ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'State computed using SPKEZR: ' */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Observer: ', OBSRVR */
/* WRITE (*,*) 'Observation time: ', OBSTIM */
/* WRITE (*,*) 'Target: ', TARGET */
/* WRITE (*,*) 'Output reference frame: ', OUTREF */
/* WRITE (*,*) 'Aberration correction: ', ABCORR */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Observer-target position (km): ' */
/* WRITE (*,FMT0) ' ', ( STATE2(I), I = 1, 3 ) */
/* WRITE (*,*) 'Observer-target velocity (km/s): ' */
/* WRITE (*,FMT0) ' ', ( STATE2(I), I = 4, 6 ) */
/* WRITE (*,FMT1) 'Light time (s): ', LT2 */
/* WRITE (*,*) ' ' */
/* WRITE (*,FMT1) 'Distance between last two ' */
/* .// 'positions (km): ', */
/* . VDIST ( STATE1, STATE2 ) */
/* WRITE (*,FMT1) 'Velocity difference magnitude ' */
/* .// ' (km/s): ', */
/* . VDIST( STATE1(4), STATE2(4) ) */
/* C */
/* C Finally, compute an observer-target state in */
/* C a frame centered at the observer. */
/* C The reference frame will be that of the */
/* C MGS MOC NA camera. */
/* C */
/* C In this case we'll use as the target the surface */
/* C intercept on Mars of the camera boresight. This */
/* C allows us to easily verify the correctness of */
/* C the results returned by SPKCPT. */
/* C */
/* C Get camera frame and FOV parameters. We'll need */
/* C the camera ID code first. */
/* C */
/* CALL BODN2C ( CAMERA, CAMID, FOUND ) */
/* IF ( .NOT. FOUND ) THEN */
/* WRITE (*,*) 'Camera name could not be mapped ' */
/* . // 'to an ID code.' */
/* STOP */
/* END IF */
/* C */
/* C GETFOV will return the name of the camera-fixed frame */
/* C in the string CAMREF, the camera boresight vector in */
/* C the array BSIGHT, and the FOV corner vectors in the */
/* C array BOUNDS. All we're going to use are the camera */
/* C frame name and camera boresight. */
/* C */
/* CALL GETFOV ( CAMID, MAXBND, SHAPE, CAMREF, */
/* . BSIGHT, N, BOUNDS ) */
/* C */
/* C Find the camera boresight surface intercept. */
/* C */
/* TRGCTR = 'MARS' */
/* TRGREF = 'IAU_MARS' */
/* CALL SINCPT ( 'ELLIPSOID', TRGCTR, ET, TRGREF, */
/* . ABCORR, OBSRVR, CAMREF, BSIGHT, */
/* . SPOINT, TRGEPC, SRFVEC, FOUND ) */
/* OUTREF = CAMREF */
/* REFLOC = 'OBSERVER' */
/* CALL SPKCPT ( SPOINT, TRGCTR, TRGREF, */
/* . ET, OUTREF, REFLOC, ABCORR, */
/* . OBSRVR, STATE3, LT3 ) */
/* C */
/* C Convert the emission time and the target state */
/* C evaluation epoch to strings for output. */
/* C */
/* CALL TIMOUT ( ET - LT3, TIMFMT, EMITIM ) */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Frame evaluation locus: ', REFLOC */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Observer: ', OBSRVR */
/* WRITE (*,*) 'Observation time: ', OBSTIM */
/* WRITE (*,*) 'Target center: ', TRGCTR */
/* WRITE (*,*) 'Target frame: ', TRGREF */
/* WRITE (*,*) 'Emission time: ', EMITIM */
/* WRITE (*,*) 'Output reference frame: ', OUTREF */
/* WRITE (*,*) 'Aberration correction: ', ABCORR */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Observer-target position (km): ' */
/* WRITE (*,FMT0) ' ', ( STATE3(I), I = 1, 3 ) */
/* WRITE (*,*) 'Observer-target velocity (km/s): ' */
/* WRITE (*,FMT0) ' ', ( STATE3(I), I = 4, 6 ) */
/* WRITE (*,FMT1) 'Light time (s): ', LT3 */
/* WRITE (*,FMT1) 'Target range from SINCPT (km): ' */
/* .// ' ', VNORM( SRFVEC ) */
/* WRITE (*,*) ' ' */
/* END */
/* When this program was executed on a PC/Linux/gfortran */
/* platform, the output was: */
/* Frame evaluation locus: TARGET */
/* Observer: MGS */
/* Observation time: 2003 OCT 13 06:00:00.000000 UTC */
/* Target center: EARTH */
/* Target frame: ITRF93 */
/* Emission time: 2003 OCT 13 05:55:44.232914 UTC */
/* Output reference frame: ITRF93 */
/* Aberration correction: CN+S */
/* Observer-target position (km): */
/* 52746468.84243592 52367725.79653772 18836142.68957234 */
/* Observer-target velocity (km/s): */
/* 3823.39593314 -3840.60002121 2.21337692 */
/* Light time (s): 255.76708533 */
/* Frame evaluation locus: CENTER */
/* Observer: MGS */
/* Observation time: 2003 OCT 13 06:00:00.000000 UTC */
/* Target center: EARTH */
/* Target frame: ITRF93 */
/* Emission time: 2003 OCT 13 05:55:44.232914 UTC */
/* Output reference frame: ITRF93 */
/* Aberration correction: CN+S */
/* Observer-target position (km): */
/* 52746419.34648802 52367775.65036674 18836142.68969753 */
/* Observer-target velocity (km/s): */
/* 3823.40103499 -3840.59789000 2.21337692 */
/* Light time (s): 255.76708533 */
/* Distance between above positions (km): 70.25135676 */
/* Velocity difference magnitude (km/s): 0.00552910 */
/* State computed using SPKEZR: */
/* Observer: MGS */
/* Observation time: 2003 OCT 13 06:00:00.000000 UTC */
/* Target: DSS-14 */
/* Output reference frame: ITRF93 */
/* Aberration correction: CN+S */
/* Observer-target position (km): */
/* 52746419.34641990 52367775.65039122 18836142.68968301 */
/* Observer-target velocity (km/s): */
/* 3823.40103499 -3840.59789000 2.21337692 */
/* Light time (s): 255.76708533 */
/* Distance between last two positions (km): 0.00007383 */
/* Velocity difference magnitude (km/s): 0.00000000 */
/* Frame evaluation locus: OBSERVER */
/* Observer: MGS */
/* Observation time: 2003 OCT 13 06:00:00.000000 UTC */
/* Target center: MARS */
/* Target frame: IAU_MARS */
/* Emission time: 2003 OCT 13 05:59:59.998702 UTC */
/* Output reference frame: MGS_MOC_NA */
/* Aberration correction: CN+S */
/* Observer-target position (km): */
/* 0.00000001 -0.00000001 388.97573572 */
/* Observer-target velocity (km/s): */
/* 2.91968665 0.15140014 0.92363513 */
/* Light time (s): 0.00129748 */
/* Target range from SINCPT (km): 388.97573572 */
/* $ Restrictions */
/* 1) This routine may not be suitable for work with stars or other */
/* objects having large distances from the observer, due to loss */
/* of precision in position vectors. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* S.C. Krening (JPL) */
/* B.V. Semenov (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.0, 27-MAR-2012 (NJB) (SCK) (BVS) */
/* -& */
/* $ Index_Entries */
/* state of constant_position_target */
/* state of fixed_position_target */
/* state of surface_point on extended_object */
/* state of landmark on extended_object */
/* -& */
/* $ Revisions */
/* None. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
}
chkin_("SPKCPT", (ftnlen)6);
/* Create a state vector for the target. The velocity */
/* portion of the state is zero. */
vequ_(trgpos, trgsta);
cleard_(&c__3, &trgsta[3]);
/* Set the target epoch; the value is arbitrary, since */
/* the target's velocity is zero. */
trgepc = 0.;
spkcvt_(trgsta, &trgepc, trgctr, trgref, et, outref, refloc, abcorr,
obsrvr, state, lt, trgctr_len, trgref_len, outref_len, refloc_len,
abcorr_len, obsrvr_len);
chkout_("SPKCPT", (ftnlen)6);
return 0;
} /* spkcpt_ */
/* $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). */
/* Whether the 'CN+S' solution is */
/* substantially more accurate than the */
/* 'LT' solution 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. See the Particulars section of */
/* SPKEZR for a discussion of precision of */
/* light time corrections. */
/* 'CN+S' Converged Newtonian light time */
/* correction and stellar aberration */
/* 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. */
/* '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 correction and */
/* stellar aberration correction. */
/* 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.1, 04-JUL-2014 (NJB) */
/* Discussion of light time corrections was updated. Assertions */
/* that converged light time corrections are unlikely to be */
/* useful were removed. */
/* - 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)632)], <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_ */
/* $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], acc[3], pntsta[6], 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);
logical fnd;
extern /* Subroutine */ int sigerr_(char *, ftnlen), 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);
doublereal dlt;
extern /* Subroutine */ int sxform_(char *, char *, doublereal *,
doublereal *, ftnlen, 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 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.3.0, 01-OCT-2011 (NJB) */
/* Added NWILUM parameter. */
/* - SPICELIB Version 1.2.0, 14-SEP-2010 (EDW) */
/* Added NWPA parameter. */
/* - SPICELIB Version 1.1.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. */
/* Callers of GFPA should declare their workspace window */
/* count using NWPA. */
/* Callers of GFILUM should declare their workspace window */
/* count using NWILUM. */
/* 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_ */
/* $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;
extern /* Subroutine */ int chkin_(char *, ftnlen);
doublereal 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 *), sigerr_(char *, ftnlen), chkout_(
char *, ftnlen), setmsg_(char *, ftnlen);
doublereal svphat[6];
extern logical return_(void);
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 */
/* 1) If attempt to divide by zero occurs, the error */
/* SPICE(DIVIDEBYZERO) will be signaled. This case may occur */
/* due to uninitialized inputs. */
/* 2) 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 2.0.0, 15-APR-2014 (NJB) */
/* Added RETURN test and discovery check-in. */
/* Check for division by zero was added. This */
/* case might occur due to uninitialized inputs. */
/* - 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 */
/* Use discovery check-in. */
if (return_()) {
return 0;
}
/* In the discussion below, the dot product of vectors X and Y */
/* is denoted by */
/* <X,Y> */
/* 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 - ( ( <VOBS,DRHAT> + <ACCOBS, RHAT> )*RHAT */
/* + <VOBS,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)*<DVP, VPHAT> (7) */
/* Then for positive phi */
/* d(phi)/dt = (1/cos(phi)) * (1/c) * <DVP, VPHAT> (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)));
if (c__ == 0.) {
/* C will be used as a divisor later (in the computation */
/* of DPHI), so we'll put a stop to the problem here. */
chkin_("ZZSTELAB", (ftnlen)8);
setmsg_("Cosine of the aberration angle is 0; this cannot occur for "
"realistic observer velocities. This case can arise due to un"
"initialized inputs. This cosine value is used as a divisor i"
"n a later computation, so it must not be equal to zero.", (
ftnlen)234);
sigerr_("SPICE(DIVIDEBYZERO)", (ftnlen)19);
chkout_("ZZSTELAB", (ftnlen)8);
return 0;
}
/* 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 - ( ( <VOBS,DRHAT> + <ACCOBS, RHAT> )*RHAT */
/* + <VOBS,RHAT> * DRHAT ) */
d__1 = -vdot_(lcvobs, drhat) - vdot_(lcacc, rhat);
d__2 = -vdot_(lcvobs, rhat);
vlcom3_(&c_b7, 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) * <DVP, VPHAT> */
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_b7, 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_b7, 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)597)]);
}
/* Now compute the derivative. */
qderiv_(&c__3, saoff, &saoff[3], &c_b7, dscorr);
}
/* At this point the correction offset SCORR and its derivative */
/* with respect to time DSCORR are both set. */
return 0;
} /* zzstelab_ */
/* $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_ */
/* $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_ */
/* $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_ */
