rcchk.c 3.0 KB

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