/* fchain.f -- translated by f2c (version 20000531). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ #include "f2c.h" /* $Procedure FCHAIN ( Extract the frame chain connecting two frames ) */ /* Subroutine */ int fchain_pdt_(char *from, char *to, doublereal *et, logical * state, integer *room, integer *n, char *chain, logical *found, ftnlen from_len, ftnlen to_len, ftnlen chain_len) { /* System generated locals */ integer i__1, i__2; /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_cmp(char *, char *, ftnlen, ftnlen); /* Local variables */ integer node; logical done; integer fcode; extern /* Subroutine */ int chkin_(char *, ftnlen); integer tcode; extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen); integer infrm; extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen); extern logical failed_(void); extern /* Subroutine */ int clearc_(integer *, char *, ftnlen), cyclac_( char *, integer *, char *, integer *, char *, ftnlen, ftnlen, ftnlen); extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen); integer comnod; extern /* Subroutine */ int namfrm_(char *, integer *, ftnlen), frmnam_( integer *, char *, ftnlen), frmget_(integer *, doublereal *, doublereal *, integer *, logical *); doublereal stamat[36] /* was [6][6] */; logical gotone; char tmpnam[32]; extern /* Subroutine */ int sigerr_(char *, ftnlen); logical gotfrm; extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *, ftnlen); doublereal posmat[9] /* was [3][3] */; extern /* Subroutine */ int errint_(char *, integer *, ftnlen), rotget_( integer *, doublereal *, doublereal *, integer *, logical *); integer stpnod, outfrm; extern logical return_(void); /* $ Abstract */ /* Retrieve the list of frame names connecting FROM to TO */ /* at epoch ET in the state or position transformation trees. */ /* $ Copyright */ /* Copyright (1998), California Institute of Technology. */ /* U.S. Government sponsorship acknowledged. */ /* $ Required_Reading */ /* None. */ /* $ Keywords */ /* FRAMES */ /* $ Declarations */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* FROM I Name of the frame to transform from */ /* TO I Name of the frame to transform to */ /* ET I Epoch that the connecting chain is computed */ /* STATE I Logical that indicates to use the state tree */ /* ROOM I Number of entries in the CHAIN array */ /* N O Number of entries returned in CHAIN */ /* CHAIN O List of frames connecting FROM to TO */ /* FOUND O Logical that indicates CHAIN was found */ /* $ Detailed_Input */ /* FROM is the name of some reference frame in which */ /* states or positions are known. */ /* TO is the name of some reference frame in which */ /* it is desired to represent states or positions. */ /* ET is the epoch in ephemeris seconds past the epoch */ /* of J2000 (TDB) at which the state or position */ /* transformation chain should be computed. */ /* STATE is TRUE when this routine is to compute CHAIN */ /* in the state transformation tree. If FALSE */ /* it will compute CHAIN from the position */ /* transformation tree. */ /* ROOM is the maximum number of frame names that can */ /* be stored in CHAIN. */ /* $ Detailed_Output */ /* N is the number of frames returned in CHAIN. */ /* CHAIN lists the frames connecting FROM to TO from */ /* the state or position transformation tree at */ /* epoch ET. In the case where the the connection */ /* from FROM to TO can be made: */ /* CHAIN(1) = FROM */ /* CHAIN(2) = NEXT_FRAME */ /* . . */ /* . . */ /* . . */ /* CHAIN(N-1) = NEXT_TO_LAST_FRAME */ /* CHAIN(N) = TO */ /* In the case where no connection at the requested */ /* epoch in the desired tree can be made, the */ /* following is returned in CHAIN: */ /* CHAIN(1) = FROM */ /* CHAIN(2) = NEXT_FRAME_FOUND */ /* . . */ /* . . */ /* . . */ /* CHAIN(M-1) = FURTHEST_FRAME_FROM */ /* CHAIN(M) = ' ' */ /* CHAIN(M+1) = FURTHEST_FRAME_TO */ /* . . */ /* . . */ /* . . */ /* CHAIN(N-1) = NEXT_TO_LAST_FRAME */ /* CHAIN(N) = TO */ /* where M is the index of the blank entry. */ /* FOUND is TRUE if the CHAIN contains the path in the */ /* requested tree that connects FROM to TO, and */ /* FALSE if no connection was made. */ /* $ Parameters */ /* None. */ /* $ Files */ /* None. */ /* $ Exceptions */ /* 1) */ /* $ Particulars */ /* Something goes here... what... not quite sure. */ /* $ Examples */ /* Examples would be good... but not now. */ /* $ Restrictions */ /* None. */ /* $ Author_and_Institution */ /* F.S. Turner (JPL) */ /* $ Literature_References */ /* None. */ /* $ Version */ /* - fchain Version 1.0.0, 03-MAY-2001 (FST) */ /* -& */ /* $ Index_Entries */ /* compute frame chain connecting two frames */ /* -& */ /* SPICELIB Functions */ /* Local Parameters */ /* ID Code of the root frame. */ /* Local Variables */ /* Standard SPICE error handling. */ if (return_()) { *n = 0; *found = FALSE_; clearc_(room, chain, chain_len); return 0; } else { chkin_("FCHAIN", (ftnlen)6); } /* Start by checking that FROM and TO are valid frames. */ namfrm_(from, &fcode, from_len); namfrm_(to, &tcode, to_len); /* NAMFRM returns 0 when the frame isn't recognized. */ if (fcode == 0 && tcode == 0) { /* Clean up the output arguments. */ *n = 0; *found = FALSE_; clearc_(room, chain, chain_len); /* Signal the error. */ setmsg_("Neither of the frames # or # were recognized as a known ref" "erence frame.", (ftnlen)72); errch_("#", from, (ftnlen)1, from_len); errch_("#", to, (ftnlen)1, to_len); sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); chkout_("FCHAIN", (ftnlen)6); return 0; } else if (fcode == 0) { /* Clean up the output arguments. */ *n = 0; *found = FALSE_; clearc_(room, chain, chain_len); /* Signal the error. */ setmsg_("The frame # was not recognized as a known reference frame.", (ftnlen)58); errch_("#", from, (ftnlen)1, from_len); sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); chkout_("FCHAIN", (ftnlen)6); return 0; } else if (tcode == 0) { /* Clean up the output arguments. */ *n = 0; *found = FALSE_; clearc_(room, chain, chain_len); /* Signal the error. */ setmsg_("The frame # was not recognized as a known reference frame.", (ftnlen)58); errch_("#", to, (ftnlen)1, to_len); sigerr_("SPICE(UNKNOWNFRAME)", (ftnlen)19); chkout_("FCHAIN", (ftnlen)6); return 0; } /* Check ROOM to see it's some positive number. Otherwise signal */ /* an error since we can't store the results. */ if (*room <= 0) { /* Clean up the output arguments. */ *n = 0; *found = FALSE_; clearc_(room, chain, chain_len); /* Signal the error. */ setmsg_("The maximum number of nodes that can be stored in the frame" " chain, #, exceeds the number of nodes required to capture t" "he chain.", (ftnlen)128); errint_("#", room, (ftnlen)1); sigerr_("SPICE(NOTENOUGHROOM)", (ftnlen)20); chkout_("FCHAIN", (ftnlen)6); return 0; } /* At this point we know that FROM and TO are known frames. */ /* Check the degenerate case first. */ if (fcode == tcode) { s_copy(chain, from, chain_len, from_len); i__1 = *room - 1; clearc_(&i__1, chain + chain_len, chain_len); *n = 1; *found = TRUE_; chkout_("FCHAIN", (ftnlen)6); return 0; } /* Now if we get here, we have to search the tree to connect */ /* the frames. Start at FROM and search until we hit the root */ /* node or discover the TO frame. */ s_copy(chain, from, chain_len, from_len); node = 1; gotfrm = TRUE_; outfrm = fcode; infrm = fcode; while(outfrm != 1 && outfrm != tcode && node < *room && gotfrm) { /* If we're searching the state transformation table, use */ /* FRMGET, otherwise use ROTGET. */ if (*state) { frmget_(&infrm, et, stamat, &outfrm, &gotfrm); } else { rotget_(&infrm, et, posmat, &outfrm, &gotfrm); } /* At this point we found the next node, increase the node */ /* pointer and convert and store the new frame name. */ if (gotfrm) { ++node; frmnam_(&outfrm, tmpnam, (ftnlen)32); /* IF TMPNAM is blank, then store the integer code for the */ /* frame in CHAIN, otherwise copy the name. */ if (s_cmp(tmpnam, " ", (ftnlen)32, (ftnlen)1) == 0) { s_copy(chain + (node - 1) * chain_len, "#", chain_len, ( ftnlen)1); repmi_(chain + (node - 1) * chain_len, "#", &outfrm, chain + ( node - 1) * chain_len, chain_len, (ftnlen)1, chain_len); } else { s_copy(chain + (node - 1) * chain_len, tmpnam, chain_len, ( ftnlen)32); } /* Make INFRM be OUTFRM to move up the tree. */ infrm = outfrm; } } /* Now check to see if we have run out of room in CHAIN. */ done = outfrm == 1 || outfrm == tcode || ! gotfrm; /* If we are not done climbing the root tree, then we have */ /* run out of room. Signal an error and return control */ /* to the caller. */ if (! done) { /* Clean up the output arguments. */ *n = 0; *found = FALSE_; clearc_(room, chain, chain_len); /* Signal the error. */ setmsg_("The maximum number of nodes that can be stored in the frame" " chain, #, exceeds the number of nodes required to capture t" "he chain.", (ftnlen)128); errint_("#", room, (ftnlen)1); sigerr_("SPICE(NOTENOUGHROOM)", (ftnlen)20); chkout_("FCHAIN", (ftnlen)6); return 0; } /* Now before moving on, check to see if OUTFRM is TCODE. If */ /* this is the case we're done. Prepare the chain and return */ /* it to the caller. */ if (outfrm == tcode) { /* Clean up the end of the CHAIN. */ i__1 = *room - *n; clearc_(&i__1, chain + *n * chain_len, chain_len); *found = TRUE_; *n = node; chkout_("FCHAIN", (ftnlen)6); return 0; } /* Ok, at this point we start at the TO frame and work back until */ /* we hit the root node of the frame tree or encounter a common */ /* node in the FROM to root node path. */ stpnod = node; node = *room; s_copy(chain + (node - 1) * chain_len, to, chain_len, to_len); infrm = tcode; outfrm = tcode; gotfrm = TRUE_; gotone = FALSE_; while(outfrm != 1 && node > stpnod + 1 && ! gotone && gotfrm) { /* If we're searching the state transformation table, use */ /* FRMGET, otherwise use ROTGET. */ if (*state) { frmget_(&infrm, et, stamat, &outfrm, &gotfrm); } else { rotget_(&infrm, et, posmat, &outfrm, &gotfrm); } /* At this point we found the next node, increase the node */ /* pointer and convert and store the new frame name. */ if (gotfrm) { /* Check to see if it is a node that we already have */ /* uncovered in the FROM to ROOT frame. */ frmnam_(&outfrm, tmpnam, (ftnlen)32); if (s_cmp(tmpnam, " ", (ftnlen)32, (ftnlen)1) == 0) { s_copy(tmpnam, "#", (ftnlen)32, (ftnlen)1); repmi_(tmpnam, "#", &outfrm, tmpnam, (ftnlen)32, (ftnlen)1, ( ftnlen)32); } /* Search to see if this node is in common with */ /* any nodes in the FROM to root node search. */ comnod = isrchc_(tmpnam, &stpnod, chain, (ftnlen)32, chain_len); gotone = comnod > 0; if (! gotone) { --node; s_copy(chain + (node - 1) * chain_len, tmpnam, chain_len, ( ftnlen)32); infrm = outfrm; } } } /* Check to see if we have run out of room in CHAIN to store */ /* frame names. */ done = outfrm == 1 || gotone || ! gotfrm; if (! done) { /* Clean up the output arguments. */ *n = 0; *found = FALSE_; clearc_(room, chain, chain_len); /* Signal the error. */ setmsg_("The maximum number of nodes that can be stored in the frame" " chain, #, exceeds the number of nodes required to capture t" "he chain.", (ftnlen)128); errint_("#", room, (ftnlen)1); sigerr_("SPICE(NOTENOUGHROOM)", (ftnlen)20); chkout_("FCHAIN", (ftnlen)6); return 0; } /* Now handle the nominal case. This is the case when we found */ /* a common node. In the nominal case we have the following: */ /* CHAIN(1) = FROM -- */ /* CHAIN(2) = LINK_2 | */ /* . . | Beginning of */ /* . . | CHAIN */ /* . . | */ /* CHAIN(COMNOD) = LINK_COMNOD -- */ /* . . */ /* . . */ /* . . */ /* CHAIN(STPNOD) = MAX_LINK_UP_TREE */ /* . . */ /* . . */ /* . . */ /* CHAIN(NODE) = LINK_COMNOD+1 -- */ /* CHAIN(NODE+1) = LINK_COMNOD+2 | */ /* . . | End of */ /* . . | CHAIN */ /* . . | */ /* CHAIN(ROOM) = TO -- */ /* We need to merge these two pieces of the chain into the */ /* following: */ /* CHAIN(1) = FROM -- */ /* CHAIN(2) = LINK_2 | */ /* . . | */ /* . . | */ /* . . | */ /* CHAIN(COMNOD) = LINK_COMNOD | */ /* CHAIN(COMNOD+1) = LINK_COMNOD+1 | */ /* CHAIN(COMNOD+2) = LINK_COMNOD+2 | */ /* . . | */ /* . . | */ /* . . | */ /* CHAIN(N) = TO -- */ /* . . */ /* . . */ /* . . */ /* CHAIN(ROOM) = ' ' */ /* The following code performs the necessary adjustments. */ if (gotone) { /* Cycle the elements of CHAIN into place. */ i__1 = *room - comnod; i__2 = node - comnod - 1; cyclac_(chain + comnod * chain_len, &i__1, "B", &i__2, chain + comnod * chain_len, chain_len, (ftnlen)1, chain_len); /* Set FOUND to TRUE and N to the appropriate number. */ *found = TRUE_; *n = comnod + *room - node + 1; /* Clear out the tail end of the array. */ i__1 = *room - *n; clearc_(&i__1, chain + *n * chain_len, chain_len); /* Check FAILED() and clean up if an error has occurred. */ if (failed_()) { *n = 0; *found = FALSE_; clearc_(room, chain, chain_len); } /* Check out and return. */ chkout_("FCHAIN", (ftnlen)6); return 0; } /* If we end up here, then both branches of the frame tree involved, */ /* do not connect. Restructure CHAIN to contain the two branches */ /* and return to the caller. First check to see if we have */ /* enough space to leave the blank entry separating the */ /* disconnected branches. Signal an error because we do not */ /* have enough space to store the results. */ if (node == stpnod + 1) { /* Clean up the output arguments. */ *n = 0; *found = FALSE_; clearc_(room, chain, chain_len); /* Signal the error. */ setmsg_("The maximum number of nodes that can be stored in the frame" " chain, #, exceeds the number of nodes required to capture t" "he chain.", (ftnlen)128); errint_("#", room, (ftnlen)1); sigerr_("SPICE(NOTENOUGHROOM)", (ftnlen)20); chkout_("FCHAIN", (ftnlen)6); return 0; } /* Clear the node just above CHAIN(NODE). From the above check, */ /* we know this isn't erasing the last element of the FROM chain. */ --node; s_copy(chain + (node - 1) * chain_len, " ", chain_len, (ftnlen)1); /* Cycle the elements of CHAIN into place. */ i__1 = *room - stpnod; i__2 = node - stpnod - 1; cyclac_(chain + stpnod * chain_len, &i__1, "B", &i__2, chain + stpnod * chain_len, chain_len, (ftnlen)1, chain_len); /* Set FOUND to FALSE and N to the appropriate number. */ *found = FALSE_; *n = stpnod + *room - node + 1; /* Clear out the tail end of the array. */ i__1 = *room - *n; clearc_(&i__1, chain + *n * chain_len, chain_len); /* Since we are about to return, check FAILED() and clean up. */ if (failed_()) { *n = 0; *found = FALSE_; clearc_(room, chain, chain_len); } /* Standard SPICE error handling. */ chkout_("FCHAIN", (ftnlen)6); return 0; } /* fchain_ */