You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

slaset.f 4.9 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184
  1. *> \brief \b SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download SLASET + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaset.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaset.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaset.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE SLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
  22. *
  23. * .. Scalar Arguments ..
  24. * CHARACTER UPLO
  25. * INTEGER LDA, M, N
  26. * REAL ALPHA, BETA
  27. * ..
  28. * .. Array Arguments ..
  29. * REAL A( LDA, * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> SLASET initializes an m-by-n matrix A to BETA on the diagonal and
  39. *> ALPHA on the offdiagonals.
  40. *> \endverbatim
  41. *
  42. * Arguments:
  43. * ==========
  44. *
  45. *> \param[in] UPLO
  46. *> \verbatim
  47. *> UPLO is CHARACTER*1
  48. *> Specifies the part of the matrix A to be set.
  49. *> = 'U': Upper triangular part is set; the strictly lower
  50. *> triangular part of A is not changed.
  51. *> = 'L': Lower triangular part is set; the strictly upper
  52. *> triangular part of A is not changed.
  53. *> Otherwise: All of the matrix A is set.
  54. *> \endverbatim
  55. *>
  56. *> \param[in] M
  57. *> \verbatim
  58. *> M is INTEGER
  59. *> The number of rows of the matrix A. M >= 0.
  60. *> \endverbatim
  61. *>
  62. *> \param[in] N
  63. *> \verbatim
  64. *> N is INTEGER
  65. *> The number of columns of the matrix A. N >= 0.
  66. *> \endverbatim
  67. *>
  68. *> \param[in] ALPHA
  69. *> \verbatim
  70. *> ALPHA is REAL
  71. *> The constant to which the offdiagonal elements are to be set.
  72. *> \endverbatim
  73. *>
  74. *> \param[in] BETA
  75. *> \verbatim
  76. *> BETA is REAL
  77. *> The constant to which the diagonal elements are to be set.
  78. *> \endverbatim
  79. *>
  80. *> \param[out] A
  81. *> \verbatim
  82. *> A is REAL array, dimension (LDA,N)
  83. *> On exit, the leading m-by-n submatrix of A is set as follows:
  84. *>
  85. *> if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n,
  86. *> if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n,
  87. *> otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j,
  88. *>
  89. *> and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n).
  90. *> \endverbatim
  91. *>
  92. *> \param[in] LDA
  93. *> \verbatim
  94. *> LDA is INTEGER
  95. *> The leading dimension of the array A. LDA >= max(1,M).
  96. *> \endverbatim
  97. *
  98. * Authors:
  99. * ========
  100. *
  101. *> \author Univ. of Tennessee
  102. *> \author Univ. of California Berkeley
  103. *> \author Univ. of Colorado Denver
  104. *> \author NAG Ltd.
  105. *
  106. *> \date December 2016
  107. *
  108. *> \ingroup OTHERauxiliary
  109. *
  110. * =====================================================================
  111. SUBROUTINE SLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
  112. *
  113. * -- LAPACK auxiliary routine (version 3.7.0) --
  114. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  115. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  116. * December 2016
  117. *
  118. * .. Scalar Arguments ..
  119. CHARACTER UPLO
  120. INTEGER LDA, M, N
  121. REAL ALPHA, BETA
  122. * ..
  123. * .. Array Arguments ..
  124. REAL A( LDA, * )
  125. * ..
  126. *
  127. * =====================================================================
  128. *
  129. * .. Local Scalars ..
  130. INTEGER I, J
  131. * ..
  132. * .. External Functions ..
  133. LOGICAL LSAME
  134. EXTERNAL LSAME
  135. * ..
  136. * .. Intrinsic Functions ..
  137. INTRINSIC MIN
  138. * ..
  139. * .. Executable Statements ..
  140. *
  141. IF( LSAME( UPLO, 'U' ) ) THEN
  142. *
  143. * Set the strictly upper triangular or trapezoidal part of the
  144. * array to ALPHA.
  145. *
  146. DO 20 J = 2, N
  147. DO 10 I = 1, MIN( J-1, M )
  148. A( I, J ) = ALPHA
  149. 10 CONTINUE
  150. 20 CONTINUE
  151. *
  152. ELSE IF( LSAME( UPLO, 'L' ) ) THEN
  153. *
  154. * Set the strictly lower triangular or trapezoidal part of the
  155. * array to ALPHA.
  156. *
  157. DO 40 J = 1, MIN( M, N )
  158. DO 30 I = J + 1, M
  159. A( I, J ) = ALPHA
  160. 30 CONTINUE
  161. 40 CONTINUE
  162. *
  163. ELSE
  164. *
  165. * Set the leading m-by-n submatrix to ALPHA.
  166. *
  167. DO 60 J = 1, N
  168. DO 50 I = 1, M
  169. A( I, J ) = ALPHA
  170. 50 CONTINUE
  171. 60 CONTINUE
  172. END IF
  173. *
  174. * Set the first min(M,N) diagonal elements to BETA.
  175. *
  176. DO 70 I = 1, MIN( M, N )
  177. A( I, I ) = BETA
  178. 70 CONTINUE
  179. *
  180. RETURN
  181. *
  182. * End of SLASET
  183. *
  184. END