1 /* gfrprt.f -- translated by f2c (version 19980913).
2 You must link the resulting object file with the libraries:
3 -lf2c -lm (in that order)
4 */
5
6 #include "f2c.h"
7
8 /* Table of constant values */
9
10 static integer c__55 = 55;
11 static integer c__13 = 13;
12 static doublereal c_b26 = 1.;
13 static integer c__4 = 4;
14 static doublereal c_b44 = 0.;
15 static integer c__1 = 1;
16
17 /* $Procedure GFRPRT ( GF, progress reporting package ) */
gfrprt_0_(int n__,doublereal * window,char * begmss,char * endmss,doublereal * ivbeg,doublereal * ivend,doublereal * time,ftnlen begmss_len,ftnlen endmss_len)18 /* Subroutine */ int gfrprt_0_(int n__, doublereal *window, char *begmss,
19 char *endmss, doublereal *ivbeg, doublereal *ivend, doublereal *time,
20 ftnlen begmss_len, ftnlen endmss_len)
21 {
22 /* System generated locals */
23 integer i__1;
24
25 /* Builtin functions */
26 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
27
28 /* Local variables */
29 doublereal incr, freq;
30 integer long__, unit;
31 extern /* Subroutine */ int zzgfwkad_(doublereal *, integer *, char *,
32 char *, ftnlen, ftnlen), zzgfwkin_(doublereal *), zzgfdsps_(
33 integer *, char *, char *, integer *, ftnlen, ftnlen), zzgfwkmo_(
34 integer *, doublereal *, doublereal *, integer *, char *, char *,
35 doublereal *, ftnlen, ftnlen), zzgftswk_(doublereal *, doublereal
36 *, integer *, char *, char *, ftnlen, ftnlen);
37 integer i__;
38 extern integer cardd_(doublereal *);
39 char begin[55];
40 extern /* Subroutine */ int chkin_(char *, ftnlen);
41 static char copyb[55];
42 extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
43 static char copye[13];
44 extern /* Subroutine */ int stdio_(char *, integer *, ftnlen);
45 doublereal total;
46 integer short__;
47 static doublereal t0;
48 extern logical failed_(void);
49 integer tcheck, chrcod;
50 static doublereal remain;
51 extern integer lastnb_(char *, ftnlen);
52 doublereal stddev;
53 extern /* Subroutine */ int sigerr_(char *, ftnlen);
54 doublereal measur;
55 extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
56 ftnlen), errint_(char *, integer *, ftnlen), wnsumd_(doublereal *,
57 doublereal *, doublereal *, doublereal *, integer *, integer *);
58 extern logical return_(void);
59 integer stdout;
60 char end[13];
61 doublereal ave;
62
63 /* $ Abstract */
64
65 /* The entry points contained under this routine provide users */
66 /* information regarding the status of a GF search in progress. */
67
68 /* $ Disclaimer */
69
70 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
71 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
72 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
73 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
74 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
75 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
76 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
77 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
78 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
79 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
80
81 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
82 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
83 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
84 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
85 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
86 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
87
88 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
89 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
90 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
91 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
92
93 /* $ Required_Reading */
94
95 /* GF */
96
97 /* $ Keywords */
98
99 /* SEARCH */
100 /* UTILITY */
101
102 /* $ Declarations */
103 /* $ Abstract */
104
105 /* SPICE private include file intended solely for the support of */
106 /* SPICE routines. Users should not include this routine in their */
107 /* source code due to the volatile nature of this file. */
108
109 /* This file contains private, global parameter declarations */
110 /* for the SPICELIB Geometry Finder (GF) subsystem. */
111
112 /* $ Disclaimer */
113
114 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
115 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
116 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
117 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
118 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
119 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
120 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
121 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
122 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
123 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
124
125 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
126 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
127 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
128 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
129 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
130 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
131
132 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
133 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
134 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
135 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
136
137 /* $ Required_Reading */
138
139 /* GF */
140
141 /* $ Keywords */
142
143 /* GEOMETRY */
144 /* ROOT */
145
146 /* $ Restrictions */
147
148 /* None. */
149
150 /* $ Author_and_Institution */
151
152 /* N.J. Bachman (JPL) */
153 /* E.D. Wright (JPL) */
154
155 /* $ Literature_References */
156
157 /* None. */
158
159 /* $ Version */
160
161 /* - SPICELIB Version 1.0.0, 17-FEB-2009 (NJB) (EDW) */
162
163 /* -& */
164
165 /* The set of supported coordinate systems */
166
167 /* System Coordinates */
168 /* ---------- ----------- */
169 /* Rectangular X, Y, Z */
170 /* Latitudinal Radius, Longitude, Latitude */
171 /* Spherical Radius, Colatitude, Longitude */
172 /* RA/Dec Range, Right Ascension, Declination */
173 /* Cylindrical Radius, Longitude, Z */
174 /* Geodetic Longitude, Latitude, Altitude */
175 /* Planetographic Longitude, Latitude, Altitude */
176
177 /* Below we declare parameters for naming coordinate systems. */
178 /* User inputs naming coordinate systems must match these */
179 /* when compared using EQSTR. That is, user inputs must */
180 /* match after being left justified, converted to upper case, */
181 /* and having all embedded blanks removed. */
182
183
184 /* Below we declare names for coordinates. Again, user */
185 /* inputs naming coordinates must match these when */
186 /* compared using EQSTR. */
187
188
189 /* Note that the RA parameter value below matches */
190
191 /* 'RIGHT ASCENSION' */
192
193 /* when extra blanks are compressed out of the above value. */
194
195
196 /* Parameters specifying types of vector definitions */
197 /* used for GF coordinate searches: */
198
199 /* All string parameter values are left justified, upper */
200 /* case, with extra blanks compressed out. */
201
202 /* POSDEF indicates the vector is defined by the */
203 /* position of a target relative to an observer. */
204
205
206 /* SOBDEF indicates the vector points from the center */
207 /* of a target body to the sub-observer point on */
208 /* that body, for a given observer and target. */
209
210
211 /* SOBDEF indicates the vector points from the center */
212 /* of a target body to the surface intercept point on */
213 /* that body, for a given observer, ray, and target. */
214
215
216 /* Number of workspace windows used by ZZGFREL: */
217
218
219 /* Number of additional workspace windows used by ZZGFLONG: */
220
221
222 /* Index of "existence window" used by ZZGFCSLV: */
223
224
225 /* Progress report parameters: */
226
227 /* MXBEGM, */
228 /* MXENDM are, respectively, the maximum lengths of the progress */
229 /* report message prefix and suffix. */
230
231 /* Note: the sum of these lengths, plus the length of the */
232 /* "percent complete" substring, should not be long enough */
233 /* to cause wrap-around on any platform's terminal window. */
234
235
236 /* Total progress report message length upper bound: */
237
238
239 /* End of file zzgf.inc. */
240
241 /* $ Brief_I/O */
242
243 /* VARIABLE I/O DESCRIPTION */
244 /* -------- --- -------------------------------------------------- */
245 /* LBCELL P The SPICELIB cell lower bound. */
246 /* MXBEGM P Maximum progress report message prefix length. */
247 /* MXENDM P Maximum progress report message suffix length. */
248 /* WINDOW I A window over which a job is to be performed. */
249 /* BEGMSS I Beginning of the text portion of the output message */
250 /* ENDMSS I End of the text portion of the output message */
251 /* IVBEG I Current confinement window interval start time. */
252 /* IVEND I Current confinement window interval stop time. */
253 /* TIME I Input to the reporting routine. */
254
255 /* $ Detailed_Input */
256
257 /* See the individual entry points. */
258
259 /* $ Detailed_Output */
260
261 /* See the individual entry points. */
262
263 /* $ Parameters */
264
265 /* LBCELL is the SPICELIB cell lower bound. */
266
267 /* MXBEGM, */
268 /* MXENDM are, respectively, the maximum lengths of the progress */
269 /* report message prefix and suffix. */
270
271 /* $ Exceptions */
272
273 /* See the individual entry points. */
274
275 /* $ Files */
276
277 /* None. */
278
279 /* $ Particulars */
280
281 /* This umbrella routine contains default progress reporting entry */
282 /* points that display a report via console I/O. These routines may */
283 /* be used by SPICE-based applications as inputs to mid-level GF */
284 /* search routines. These routines may be useful even when progress */
285 /* reporting is not desired, since the mid-level search routines */
286 /* provide some capabilities that aren't supported by the top-level */
287 /* GF routines. */
288
289 /* Developers wishing to use their own GF progress reporting */
290 /* routines must design them with the same interfaces and should */
291 /* assign them the same progress reporting roles as the entry points */
292 /* of these routines. */
293
294 /* The entry points contained in this routine are written to */
295 /* make reporting of work (such as searching for a geometric event) */
296 /* over a particular window easy. This is an important feature for */
297 /* interactive programs that may "go away" from the user's control */
298 /* for a considerable length of time. It allows the user to see that */
299 /* something is still going on (although maybe not too quickly). */
300
301 /* The three entry points contained under this module are: */
302
303 /* GFREPI used to set up the reporting mechanism. It lets GFRPRT */
304 /* know that some task is about to begin that involves */
305 /* interaction with some window of times. It is used */
306 /* only to set up and store the constants associated with */
307 /* the reporting of the job in progress. */
308
309 /* GFREPU is used to notify the reporter that work has */
310 /* progressed to a given point with respect to the start */
311 /* of the confinement window. */
312
313 /* GFREPF is used to "finish" the reporting of work (set the */
314 /* completion value to 100%. */
315
316 /* The progress reporting utilities are called by GF search routines */
317 /* as follows: */
318
319 /* 1) Given a window over which some work is to be performed, */
320 /* CALL GFREPI with the appropriate inputs, to let the routine */
321 /* know the intervals over which some work is to be done. */
322
323 /* 2) Each time some "good" amount of work has been done, call */
324 /* GFREPU so that the total amount of work done can be updated */
325 /* and can be reported. */
326
327 /* 3) When work is complete call GFREPF to "clean up" the end of */
328 /* the progress report. */
329
330 /* $ Examples */
331
332 /* 1) This example shows how to call a mid-level GF search API that */
333 /* requires as input progress reporting routines. */
334
335 /* If custom progress reporting routines are available, they */
336 /* can replace GFREPI, GFREPU, and GFREPF in any GF API calls. */
337
338 /* The code fragment below is from the first code example in the */
339 /* header of */
340
341 /* gfocce.for */
342
343 /* Only the portions of that program relevant to use of the */
344 /* progress reporting routines are copied here. Deleted portions */
345 /* of code are indicated by ellipses. */
346
347
348 /* PROGRAM EX1 */
349
350 /* IMPLICIT NONE */
351
352 /* ... */
353
354 /* EXTERNAL GFREPI */
355 /* EXTERNAL GFREPU */
356 /* EXTERNAL GFREPF */
357
358 /* ... */
359
360 /* C */
361 /* C Turn on progress reporting; turn off interrupt */
362 /* C handling. */
363 /* C */
364 /* RPT = .TRUE. */
365 /* ... */
366
367 /* C */
368 /* C Perform the search. */
369 /* C */
370 /* CALL GFOCCE ( 'ANY', */
371 /* . 'MOON', 'ellipsoid', 'IAU_MOON', */
372 /* . 'SUN', 'ellipsoid', 'IAU_SUN', */
373 /* . 'LT', 'EARTH', CNVTOL, */
374 /* . GFSTEP, GFREFN, RPT, */
375 /* . GFREPI, GFREPU, GFREPF, */
376 /* . BAIL, GFBAIL, CNFINE, RESULT ) */
377
378
379 /* ... */
380
381
382
383 /* 2) The following piece of code provides a more concrete example */
384 /* of how these routines might be used. It is part of code that */
385 /* performs a search for the time of an occultation of one body */
386 /* by another. It is intended only for illustration and is not */
387 /* recommended for use in code that has to do real work. */
388
389 /* C */
390 /* C Prepare the progress reporter if appropriate. */
391 /* C */
392 /* IF ( RPT ) THEN */
393 /* CALL UDREPI ( CNFINE, 'Occultation/transit search ', */
394 /* . 'done.' ) */
395 /* END IF */
396
397 /* C */
398 /* C Cycle over the intervals in the confining window. */
399 /* C */
400 /* COUNT = WNCARD(CNFINE) */
401
402 /* DO I = 1, COUNT */
403 /* C */
404 /* C Retrieve the bounds for the Ith interval of the confinement */
405 /* C window. Search this interval for occultation events. */
406 /* C Union the result with the contents of the RESULT window. */
407 /* C */
408 /* CALL WNFETD ( CNFINE, I, START, FINISH ) */
409
410 /* CALL ZZGFSOLV ( ZZGFOCST, UDSTEP, UDREFN, BAIL, */
411 /* . UDBAIL, CSTEP, STEP, START, */
412 /* . FINISH, TOL, RPT, UDREPU, */
413 /* . RESULT ) */
414
415
416 /* IF ( FAILED() ) THEN */
417 /* CALL CHKOUT ( 'GFOCCE' ) */
418 /* RETURN */
419 /* END IF */
420
421 /* IF ( BAIL ) THEN */
422 /* C */
423 /* C Interrupt handling is enabled. */
424 /* C */
425 /* IF ( UDBAIL () ) THEN */
426 /* C */
427 /* C An interrupt has been issued. Return now regardless of */
428 /* C whether the search has been completed. */
429 /* C */
430 /* CALL CHKOUT ( 'GFOCCE' ) */
431 /* RETURN */
432
433 /* END IF */
434
435 /* END IF */
436
437 /* END DO */
438
439 /* C */
440 /* C End the progress report. */
441 /* C */
442 /* IF ( RPT ) THEN */
443 /* CALL UDREPF */
444 /* END IF */
445
446
447 /* $ Restrictions */
448
449 /* None. */
450
451 /* $ Literature_References */
452
453 /* None. */
454
455 /* $ Author_and_Institution */
456
457 /* N.J. Bachman (JPL) */
458 /* L.S. Elson (JPL) */
459 /* W.L. Taber (JPL) */
460 /* I.M. Underwood (JPL) */
461 /* B.V. Semenov (JPL) */
462
463 /* $ Version */
464
465 /* - SPICELIB Version 1.0.1 10-FEB-2014 (BVS) */
466
467 /* Added declarations of IVBEG and IVEND to the Declarations */
468 /* section of the GFREPU header. */
469
470 /* Corrected declaration of WINDOW in the Declarations */
471 /* section and added descriptions of LBCELL to the GFREPI */
472 /* header. */
473
474 /* - SPICELIB Version 1.0.0 06-MAR-2009 (NJB) (LSE) (WLT) (IMU) */
475
476
477 /* -& */
478 /* $ Index_Entries */
479
480 /* GF progress report umbrella */
481
482 /* -& */
483
484 /* SPICELIB functions */
485
486
487 /* Local parameters */
488
489
490 /* Local variables */
491
492 /* Parameter adjustments */
493 if (window) {
494 }
495
496 /* Function Body */
497 switch(n__) {
498 case 1: goto L_gfrepi;
499 case 2: goto L_gfrepu;
500 case 3: goto L_gfrepf;
501 }
502
503 chkin_("GFRPRT", (ftnlen)6);
504 sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17);
505 chkout_("GFRPRT", (ftnlen)6);
506 return 0;
507 /* $Procedure GFREPI ( GF, progress report initialization ) */
508
509 L_gfrepi:
510 /* $ Abstract */
511
512 /* This entry point initializes a search progress report. */
513
514 /* $ Disclaimer */
515
516 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
517 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
518 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
519 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
520 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
521 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
522 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
523 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
524 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
525 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
526
527 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
528 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
529 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
530 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
531 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
532 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
533
534 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
535 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
536 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
537 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
538
539 /* $ Required_Reading */
540
541 /* GF */
542
543 /* $ Keywords */
544
545 /* SEARCH */
546 /* UTILITY */
547
548 /* $ Declarations */
549
550 /* DOUBLE PRECISION WINDOW ( LBCELL : * ) */
551 /* CHARACTER*(*) BEGMSS */
552 /* CHARACTER*(*) ENDMSS */
553
554 /* $ Brief_I/O */
555
556 /* VARIABLE I/O DESCRIPTION */
557 /* -------- --- -------------------------------------------------- */
558 /* LBCELL P The SPICELIB cell lower bound. */
559 /* MXBEGM P Maximum progress report message prefix length. */
560 /* MXENDM P Maximum progress report message suffix length. */
561 /* WINDOW I A window over which a job is to be performed. */
562 /* BEGMSS I Beginning of the text portion of the output message */
563 /* ENDMSS I End of the text portion of the output message */
564
565 /* $ Detailed_Input */
566
567 /* WINDOW is the name of a constraint window. This is the window */
568 /* associated with some root finding activity. It is */
569 /* used to determine how much total time is being searched */
570 /* in order to find the events of interest. */
571
572 /* BEGMSS is the beginning of the output message reported by the */
573 /* routine GFRPWK. This output message has the form */
574
575 /* BEGMSS(1:LASTNB(BEGMSS)) // ' xx.xx% ' // ENDMSS */
576
577 /* BEGMSS must have length not greater than MXBEGM */
578 /* characters. All characters of BEGMSS must be printable. */
579
580 /* ENDMSS is the last portion of the output message reported by */
581 /* the routine GFRPWK. */
582
583 /* ENDMSS must have length not greater than MXBENM */
584 /* characters. All characters of ENDMSS must be printable. */
585
586 /* $ Detailed_Output */
587
588 /* None. */
589
590 /* $ Parameters */
591
592 /* LBCELL is the SPICELIB cell lower bound. */
593
594 /* MXBEGM, */
595 /* MXENDM are, respectively, the maximum lengths of the progress */
596 /* report message prefix and suffix. See the INCLUDE file */
597 /* zzgf.inc for details. */
598
599 /* $ Exceptions */
600
601 /* 1) If BEGMSS has length greater than MXBEGM characters, or if */
602 /* ENDMSS has length greater than MXENDM characters, the error */
603 /* SPICE(MESSAGETOOLONG) is signaled. */
604
605 /* 2) If either BEGMSS or ENDMSS contains non-printing characters, */
606 /* the error SPICE(NOTPRINTABLECHARS) is signaled. */
607
608 /* $ Files */
609
610 /* None. */
611
612 /* $ Particulars */
613
614 /* This entry point initializes the GF progress reporting system. It */
615 /* is called by the GF root finding utilities once at the start of */
616 /* each search pass. See the Particulars section of the main */
617 /* subroutine header for further details of its function. */
618
619 /* $ Examples */
620
621 /* See the header of the umbrella routine GFRPRT. */
622
623 /* $ Restrictions */
624
625 /* None. */
626
627 /* $ Literature_References */
628
629 /* None. */
630
631 /* $ Author_and_Institution */
632
633 /* N.J. Bachman (JPL) */
634 /* L.S. Elson (JPL) */
635 /* W.L. Taber (JPL) */
636 /* I.M. Underwood (JPL) */
637 /* B.V. Semenov (JPL) */
638
639 /* $ Version */
640
641 /* - SPICELIB Version 1.0.1 10-FEB-2014 (BVS) */
642
643 /* Corrected declaration of WINDOW in the Declarations */
644 /* section. Added description of LBCELL to the Declarations, */
645 /* Brief_I/O, and Parameters sections. */
646
647 /* - SPICELIB Version 1.0.0 21-FEB-2009 (NJB) (LSE) (WLT) (IMU) */
648
649 /* -& */
650 /* $ Index_Entries */
651
652 /* GF initialize a progress report */
653
654 /* -& */
655
656
657 /* Standard SPICE error handling. */
658
659 if (return_()) {
660 return 0;
661 }
662 chkin_("GFREPI", (ftnlen)6);
663
664 /* Check to see if either the message prefix or suffix */
665 /* is too long. */
666
667 if (lastnb_(begmss, begmss_len) > 55) {
668 setmsg_("Progress report prefix message contains # characters; limit"
669 " is #.", (ftnlen)65);
670 i__1 = lastnb_(begmss, begmss_len);
671 errint_("#", &i__1, (ftnlen)1);
672 errint_("#", &c__55, (ftnlen)1);
673 sigerr_("SPICE(MESSAGETOOLONG)", (ftnlen)21);
674 chkout_("GFREPI", (ftnlen)6);
675 return 0;
676 }
677 if (lastnb_(endmss, endmss_len) > 13) {
678 setmsg_("Progress report suffix message contains # characters; limit"
679 " is #.", (ftnlen)65);
680 i__1 = lastnb_(endmss, endmss_len);
681 errint_("#", &i__1, (ftnlen)1);
682 errint_("#", &c__13, (ftnlen)1);
683 sigerr_("SPICE(MESSAGETOOLONG)", (ftnlen)21);
684 chkout_("GFREPI", (ftnlen)6);
685 return 0;
686 }
687
688 /* Now check that all the characters in the message prefix and */
689 /* suffix can be printed. */
690
691 i__1 = lastnb_(begmss, begmss_len);
692 for (i__ = 1; i__ <= i__1; ++i__) {
693 chrcod = *(unsigned char *)&begmss[i__ - 1];
694 if (chrcod < 32 || chrcod > 126) {
695 setmsg_("The progress report message prefix contains a nonprinta"
696 "ble character; ASCII code is #.", (ftnlen)86);
697 errint_("#", &chrcod, (ftnlen)1);
698 sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24);
699 chkout_("GFREPI", (ftnlen)6);
700 return 0;
701 }
702 }
703 i__1 = lastnb_(endmss, endmss_len);
704 for (i__ = 1; i__ <= i__1; ++i__) {
705 chrcod = *(unsigned char *)&endmss[i__ - 1];
706 if (chrcod < 32 || chrcod > 126) {
707 setmsg_("The progress report message suffix contains a nonprinta"
708 "ble character; ASCII code is #.", (ftnlen)86);
709 errint_("#", &chrcod, (ftnlen)1);
710 sigerr_("SPICE(NONPRINTABLECHARS)", (ftnlen)24);
711 chkout_("GFREPI", (ftnlen)6);
712 return 0;
713 }
714 }
715 s_copy(copyb, begmss, (ftnlen)55, begmss_len);
716 s_copy(copye, endmss, (ftnlen)13, endmss_len);
717
718 /* Find the length of the window. Use that to initialize the work */
719 /* reporter. */
720
721 wnsumd_(window, &measur, &ave, &stddev, &short__, &long__);
722 zzgftswk_(&measur, &c_b26, &c__4, begmss, endmss, begmss_len, endmss_len);
723 if (failed_()) {
724 chkout_("GFREPI", (ftnlen)6);
725 return 0;
726 }
727
728 /* Initialize the time to the start of the confinement window. */
729 /* The remaining amount of work in the current interval is */
730 /* the measure of the interval. */
731
732 if (cardd_(window) >= 2) {
733 t0 = window[6];
734 remain = window[7] - t0;
735 } else {
736 remain = 0.;
737 }
738 chkout_("GFREPI", (ftnlen)6);
739 return 0;
740 /* $Procedure GFREPU ( GF, progress report update ) */
741
742 L_gfrepu:
743 /* $ Abstract */
744
745 /* This entry point tells the progress reporting system */
746 /* how far a search has progressed. */
747
748 /* $ Disclaimer */
749
750 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
751 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
752 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
753 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
754 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
755 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
756 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
757 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
758 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
759 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
760
761 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
762 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
763 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
764 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
765 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
766 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
767
768 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
769 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
770 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
771 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
772
773 /* $ Required_Reading */
774
775 /* GF */
776
777 /* $ Keywords */
778
779 /* SEARCH */
780 /* UTILITY */
781
782 /* $ Declarations */
783
784 /* DOUBLE PRECISION IVBEG */
785 /* DOUBLE PRECISION IVEND */
786 /* DOUBLE PRECISION TIME */
787
788 /* $ Brief_I/O */
789
790 /* VARIABLE I/O DESCRIPTION */
791 /* -------- --- -------------------------------------------------- */
792 /* IVBEG I Start time of work interval. */
793 /* IVEND I End time of work interval. */
794 /* TIME I Current time being examined in the search process */
795
796 /* $ Detailed_Input */
797
798 /* IVBEG, */
799 /* IVEND are the bounds of an interval that is contained in some */
800 /* interval belonging to the confinement window. The */
801 /* confinement window is associated with some root finding */
802 /* activity. It is used to determine how much total time is */
803 /* being searched in order to find the events of interest. */
804
805 /* In order for a meaningful progress report to be */
806 /* displayed, IVBEG and IVEND must satisfy the following */
807 /* constraints: */
808
809 /* - IVBEG must be less than or equal to IVEND. */
810
811 /* - The interval [ IVBEG, IVEND ] must be contained in */
812 /* some interval of the confinement window. It can be */
813 /* a proper subset of the containing interval; that */
814 /* is, it can be smaller than the interval of the */
815 /* confinement window that contains it. */
816
817 /* - Over a search pass, the sum of the differences */
818
819 /* IVEND - IVBEG */
820
821 /* for all calls to this routine made during the pass */
822 /* must equal the measure of the confinement window. */
823
824
825 /* TIME is the current time reached in the search for an event. */
826 /* TIME must lie in the interval */
827
828 /* IVBEG : IVEND */
829
830 /* inclusive. The input values of TIME for a given interval */
831 /* need not form an increasing sequence. */
832
833 /* $ Detailed_Output */
834
835 /* None. This routine does perform console I/O when progress */
836 /* reporting is enabled. */
837
838 /* $ Parameters */
839
840 /* None. */
841
842 /* $ Exceptions */
843
844 /* 1) If IVBEG and IVEND are in decreasing order, the error */
845 /* SPICE(BADENDPOINTS) is signaled. */
846
847 /* 2) If TIME is not in the closed interval [IVBEG, IVEND], the */
848 /* error SPICE(VALUEOUTOFRANGE) is signaled. */
849
850 /* 3) Any I/O errors resulting from writing to standard output */
851 /* will be diagnosed by routines in the call tree of this */
852 /* routine. */
853
854 /* $ Files */
855
856 /* None. */
857
858 /* $ Particulars */
859
860 /* This entry point is used to indicate the current progress of a */
861 /* search. Using information recorded through the initialization */
862 /* entry point of this routine, the progress reporting system */
863 /* determines how much work has been completed and whether or not to */
864 /* report it on the users screen. */
865
866 /* $ Examples */
867
868 /* See the header of the umbrella routine GFRPRT. */
869
870 /* $ Restrictions */
871
872 /* This routine has no way of enforcing that the input values of */
873 /* IVBEG and IVEND are compatible with the input window passed to */
874 /* GFREPI. Callers of this routine are responsible for ensuring */
875 /* that this requirement is obeyed. */
876
877 /* $ Literature_References */
878
879 /* None. */
880
881 /* $ Author_and_Institution */
882
883 /* N.J. Bachman (JPL) */
884 /* L.S. Elson (JPL) */
885 /* W.L. Taber (JPL) */
886 /* I.M. Underwood (JPL) */
887 /* B.V. Semenov (JPL) */
888
889 /* $ Version */
890
891 /* - SPICELIB Version 1.0.1 10-FEB-2014 (BVS) */
892
893 /* Added declarations of IVBEG and IVEND to the Declarations */
894 /* section. */
895
896 /* - SPICELIB Version 1.0.0 21-FEB-2009 (NJB) (LSE) (WLT) (IMU) */
897
898 /* -& */
899 /* $ Index_Entries */
900
901 /* GF update a progress report */
902
903 /* -& */
904 if (return_()) {
905 return 0;
906 }
907 chkin_("GFREPU", (ftnlen)6);
908
909 /* Do a few error checks before getting started. */
910
911 /* We expect the endpoints of the current window to be in order. */
912
913 if (*ivend < *ivbeg) {
914 setmsg_("Interval endpoints are #:#; endpoints must be in increasing"
915 " order.", (ftnlen)66);
916 errdp_("#", ivbeg, (ftnlen)1);
917 errdp_("#", ivend, (ftnlen)1);
918 sigerr_("SPICE(BADENDPOINTS)", (ftnlen)19);
919 chkout_("GFREPU", (ftnlen)6);
920 return 0;
921 }
922
923 /* We expect TIME to be in the current interval of the confinement */
924 /* window. */
925
926 if (*time < *ivbeg || *time > *ivend) {
927 setmsg_("TIME should be in interval #:# but is #.", (ftnlen)40);
928 errdp_("#", time, (ftnlen)1);
929 errdp_("#", ivbeg, (ftnlen)1);
930 errdp_("#", ivend, (ftnlen)1);
931 sigerr_("SPICE(VALUEOUTOFRANGE)", (ftnlen)22);
932 chkout_("GFREPU", (ftnlen)6);
933 return 0;
934 }
935
936 /* The amount of work done is the difference between the current */
937 /* time and the previous time T0, presuming both times are in */
938 /* the current interval. Note this work amount may be negative. */
939
940 if (t0 >= *ivbeg && t0 <= *ivend) {
941 incr = *time - t0;
942 } else {
943
944 /* T0 is in the previous interval. The amount of work */
945 /* done to complete processing of that interval is REMAIN. */
946 /* The amount of work done in the current interval is */
947 /* the difference of TIME and the left endpoint of the */
948 /* interval. */
949
950 incr = remain + *time - *ivbeg;
951 }
952
953 /* The remaining work is the distance from TIME to the right */
954 /* endpoint of the current interval. */
955
956 remain = *ivend - *time;
957
958 /* Record the current time as T0. */
959
960 t0 = *time;
961
962 /* Report the work increment. */
963
964 zzgfwkin_(&incr);
965 chkout_("GFREPU", (ftnlen)6);
966 return 0;
967 /* $Procedure GFREPF ( GF, progress report finalization ) */
968
969 L_gfrepf:
970 /* $ Abstract */
971
972 /* Finish a progress report. */
973
974 /* $ Disclaimer */
975
976 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
977 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
978 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
979 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
980 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
981 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
982 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
983 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
984 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
985 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
986
987 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
988 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
989 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
990 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
991 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
992 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
993
994 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
995 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
996 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
997 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
998
999 /* $ Required_Reading */
1000
1001 /* GF */
1002
1003 /* $ Keywords */
1004
1005 /* SEARCH */
1006 /* UTILITY */
1007
1008 /* $ Declarations */
1009
1010 /* None. */
1011
1012 /* $ Brief_I/O */
1013
1014 /* VARIABLE I/O DESCRIPTION */
1015 /* -------- --- -------------------------------------------------- */
1016 /* None. */
1017
1018 /* $ Detailed_Input */
1019
1020 /* None. */
1021
1022 /* $ Detailed_Output */
1023
1024 /* None. This routine does perform console I/O when progress */
1025 /* reporting is enabled. */
1026
1027 /* $ Parameters */
1028
1029 /* None. */
1030
1031 /* $ Exceptions */
1032
1033 /* 1) Any I/O errors resulting from writing to standard output */
1034 /* will be diagnosed by routines in the call tree of this */
1035 /* routine. */
1036
1037 /* $ Files */
1038
1039 /* None. */
1040
1041 /* $ Particulars */
1042
1043 /* This entry point "finishes" a progress report, i.e. updates the */
1044 /* report to indicate the underlying task is 100% complete. */
1045
1046 /* $ Examples */
1047
1048 /* See the header of the umbrella routine GFRPRT. */
1049
1050 /* $ Restrictions */
1051
1052 /* None. */
1053
1054 /* $ Literature_References */
1055
1056 /* None. */
1057
1058 /* $ Author_and_Institution */
1059
1060 /* N.J. Bachman (JPL) */
1061 /* L.S. Elson (JPL) */
1062 /* W.L. Taber (JPL) */
1063 /* I.M. Underwood (JPL) */
1064
1065 /* $ Version */
1066
1067 /* - SPICELIB Version 1.0.0 21-FEB-2009 (NJB) (LSE) (WLT) (IMU) */
1068
1069 /* -& */
1070 /* $ Index_Entries */
1071
1072 /* GF finish a progress report */
1073
1074 /* -& */
1075 if (return_()) {
1076 return 0;
1077 }
1078 chkin_("GFREPF", (ftnlen)6);
1079 zzgfwkad_(&c_b44, &c__1, copyb, copye, (ftnlen)55, (ftnlen)13);
1080 zzgfwkin_(&c_b44);
1081
1082 /* Determine whether progress report output is currently */
1083 /* being sent to standard output. Fetch the output unit. */
1084
1085 zzgfwkmo_(&unit, &total, &freq, &tcheck, begin, end, &incr, (ftnlen)55, (
1086 ftnlen)13);
1087 stdio_("STDOUT", &stdout, (ftnlen)6);
1088 if (unit != stdout) {
1089
1090 /* We're not currently writing to standard output, so we're */
1091 /* done. */
1092
1093 chkout_("GFREPF", (ftnlen)6);
1094 return 0;
1095 }
1096
1097 /* Emit a final blank line by moving the cursor down two */
1098 /* spaces. */
1099
1100 /* The set of actual arguments passed here is rather funky */
1101 /* and deserves some explanation: */
1102
1103 /* The first argument, calling for a leading blank line, moves */
1104 /* the cursor down so that the next blank line written won't */
1105 /* overwrite the final status message. That blank line is */
1106 /* followed with a cursor repositioning command that moves the */
1107 /* cursor to the beginning of the line that was just written. The */
1108 /* last argument, calling for another blank line, moves the */
1109 /* cursor down again. The total cursor movement is down 2 lines. */
1110 /* This results in one skipped line. */
1111
1112 /* We could accomplish the same results more simply if were */
1113 /* were to use I/O statements in this routine; however, in the */
1114 /* interest of minimizing the number of places where I/O is */
1115 /* performed, we rely on ZZGFDSPS to do that job. */
1116
1117 zzgfdsps_(&c__1, " ", "A", &c__1, (ftnlen)1, (ftnlen)1);
1118 chkout_("GFREPF", (ftnlen)6);
1119 return 0;
1120 } /* gfrprt_ */
1121
gfrprt_(doublereal * window,char * begmss,char * endmss,doublereal * ivbeg,doublereal * ivend,doublereal * time,ftnlen begmss_len,ftnlen endmss_len)1122 /* Subroutine */ int gfrprt_(doublereal *window, char *begmss, char *endmss,
1123 doublereal *ivbeg, doublereal *ivend, doublereal *time, ftnlen
1124 begmss_len, ftnlen endmss_len)
1125 {
1126 return gfrprt_0_(0, window, begmss, endmss, ivbeg, ivend, time,
1127 begmss_len, endmss_len);
1128 }
1129
gfrepi_(doublereal * window,char * begmss,char * endmss,ftnlen begmss_len,ftnlen endmss_len)1130 /* Subroutine */ int gfrepi_(doublereal *window, char *begmss, char *endmss,
1131 ftnlen begmss_len, ftnlen endmss_len)
1132 {
1133 return gfrprt_0_(1, window, begmss, endmss, (doublereal *)0, (doublereal *
1134 )0, (doublereal *)0, begmss_len, endmss_len);
1135 }
1136
gfrepu_(doublereal * ivbeg,doublereal * ivend,doublereal * time)1137 /* Subroutine */ int gfrepu_(doublereal *ivbeg, doublereal *ivend, doublereal
1138 *time)
1139 {
1140 return gfrprt_0_(2, (doublereal *)0, (char *)0, (char *)0, ivbeg, ivend,
1141 time, (ftnint)0, (ftnint)0);
1142 }
1143
gfrepf_(void)1144 /* Subroutine */ int gfrepf_(void)
1145 {
1146 return gfrprt_0_(3, (doublereal *)0, (char *)0, (char *)0, (doublereal *)
1147 0, (doublereal *)0, (doublereal *)0, (ftnint)0, (ftnint)0);
1148 }
1149
1150