dpbsl.f 2.9 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697
  1. *DECK DPBSL
  2. SUBROUTINE DPBSL (ABD, LDA, N, M, B)
  3. C***BEGIN PROLOGUE DPBSL
  4. C***PURPOSE Solve a real symmetric positive definite band system
  5. C using the factors computed by DPBCO or DPBFA.
  6. C***LIBRARY SLATEC (LINPACK)
  7. C***CATEGORY D2B2
  8. C***TYPE DOUBLE PRECISION (SPBSL-S, DPBSL-D, CPBSL-C)
  9. C***KEYWORDS BANDED, LINEAR ALGEBRA, LINPACK, MATRIX,
  10. C POSITIVE DEFINITE, SOLVE
  11. C***AUTHOR Moler, C. B., (U. of New Mexico)
  12. C***DESCRIPTION
  13. C
  14. C DPBSL solves the double precision symmetric positive definite
  15. C band system A*X = B
  16. C using the factors computed by DPBCO or DPBFA.
  17. C
  18. C On Entry
  19. C
  20. C ABD DOUBLE PRECISION(LDA, N)
  21. C the output from DPBCO or DPBFA.
  22. C
  23. C LDA INTEGER
  24. C the leading dimension of the array ABD .
  25. C
  26. C N INTEGER
  27. C the order of the matrix A .
  28. C
  29. C M INTEGER
  30. C the number of diagonals above the main diagonal.
  31. C
  32. C B DOUBLE PRECISION(N)
  33. C the right hand side vector.
  34. C
  35. C On Return
  36. C
  37. C B the solution vector X .
  38. C
  39. C Error Condition
  40. C
  41. C A division by zero will occur if the input factor contains
  42. C a zero on the diagonal. Technically this indicates
  43. C singularity, but it is usually caused by improper subroutine
  44. C arguments. It will not occur if the subroutines are called
  45. C correctly, and INFO .EQ. 0 .
  46. C
  47. C To compute INVERSE(A) * C where C is a matrix
  48. C with P columns
  49. C CALL DPBCO(ABD,LDA,N,RCOND,Z,INFO)
  50. C IF (RCOND is too small .OR. INFO .NE. 0) GO TO ...
  51. C DO 10 J = 1, P
  52. C CALL DPBSL(ABD,LDA,N,C(1,J))
  53. C 10 CONTINUE
  54. C
  55. C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
  56. C Stewart, LINPACK Users' Guide, SIAM, 1979.
  57. C***ROUTINES CALLED DAXPY, DDOT
  58. C***REVISION HISTORY (YYMMDD)
  59. C 780814 DATE WRITTEN
  60. C 890531 Changed all specific intrinsics to generic. (WRB)
  61. C 890831 Modified array declarations. (WRB)
  62. C 890831 REVISION DATE from Version 3.2
  63. C 891214 Prologue converted to Version 4.0 format. (BAB)
  64. C 900326 Removed duplicate information from DESCRIPTION section.
  65. C (WRB)
  66. C 920501 Reformatted the REFERENCES section. (WRB)
  67. C***END PROLOGUE DPBSL
  68. INTEGER LDA,N,M
  69. DOUBLE PRECISION ABD(LDA,*),B(*)
  70. C
  71. DOUBLE PRECISION DDOT,T
  72. INTEGER K,KB,LA,LB,LM
  73. C
  74. C SOLVE TRANS(R)*Y = B
  75. C
  76. C***FIRST EXECUTABLE STATEMENT DPBSL
  77. DO 10 K = 1, N
  78. LM = MIN(K-1,M)
  79. LA = M + 1 - LM
  80. LB = K - LM
  81. T = DDOT(LM,ABD(LA,K),1,B(LB),1)
  82. B(K) = (B(K) - T)/ABD(M+1,K)
  83. 10 CONTINUE
  84. C
  85. C SOLVE R*X = Y
  86. C
  87. DO 20 KB = 1, N
  88. K = N + 1 - KB
  89. LM = MIN(K-1,M)
  90. LA = M + 1 - LM
  91. LB = K - LM
  92. B(K) = B(K)/ABD(M+1,K)
  93. T = -B(K)
  94. CALL DAXPY(LM,T,ABD(LA,K),1,B(LB),1)
  95. 20 CONTINUE
  96. RETURN
  97. END