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.

dlaset.f 4.9 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181
  1. *> \brief \b DLASET 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 DLASET + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaset.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaset.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaset.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE DLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
  22. *
  23. * .. Scalar Arguments ..
  24. * CHARACTER UPLO
  25. * INTEGER LDA, M, N
  26. * DOUBLE PRECISION ALPHA, BETA
  27. * ..
  28. * .. Array Arguments ..
  29. * DOUBLE PRECISION A( LDA, * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> DLASET 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 DOUBLE PRECISION
  71. *> The constant to which the offdiagonal elements are to be set.
  72. *> \endverbatim
  73. *>
  74. *> \param[in] BETA
  75. *> \verbatim
  76. *> BETA is DOUBLE PRECISION
  77. *> The constant to which the diagonal elements are to be set.
  78. *> \endverbatim
  79. *>
  80. *> \param[out] A
  81. *> \verbatim
  82. *> A is DOUBLE PRECISION 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. *> \ingroup OTHERauxiliary
  107. *
  108. * =====================================================================
  109. SUBROUTINE DLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
  110. *
  111. * -- LAPACK auxiliary routine --
  112. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  113. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  114. *
  115. * .. Scalar Arguments ..
  116. CHARACTER UPLO
  117. INTEGER LDA, M, N
  118. DOUBLE PRECISION ALPHA, BETA
  119. * ..
  120. * .. Array Arguments ..
  121. DOUBLE PRECISION A( LDA, * )
  122. * ..
  123. *
  124. * =====================================================================
  125. *
  126. * .. Local Scalars ..
  127. INTEGER I, J
  128. * ..
  129. * .. External Functions ..
  130. LOGICAL LSAME
  131. EXTERNAL LSAME
  132. * ..
  133. * .. Intrinsic Functions ..
  134. INTRINSIC MIN
  135. * ..
  136. * .. Executable Statements ..
  137. *
  138. IF( LSAME( UPLO, 'U' ) ) THEN
  139. *
  140. * Set the strictly upper triangular or trapezoidal part of the
  141. * array to ALPHA.
  142. *
  143. DO 20 J = 2, N
  144. DO 10 I = 1, MIN( J-1, M )
  145. A( I, J ) = ALPHA
  146. 10 CONTINUE
  147. 20 CONTINUE
  148. *
  149. ELSE IF( LSAME( UPLO, 'L' ) ) THEN
  150. *
  151. * Set the strictly lower triangular or trapezoidal part of the
  152. * array to ALPHA.
  153. *
  154. DO 40 J = 1, MIN( M, N )
  155. DO 30 I = J + 1, M
  156. A( I, J ) = ALPHA
  157. 30 CONTINUE
  158. 40 CONTINUE
  159. *
  160. ELSE
  161. *
  162. * Set the leading m-by-n submatrix to ALPHA.
  163. *
  164. DO 60 J = 1, N
  165. DO 50 I = 1, M
  166. A( I, J ) = ALPHA
  167. 50 CONTINUE
  168. 60 CONTINUE
  169. END IF
  170. *
  171. * Set the first min(M,N) diagonal elements to BETA.
  172. *
  173. DO 70 I = 1, MIN( M, N )
  174. A( I, I ) = BETA
  175. 70 CONTINUE
  176. *
  177. RETURN
  178. *
  179. * End of DLASET
  180. *
  181. END