icmax1.c 2.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128
  1. /* icmax1.f -- translated by f2c (version 20061008).
  2. You must link the resulting object file with libf2c:
  3. on Microsoft Windows system, link with libf2c.lib;
  4. on Linux or Unix systems, link with .../path/to/libf2c.a -lm
  5. or, if you install libf2c.a in a standard place, with -lf2c -lm
  6. -- in that order, at the end of the command line, as in
  7. cc *.o -lf2c -lm
  8. Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
  9. http://www.netlib.org/f2c/libf2c.zip
  10. */
  11. #include "f2c.h"
  12. #include "blaswrap.h"
  13. integer _starpu_icmax1_(integer *n, complex *cx, integer *incx)
  14. {
  15. /* System generated locals */
  16. integer ret_val, i__1;
  17. /* Builtin functions */
  18. double c_abs(complex *);
  19. /* Local variables */
  20. integer i__, ix;
  21. real smax;
  22. /* -- LAPACK auxiliary routine (version 3.2) -- */
  23. /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  24. /* November 2006 */
  25. /* .. Scalar Arguments .. */
  26. /* .. */
  27. /* .. Array Arguments .. */
  28. /* .. */
  29. /* Purpose */
  30. /* ======= */
  31. /* ICMAX1 finds the index of the element whose real part has maximum */
  32. /* absolute value. */
  33. /* Based on ICAMAX from Level 1 BLAS. */
  34. /* The change is to use the 'genuine' absolute value. */
  35. /* Contributed by Nick Higham for use with CLACON. */
  36. /* Arguments */
  37. /* ========= */
  38. /* N (input) INTEGER */
  39. /* The number of elements in the vector CX. */
  40. /* CX (input) COMPLEX array, dimension (N) */
  41. /* The vector whose elements will be summed. */
  42. /* INCX (input) INTEGER */
  43. /* The spacing between successive values of CX. INCX >= 1. */
  44. /* ===================================================================== */
  45. /* .. Local Scalars .. */
  46. /* .. */
  47. /* .. Intrinsic Functions .. */
  48. /* .. */
  49. /* .. Statement Functions .. */
  50. /* .. */
  51. /* .. Statement Function definitions .. */
  52. /* NEXT LINE IS THE ONLY MODIFICATION. */
  53. /* .. */
  54. /* .. Executable Statements .. */
  55. /* Parameter adjustments */
  56. --cx;
  57. /* Function Body */
  58. ret_val = 0;
  59. if (*n < 1) {
  60. return ret_val;
  61. }
  62. ret_val = 1;
  63. if (*n == 1) {
  64. return ret_val;
  65. }
  66. if (*incx == 1) {
  67. goto L30;
  68. }
  69. /* CODE FOR INCREMENT NOT EQUAL TO 1 */
  70. ix = 1;
  71. smax = c_abs(&cx[1]);
  72. ix += *incx;
  73. i__1 = *n;
  74. for (i__ = 2; i__ <= i__1; ++i__) {
  75. if (c_abs(&cx[ix]) <= smax) {
  76. goto L10;
  77. }
  78. ret_val = i__;
  79. smax = c_abs(&cx[ix]);
  80. L10:
  81. ix += *incx;
  82. /* L20: */
  83. }
  84. return ret_val;
  85. /* CODE FOR INCREMENT EQUAL TO 1 */
  86. L30:
  87. smax = c_abs(&cx[1]);
  88. i__1 = *n;
  89. for (i__ = 2; i__ <= i__1; ++i__) {
  90. if (c_abs(&cx[i__]) <= smax) {
  91. goto L40;
  92. }
  93. ret_val = i__;
  94. smax = c_abs(&cx[i__]);
  95. L40:
  96. ;
  97. }
  98. return ret_val;
  99. /* End of ICMAX1 */
  100. } /* _starpu_icmax1_ */