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.

dtrti2f.f 4.2 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146
  1. SUBROUTINE DTRTI2F( UPLO, DIAG, N, A, LDA, INFO )
  2. *
  3. * -- LAPACK routine (version 3.1) --
  4. * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  5. * November 2006
  6. *
  7. * .. Scalar Arguments ..
  8. CHARACTER DIAG, UPLO
  9. INTEGER INFO, LDA, N
  10. * ..
  11. * .. Array Arguments ..
  12. DOUBLE PRECISION A( LDA, * )
  13. * ..
  14. *
  15. * Purpose
  16. * =======
  17. *
  18. * DTRTI2 computes the inverse of a real upper or lower triangular
  19. * matrix.
  20. *
  21. * This is the Level 2 BLAS version of the algorithm.
  22. *
  23. * Arguments
  24. * =========
  25. *
  26. * UPLO (input) CHARACTER*1
  27. * Specifies whether the matrix A is upper or lower triangular.
  28. * = 'U': Upper triangular
  29. * = 'L': Lower triangular
  30. *
  31. * DIAG (input) CHARACTER*1
  32. * Specifies whether or not the matrix A is unit triangular.
  33. * = 'N': Non-unit triangular
  34. * = 'U': Unit triangular
  35. *
  36. * N (input) INTEGER
  37. * The order of the matrix A. N >= 0.
  38. *
  39. * A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
  40. * On entry, the triangular matrix A. If UPLO = 'U', the
  41. * leading n by n upper triangular part of the array A contains
  42. * the upper triangular matrix, and the strictly lower
  43. * triangular part of A is not referenced. If UPLO = 'L', the
  44. * leading n by n lower triangular part of the array A contains
  45. * the lower triangular matrix, and the strictly upper
  46. * triangular part of A is not referenced. If DIAG = 'U', the
  47. * diagonal elements of A are also not referenced and are
  48. * assumed to be 1.
  49. *
  50. * On exit, the (triangular) inverse of the original matrix, in
  51. * the same storage format.
  52. *
  53. * LDA (input) INTEGER
  54. * The leading dimension of the array A. LDA >= max(1,N).
  55. *
  56. * INFO (output) INTEGER
  57. * = 0: successful exit
  58. * < 0: if INFO = -k, the k-th argument had an illegal value
  59. *
  60. * =====================================================================
  61. *
  62. * .. Parameters ..
  63. DOUBLE PRECISION ONE
  64. PARAMETER ( ONE = 1.0D+0 )
  65. * ..
  66. * .. Local Scalars ..
  67. LOGICAL NOUNIT, UPPER
  68. INTEGER J
  69. DOUBLE PRECISION AJJ
  70. * ..
  71. * .. External Functions ..
  72. LOGICAL LSAME
  73. EXTERNAL LSAME
  74. * ..
  75. * .. External Subroutines ..
  76. EXTERNAL DSCAL, DTRMV, XERBLA
  77. * ..
  78. * .. Intrinsic Functions ..
  79. INTRINSIC MAX
  80. * ..
  81. * .. Executable Statements ..
  82. *
  83. * Test the input parameters.
  84. *
  85. INFO = 0
  86. UPPER = LSAME( UPLO, 'U' )
  87. NOUNIT = LSAME( DIAG, 'N' )
  88. IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
  89. INFO = -1
  90. ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
  91. INFO = -2
  92. ELSE IF( N.LT.0 ) THEN
  93. INFO = -3
  94. ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  95. INFO = -5
  96. END IF
  97. IF( INFO.NE.0 ) THEN
  98. CALL XERBLA( 'DTRTI2', -INFO )
  99. RETURN
  100. END IF
  101. *
  102. IF( UPPER ) THEN
  103. *
  104. * Compute inverse of upper triangular matrix.
  105. *
  106. DO 10 J = 1, N
  107. IF( NOUNIT ) THEN
  108. A( J, J ) = ONE / A( J, J )
  109. AJJ = -A( J, J )
  110. ELSE
  111. AJJ = -ONE
  112. END IF
  113. *
  114. * Compute elements 1:j-1 of j-th column.
  115. *
  116. CALL DTRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA,
  117. $ A( 1, J ), 1 )
  118. CALL DSCAL( J-1, AJJ, A( 1, J ), 1 )
  119. 10 CONTINUE
  120. ELSE
  121. *
  122. * Compute inverse of lower triangular matrix.
  123. *
  124. DO 20 J = N, 1, -1
  125. IF( NOUNIT ) THEN
  126. A( J, J ) = ONE / A( J, J )
  127. AJJ = -A( J, J )
  128. ELSE
  129. AJJ = -ONE
  130. END IF
  131. IF( J.LT.N ) THEN
  132. *
  133. * Compute elements j+1:n of j-th column.
  134. *
  135. CALL DTRMV( 'Lower', 'No transpose', DIAG, N-J,
  136. $ A( J+1, J+1 ), LDA, A( J+1, J ), 1 )
  137. CALL DSCAL( N-J, AJJ, A( J+1, J ), 1 )
  138. END IF
  139. 20 CONTINUE
  140. END IF
  141. *
  142. RETURN
  143. *
  144. * End of DTRTI2
  145. *
  146. END