home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / fortran / linpklib.arc / SPBFA.FOR < prev    next >
Text File  |  1984-01-06  |  3KB  |  95 lines
  1.       SUBROUTINE SPBFA(ABD,LDA,N,M,INFO)
  2.       INTEGER LDA,N,M,INFO
  3.       REAL ABD(LDA,1)
  4. C
  5. C     SPBFA FACTORS A DOUBLE PRECISION SYMMETRIC POSITIVE DEFINITE
  6. C     MATRIX STORED IN BAND FORM.
  7. C
  8. C     SPBFA IS USUALLY CALLED BY SPBCO, BUT IT CAN BE CALLED
  9. C     DIRECTLY WITH A SAVING IN TIME IF  RCOND  IS NOT NEEDED.
  10. C
  11. C     ON ENTRY
  12. C
  13. C        ABD     REAL(LDA, N)
  14. C                THE MATRIX TO BE FACTORED.  THE COLUMNS OF THE UPPER
  15. C                TRIANGLE ARE STORED IN THE COLUMNS OF ABD AND THE
  16. C                DIAGONALS OF THE UPPER TRIANGLE ARE STORED IN THE
  17. C                ROWS OF ABD .  SEE THE COMMENTS BELOW FOR DETAILS.
  18. C
  19. C        LDA     INTEGER
  20. C                THE LEADING DIMENSION OF THE ARRAY  ABD .
  21. C                LDA MUST BE .GE. M + 1 .
  22. C
  23. C        N       INTEGER
  24. C                THE ORDER OF THE MATRIX  A .
  25. C
  26. C        M       INTEGER
  27. C                THE NUMBER OF DIAGONALS ABOVE THE MAIN DIAGONAL.
  28. C                0 .LE. M .LT. N .
  29. C
  30. C     ON RETURN
  31. C
  32. C        ABD     AN UPPER TRIANGULAR MATRIX  R , STORED IN BAND
  33. C                FORM, SO THAT  A = TRANS(R)*R .
  34. C
  35. C        INFO    INTEGER
  36. C                = 0  FOR NORMAL RETURN.
  37. C                = K  IF THE LEADING MINOR OF ORDER  K  IS NOT
  38. C                     POSITIVE DEFINITE.
  39. C
  40. C     BAND STORAGE
  41. C
  42. C           IF  A  IS A SYMMETRIC POSITIVE DEFINITE BAND MATRIX,
  43. C           THE FOLLOWING PROGRAM SEGMENT WILL SET UP THE INPUT.
  44. C
  45. C                   M = (BAND WIDTH ABOVE DIAGONAL)
  46. C                   DO 20 J = 1, N
  47. C                      I1 = MAX0(1, J-M)
  48. C                      DO 10 I = I1, J
  49. C                         K = I-J+M+1
  50. C                         ABD(K,J) = A(I,J)
  51. C                10    CONTINUE
  52. C                20 CONTINUE
  53. C
  54. C     LINPACK.  THIS VERSION DATED 08/14/78 .
  55. C     CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB.
  56. C
  57. C     SUBROUTINES AND FUNCTIONS
  58. C
  59. C     BLAS SDOT
  60. C     FORTRAN MAX0,SQRT
  61. C
  62. C     INTERNAL VARIABLES
  63. C
  64.       REAL SDOT,T
  65.       REAL S
  66.       INTEGER IK,J,JK,K,MU
  67. C     BEGIN BLOCK WITH ...EXITS TO 40
  68. C
  69. C
  70.          DO 30 J = 1, N
  71.             INFO = J
  72.             S = 0.0E0
  73.             IK = M + 1
  74.             JK = MAX0(J-M,1)
  75.             MU = MAX0(M+2-J,1)
  76.             IF (M .LT. MU) GO TO 20
  77.             DO 10 K = MU, M
  78.                T = ABD(K,J) - SDOT(K-MU,ABD(IK,JK),1,ABD(MU,J),1)
  79.                T = T/ABD(M+1,JK)
  80.                ABD(K,J) = T
  81.                S = S + T*T
  82.                IK = IK - 1
  83.                JK = JK + 1
  84.    10       CONTINUE
  85.    20       CONTINUE
  86.             S = ABD(M+1,J) - S
  87. C     ......EXIT
  88.             IF (S .LE. 0.0E0) GO TO 40
  89.             ABD(M+1,J) = SQRT(S)
  90.    30    CONTINUE
  91.          INFO = 0
  92.    40 CONTINUE
  93.       RETURN
  94.       END
  95.