1 /*
2 
3  * Revision 1.1  1996/08/19  22:30:41  jaf
4  * Initial revision
5  *
6 
7 */
8 
9 /*  -- translated by f2c (version 19951025).
10    You must link the resulting object file with the libraries:
11 	-lf2c -lm   (in that order)
12 */
13 
14 #include "f2c.h"
15 
16 extern int rcchk_(integer *order, real *rc1f, real *rc2f);
17 
18 /* ********************************************************************* */
19 
20 /* 	RCCHK Version 45G */
21 
22 /*
23  * Revision 1.1  1996/08/19  22:30:41  jaf
24  * Initial revision
25  * */
26 /* Revision 1.4  1996/03/27  18:13:47  jaf */
27 /* Commented out a call to subroutine ERROR. */
28 
29 /* Revision 1.3  1996/03/18  15:48:53  jaf */
30 /* Just added a few comments about which array indices of the arguments */
31 /* are used, and mentioning that this subroutine has no local state. */
32 
33 /* Revision 1.2  1996/03/13  16:55:22  jaf */
34 /* Comments added explaining that none of the local variables of this */
35 /* subroutine need to be saved from one invocation to the next. */
36 
37 /* Revision 1.1  1996/02/07 14:49:08  jaf */
38 /* Initial revision */
39 
40 
41 /* ********************************************************************* */
42 
43 /*  Check RC's, repeat previous frame's RC's if unstable */
44 
45 /* Input: */
46 /*  ORDER - Number of RC's */
47 /*  RC1F  - Previous frame's RC's */
48 /*          Indices 1 through ORDER may be read. */
49 /* Input/Output: */
50 /*  RC2F  - Present frame's RC's */
51 /*          Indices 1 through ORDER may be read, and written. */
52 
53 /* This subroutine has no local state. */
54 
rcchk_(integer * order,real * rc1f,real * rc2f)55 /* Subroutine */ int rcchk_(integer *order, real *rc1f, real *rc2f)
56 {
57     /* System generated locals */
58     integer i__1;
59     real r__1;
60 
61     /* Local variables */
62     integer i__;
63 
64 /*       Arguments */
65 /*       Local variables that need not be saved */
66     /* Parameter adjustments */
67     --rc2f;
68     --rc1f;
69 
70     /* Function Body */
71     i__1 = *order;
72     for (i__ = 1; i__ <= i__1; ++i__) {
73 	if ((r__1 = rc2f[i__], abs(r__1)) > .99f) {
74 	    goto L10;
75 	}
76     }
77     return 0;
78 /*       Note: In version embedded in other software, all calls to ERROR
79 */
80 /*       should probably be removed. */
81 L10:
82 
83 /*       This call to ERROR is only needed for debugging purposes. */
84 
85 /*       CALL ERROR('RCCHK',2,I) */
86     i__1 = *order;
87     for (i__ = 1; i__ <= i__1; ++i__) {
88 	rc2f[i__] = rc1f[i__];
89     }
90     return 0;
91 } /* rcchk_ */
92 
93