/* $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_ */