Télécharger dgetrf.eso

Retour à la liste

Numérotation des lignes :

  1. C DGETRF SOURCE BP208322 20/09/18 21:15:52 10718
  2. *> \brief \b DGETRF
  3. *
  4. * =========== DOCUMENTATION ===========
  5. *
  6. * Online html documentation available at
  7. * http://www.netlib.org/lapack/explore-html/
  8. *
  9. *> \htmlonly
  10. *> Download SGETRF + dependencies
  11. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgetrf.f">
  12. *> [TGZ]</a>
  13. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgetrf.f">
  14. *> [ZIP]</a>
  15. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgetrf.f">
  16. *> [TXT]</a>
  17. *> \endhtmlonly
  18. *
  19. * Definition:
  20. * ===========
  21. *
  22. * SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO )
  23. *
  24. * .. Scalar Arguments ..
  25. * INTEGER INFO, LDA, M, N
  26. * ..
  27. * .. Array Arguments ..
  28. * INTEGER IPIV( * )
  29. * REAL A( LDA, * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> DGETRF computes an LU factorization of a general M-by-N matrix A
  39. *> using partial pivoting with row interchanges.
  40. *>
  41. *> The factorization has the form
  42. *> A = P * L * U
  43. *> where P is a permutation matrix, L is lower triangular with unit
  44. *> diagonal elements (lower trapezoidal if m > n), and U is upper
  45. *> triangular (upper trapezoidal if m < n).
  46. *>
  47. *> This is the right-looking Level 3 BLAS version of the algorithm.
  48. *> \endverbatim
  49. *
  50. * Arguments:
  51. * ==========
  52. *
  53. *> \param[in] M
  54. *> \verbatim
  55. *> M is INTEGER
  56. *> The number of rows of the matrix A. M >= 0.
  57. *> \endverbatim
  58. *>
  59. *> \param[in] N
  60. *> \verbatim
  61. *> N is INTEGER
  62. *> The number of columns of the matrix A. N >= 0.
  63. *> \endverbatim
  64. *>
  65. *> \param[in,out] A
  66. *> \verbatim
  67. *> A is REAL array, dimension (LDA,N)
  68. *> On entry, the M-by-N matrix to be factored.
  69. *> On exit, the factors L and U from the factorization
  70. *> A = P*L*U; the unit diagonal elements of L are not stored.
  71. *> \endverbatim
  72. *>
  73. *> \param[in] LDA
  74. *> \verbatim
  75. *> LDA is INTEGER
  76. *> The leading dimension of the array A. LDA >= max(1,M).
  77. *> \endverbatim
  78. *>
  79. *> \param[out] IPIV
  80. *> \verbatim
  81. *> IPIV is INTEGER array, dimension (min(M,N))
  82. *> The pivot indices; for 1 <= i <= min(M,N), row i of the
  83. *> matrix was interchanged with row IPIV(i).
  84. *> \endverbatim
  85. *>
  86. *> \param[out] INFO
  87. *> \verbatim
  88. *> INFO is INTEGER
  89. *> = 0: successful exit
  90. *> < 0: if INFO = -i, the i-th argument had an illegal value
  91. *> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
  92. *> has been completed, but the factor U is exactly
  93. *> singular, and division by zero will occur if it is used
  94. *> to solve a system of equations.
  95. *> \endverbatim
  96. *
  97. * Authors:
  98. * ========
  99. *
  100. *> \author Univ. of Tennessee
  101. *> \author Univ. of California Berkeley
  102. *> \author Univ. of Colorado Denver
  103. *> \author NAG Ltd.
  104. *
  105. *> \date December 2016
  106. *
  107. *> \ingroup realGEcomputational
  108. *
  109. * =====================================================================
  110. SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO )
  111. *
  112. * -- LAPACK computational routine (version 3.7.0) --
  113. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  114. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  115. * December 2016
  116.  
  117. IMPLICIT INTEGER(I-N)
  118. IMPLICIT REAL*8(A-H,O-Z)
  119. *
  120. * .. Scalar Arguments ..
  121. INTEGER INFO, LDA, M, N
  122. * ..
  123. * .. Array Arguments ..
  124. INTEGER IPIV( * )
  125. REAL*8 A( LDA, * )
  126. * ..
  127. * =====================================================================
  128. * ..
  129. * .. Parameters ..
  130. REAL*8 ONE, ZERO
  131. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  132.  
  133. * .. Local Scalars ..
  134. INTEGER I, IINFO, J, JB, NB
  135. * ..
  136. * .. External Subroutines ..
  137. * EXTERNAL DGEMM, DGETRF2, DLASWP, DTRSM, XERBLA
  138. * ..
  139. * .. External Functions ..
  140. * INTEGER ILAENV
  141. * EXTERNAL ILAENV
  142. * ..
  143. * .. Intrinsic Functions ..
  144. * INTRINSIC MAX, MIN
  145. * ..
  146. * .. Executable Statements ..
  147. *
  148. * Test the input parameters.
  149. *
  150. INFO = 0
  151. IF ( M.LT.0 ) THEN
  152. INFO = -1
  153. ELSE IF( N.LT.0 ) THEN
  154. INFO = -2
  155. ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
  156. INFO = -4
  157. END IF
  158. IF ( INFO.NE.0 ) THEN
  159. CALL XERBLA( 'DGETRF', -INFO )
  160. RETURN
  161. END IF
  162. *
  163. * Quick return if possible
  164. *
  165. IF (M.EQ.0 .OR. N.EQ.0) THEN
  166. RETURN
  167. ENDIF
  168. *
  169. * Determine the block size for this environment.
  170. *
  171. NB = ILAENV( 1, 'DGETRF', ' ', M, N, -1, -1 )
  172.  
  173. IF (NB.LE.1 .OR. NB.GE.MIN(M,N)) THEN
  174. *
  175. * Use unblocked code.
  176. *
  177. CALL DGETRF2( M, N, A, LDA, IPIV, INFO )
  178.  
  179. ELSE
  180. *
  181. * Use blocked code.
  182. *
  183. DO 20 J = 1, MIN( M, N ), NB
  184. JB = MIN( MIN( M, N )-J+1, NB )
  185. *
  186. * Factor diagonal and subdiagonal blocks and test for exact
  187. * singularity.
  188. *
  189. CALL DGETRF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO )
  190. *
  191. * Adjust INFO and the pivot indices.
  192. *
  193. IF( INFO.EQ.0 .AND. IINFO.GT.0 )
  194. & INFO = IINFO + J - 1
  195. DO 10 I = J, MIN( M, J+JB-1 )
  196. IPIV( I ) = J - 1 + IPIV( I )
  197. 10 CONTINUE
  198. *
  199. * Apply interchanges to columns 1:J-1.
  200. *
  201. CALL DLASWP( J-1, A, LDA, J, J+JB-1, IPIV, 1 )
  202. *
  203. IF( J+JB.LE.N ) THEN
  204. *
  205. * Apply interchanges to columns J+JB:N.
  206. *
  207. CALL DLASWP( N-J-JB+1, A( 1, J+JB ), LDA, J, J+JB-1,
  208. & IPIV, 1 )
  209. *
  210. * Compute block row of U.
  211. *
  212. CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB,
  213. & N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ),
  214. & LDA )
  215. IF( J+JB.LE.M ) THEN
  216. *
  217. * Update trailing submatrix.
  218. *
  219. CALL DGEMM( 'No transpose', 'No transpose', M-J-JB+1,
  220. & N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA,
  221. & A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ),
  222. & LDA )
  223. END IF
  224. END IF
  225. 20 CONTINUE
  226. END IF
  227. RETURN
  228. *
  229. * End of DGETRF
  230. *
  231. END
  232.  
  233.  
  234.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales