dlag2s.c 3.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116
  1. /* dlag2s.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. /* Subroutine */ int _starpu_dlag2s_(integer *m, integer *n, doublereal *a, integer *
  14. lda, real *sa, integer *ldsa, integer *info)
  15. {
  16. /* System generated locals */
  17. integer sa_dim1, sa_offset, a_dim1, a_offset, i__1, i__2;
  18. /* Local variables */
  19. integer i__, j;
  20. doublereal rmax;
  21. extern doublereal _starpu_slamch_(char *);
  22. /* -- LAPACK PROTOTYPE auxiliary routine (version 3.1.2) -- */
  23. /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  24. /* August 2007 */
  25. /* .. */
  26. /* .. Scalar Arguments .. */
  27. /* .. */
  28. /* .. Array Arguments .. */
  29. /* .. */
  30. /* Purpose */
  31. /* ======= */
  32. /* DLAG2S converts a DOUBLE PRECISION matrix, SA, to a SINGLE */
  33. /* PRECISION matrix, A. */
  34. /* RMAX is the overflow for the SINGLE PRECISION arithmetic */
  35. /* DLAG2S checks that all the entries of A are between -RMAX and */
  36. /* RMAX. If not the convertion is aborted and a flag is raised. */
  37. /* This is an auxiliary routine so there is no argument checking. */
  38. /* Arguments */
  39. /* ========= */
  40. /* M (input) INTEGER */
  41. /* The number of lines of the matrix A. M >= 0. */
  42. /* N (input) INTEGER */
  43. /* The number of columns of the matrix A. N >= 0. */
  44. /* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
  45. /* On entry, the M-by-N coefficient matrix A. */
  46. /* LDA (input) INTEGER */
  47. /* The leading dimension of the array A. LDA >= max(1,M). */
  48. /* SA (output) REAL array, dimension (LDSA,N) */
  49. /* On exit, if INFO=0, the M-by-N coefficient matrix SA; if */
  50. /* INFO>0, the content of SA is unspecified. */
  51. /* LDSA (input) INTEGER */
  52. /* The leading dimension of the array SA. LDSA >= max(1,M). */
  53. /* INFO (output) INTEGER */
  54. /* = 0: successful exit. */
  55. /* = 1: an entry of the matrix A is greater than the SINGLE */
  56. /* PRECISION overflow threshold, in this case, the content */
  57. /* of SA in exit is unspecified. */
  58. /* ========= */
  59. /* .. Local Scalars .. */
  60. /* .. */
  61. /* .. External Functions .. */
  62. /* .. */
  63. /* .. Executable Statements .. */
  64. /* Parameter adjustments */
  65. a_dim1 = *lda;
  66. a_offset = 1 + a_dim1;
  67. a -= a_offset;
  68. sa_dim1 = *ldsa;
  69. sa_offset = 1 + sa_dim1;
  70. sa -= sa_offset;
  71. /* Function Body */
  72. rmax = _starpu_slamch_("O");
  73. i__1 = *n;
  74. for (j = 1; j <= i__1; ++j) {
  75. i__2 = *m;
  76. for (i__ = 1; i__ <= i__2; ++i__) {
  77. if (a[i__ + j * a_dim1] < -rmax || a[i__ + j * a_dim1] > rmax) {
  78. *info = 1;
  79. goto L30;
  80. }
  81. sa[i__ + j * sa_dim1] = a[i__ + j * a_dim1];
  82. /* L10: */
  83. }
  84. /* L20: */
  85. }
  86. *info = 0;
  87. L30:
  88. return 0;
  89. /* End of DLAG2S */
  90. } /* _starpu_dlag2s_ */