dlaset.c 4.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153
  1. /* dlaset.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_dlaset_(char *uplo, integer *m, integer *n, doublereal *
  14. alpha, doublereal *beta, doublereal *a, integer *lda)
  15. {
  16. /* System generated locals */
  17. integer a_dim1, a_offset, i__1, i__2, i__3;
  18. /* Local variables */
  19. integer i__, j;
  20. extern logical _starpu_lsame_(char *, char *);
  21. /* -- LAPACK auxiliary routine (version 3.2) -- */
  22. /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  23. /* November 2006 */
  24. /* .. Scalar Arguments .. */
  25. /* .. */
  26. /* .. Array Arguments .. */
  27. /* .. */
  28. /* Purpose */
  29. /* ======= */
  30. /* DLASET initializes an m-by-n matrix A to BETA on the diagonal and */
  31. /* ALPHA on the offdiagonals. */
  32. /* Arguments */
  33. /* ========= */
  34. /* UPLO (input) CHARACTER*1 */
  35. /* Specifies the part of the matrix A to be set. */
  36. /* = 'U': Upper triangular part is set; the strictly lower */
  37. /* triangular part of A is not changed. */
  38. /* = 'L': Lower triangular part is set; the strictly upper */
  39. /* triangular part of A is not changed. */
  40. /* Otherwise: All of the matrix A is set. */
  41. /* M (input) INTEGER */
  42. /* The number of rows of the matrix A. M >= 0. */
  43. /* N (input) INTEGER */
  44. /* The number of columns of the matrix A. N >= 0. */
  45. /* ALPHA (input) DOUBLE PRECISION */
  46. /* The constant to which the offdiagonal elements are to be set. */
  47. /* BETA (input) DOUBLE PRECISION */
  48. /* The constant to which the diagonal elements are to be set. */
  49. /* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
  50. /* On exit, the leading m-by-n submatrix of A is set as follows: */
  51. /* if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n, */
  52. /* if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n, */
  53. /* otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j, */
  54. /* and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n). */
  55. /* LDA (input) INTEGER */
  56. /* The leading dimension of the array A. LDA >= max(1,M). */
  57. /* ===================================================================== */
  58. /* .. Local Scalars .. */
  59. /* .. */
  60. /* .. External Functions .. */
  61. /* .. */
  62. /* .. Intrinsic Functions .. */
  63. /* .. */
  64. /* .. Executable Statements .. */
  65. /* Parameter adjustments */
  66. a_dim1 = *lda;
  67. a_offset = 1 + a_dim1;
  68. a -= a_offset;
  69. /* Function Body */
  70. if (_starpu_lsame_(uplo, "U")) {
  71. /* Set the strictly upper triangular or trapezoidal part of the */
  72. /* array to ALPHA. */
  73. i__1 = *n;
  74. for (j = 2; j <= i__1; ++j) {
  75. /* Computing MIN */
  76. i__3 = j - 1;
  77. i__2 = min(i__3,*m);
  78. for (i__ = 1; i__ <= i__2; ++i__) {
  79. a[i__ + j * a_dim1] = *alpha;
  80. /* L10: */
  81. }
  82. /* L20: */
  83. }
  84. } else if (_starpu_lsame_(uplo, "L")) {
  85. /* Set the strictly lower triangular or trapezoidal part of the */
  86. /* array to ALPHA. */
  87. i__1 = min(*m,*n);
  88. for (j = 1; j <= i__1; ++j) {
  89. i__2 = *m;
  90. for (i__ = j + 1; i__ <= i__2; ++i__) {
  91. a[i__ + j * a_dim1] = *alpha;
  92. /* L30: */
  93. }
  94. /* L40: */
  95. }
  96. } else {
  97. /* Set the leading m-by-n submatrix to ALPHA. */
  98. i__1 = *n;
  99. for (j = 1; j <= i__1; ++j) {
  100. i__2 = *m;
  101. for (i__ = 1; i__ <= i__2; ++i__) {
  102. a[i__ + j * a_dim1] = *alpha;
  103. /* L50: */
  104. }
  105. /* L60: */
  106. }
  107. }
  108. /* Set the first min(M,N) diagonal elements to BETA. */
  109. i__1 = min(*m,*n);
  110. for (i__ = 1; i__ <= i__1; ++i__) {
  111. a[i__ + i__ * a_dim1] = *beta;
  112. /* L70: */
  113. }
  114. return 0;
  115. /* End of DLASET */
  116. } /* _starpu_dlaset_ */