Télécharger dgetrs.eso

Retour à la liste

Numérotation des lignes :

  1. C DGETRS SOURCE BP208322 20/09/18 21:15:54 10718
  2. *> \brief \b DGETRS
  3. *
  4. * =========== DOCUMENTATION ===========
  5. *
  6. * Online html documentation available at
  7. * http://www.netlib.org/lapack/explore-html/
  8. *
  9. *> \htmlonly
  10. *> Download SGETRS + dependencies
  11. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgetrs.f">
  12. *> [TGZ]</a>
  13. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgetrs.f">
  14. *> [ZIP]</a>
  15. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgetrs.f">
  16. *> [TXT]</a>
  17. *> \endhtmlonly
  18. *
  19. * Definition:
  20. * ===========
  21. *
  22. * SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
  23. *
  24. * .. Scalar Arguments ..
  25. * CHARACTER TRANS
  26. * INTEGER INFO, LDA, LDB, N, NRHS
  27. * ..
  28. * .. Array Arguments ..
  29. * INTEGER IPIV( * )
  30. * REAL A( LDA, * ), B( LDB, * )
  31. * ..
  32. *
  33. *
  34. *> \par Purpose:
  35. * =============
  36. *>
  37. *> \verbatim
  38. *>
  39. *> DGETRS solves a system of linear equations
  40. *> A * X = B or A**T * X = B
  41. *> with a general N-by-N matrix A using the LU factorization computed
  42. *> by DGETRF.
  43. *> \endverbatim
  44. *
  45. * Arguments:
  46. * ==========
  47. *
  48. *> \param[in] TRANS
  49. *> \verbatim
  50. *> TRANS is CHARACTER*1
  51. *> Specifies the form of the system of equations:
  52. *> = 'N': A * X = B (No transpose)
  53. *> = 'T': A**T* X = B (Transpose)
  54. *> = 'C': A**T* X = B (Conjugate transpose = Transpose)
  55. *> \endverbatim
  56. *>
  57. *> \param[in] N
  58. *> \verbatim
  59. *> N is INTEGER
  60. *> The order of the matrix A. N >= 0.
  61. *> \endverbatim
  62. *>
  63. *> \param[in] NRHS
  64. *> \verbatim
  65. *> NRHS is INTEGER
  66. *> The number of right hand sides, i.e., the number of columns
  67. *> of the matrix B. NRHS >= 0.
  68. *> \endverbatim
  69. *>
  70. *> \param[in] A
  71. *> \verbatim
  72. *> A is REAL array, dimension (LDA,N)
  73. *> The factors L and U from the factorization A = P*L*U
  74. *> as computed by SGETRF.
  75. *> \endverbatim
  76. *>
  77. *> \param[in] LDA
  78. *> \verbatim
  79. *> LDA is INTEGER
  80. *> The leading dimension of the array A. LDA >= max(1,N).
  81. *> \endverbatim
  82. *>
  83. *> \param[in] IPIV
  84. *> \verbatim
  85. *> IPIV is INTEGER array, dimension (N)
  86. *> The pivot indices from SGETRF; for 1<=i<=N, row i of the
  87. *> matrix was interchanged with row IPIV(i).
  88. *> \endverbatim
  89. *>
  90. *> \param[in,out] B
  91. *> \verbatim
  92. *> B is REAL array, dimension (LDB,NRHS)
  93. *> On entry, the right hand side matrix B.
  94. *> On exit, the solution matrix X.
  95. *> \endverbatim
  96. *>
  97. *> \param[in] LDB
  98. *> \verbatim
  99. *> LDB is INTEGER
  100. *> The leading dimension of the array B. LDB >= max(1,N).
  101. *> \endverbatim
  102. *>
  103. *> \param[out] INFO
  104. *> \verbatim
  105. *> INFO is INTEGER
  106. *> = 0: successful exit
  107. *> < 0: if INFO = -i, the i-th argument had an illegal value
  108. *> \endverbatim
  109. *
  110. * Authors:
  111. * ========
  112. *
  113. *> \author Univ. of Tennessee
  114. *> \author Univ. of California Berkeley
  115. *> \author Univ. of Colorado Denver
  116. *> \author NAG Ltd.
  117. *
  118. *> \date December 2016
  119. *
  120. *> \ingroup realGEcomputational
  121. *
  122. * =====================================================================
  123. SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
  124. *
  125. * -- LAPACK computational routine (version 3.7.0) --
  126. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  127. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  128. * December 2016
  129.  
  130. IMPLICIT INTEGER(I-N)
  131. IMPLICIT REAL*8(A-H,O-Z)
  132. *
  133. * .. Scalar Arguments ..
  134. CHARACTER TRANS
  135. INTEGER INFO, LDA, LDB, N, NRHS
  136. * ..
  137. * .. Array Arguments ..
  138. INTEGER IPIV( * )
  139. REAL*8 A( LDA, * ), B(LDB,*)
  140. *
  141. * =====================================================================
  142. *
  143. * .. Parameters ..
  144. REAL*8 ONE, ZERO
  145. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  146.  
  147. * .. Local Scalars ..
  148. LOGICAL NOTRAN
  149. * ..
  150. * ..
  151. * .. External Subroutines ..
  152. * EXTERNAL DLASWP, DTRSM, XERBLA
  153. * ..
  154. * ..
  155. *
  156. * Test the input parameters.
  157. *
  158. INFO = 0
  159. NOTRAN = (TRANS.EQ.'N')
  160. IF (.NOT.NOTRAN .AND. .NOT.( TRANS.EQ.'T') .AND. .NOT.
  161. & (TRANS.EQ. 'C') ) THEN
  162. INFO = -1
  163. ELSE IF( N.LT.0 ) THEN
  164. INFO = -2
  165. ELSE IF( NRHS.LT.0 ) THEN
  166. INFO = -3
  167. ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  168. INFO = -5
  169. ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
  170. INFO = -8
  171. END IF
  172. IF ( INFO.NE.0 ) THEN
  173. CALL XERBLA( 'DGETRS', -INFO )
  174. RETURN
  175. END IF
  176. *
  177. * Quick return if possible
  178. *
  179. IF ( N.EQ.0 .OR. NRHS.EQ.0 )
  180. & RETURN
  181. IF ( NOTRAN ) THEN
  182. *
  183. * Solve A * X = B.
  184. *
  185. * Apply row interchanges to the right hand sides.
  186. *
  187. CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, 1 )
  188. *
  189. * Solve L*X = B, overwriting B with X.
  190. *
  191. CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS,
  192. & ONE, A, LDA, B, LDB )
  193. *
  194. * Solve U*X = B, overwriting B with X.
  195. *
  196. CALL DTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
  197. & NRHS, ONE, A, LDA, B, LDB )
  198.  
  199. ELSE
  200. *
  201. * Solve A**T * X = B.
  202. *
  203. * Solve U**T *X = B, overwriting B with X.
  204. *
  205. CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS,
  206. & ONE, A, LDA, B, LDB )
  207. *
  208. * Solve L**T *X = B, overwriting B with X.
  209. *
  210. CALL DTRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS, ONE,
  211. & A, LDA, B, LDB )
  212. *
  213. * Apply row interchanges to the solution vectors.
  214. *
  215. CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, -1 )
  216. END IF
  217. *
  218. RETURN
  219. *
  220. * End of DGETRS
  221. *
  222. END
  223.  
  224.  
  225.  
  226.  

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