home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / fortran / linpklib.arc / SPOSL.FOR < prev    next >
Text File  |  1984-01-06  |  2KB  |  72 lines
  1.       SUBROUTINE SPOSL(A,LDA,N,B)
  2.       INTEGER LDA,N
  3.       REAL A(LDA,1),B(1)
  4. C
  5. C     SPOSL SOLVES THE REAL SYMMETRIC POSITIVE DEFINITE
  6. C     SYSTEM A * X = B
  7. C     USING THE FACTORS COMPUTED BY SPOCO OR SPOFA.
  8. C
  9. C     ON ENTRY
  10. C
  11. C        A       REAL(LDA, N)
  12. C                THE OUTPUT FROM SPOCO OR SPOFA.
  13. C
  14. C        LDA     INTEGER
  15. C                THE LEADING DIMENSION OF THE ARRAY  A .
  16. C
  17. C        N       INTEGER
  18. C                THE ORDER OF THE MATRIX  A .
  19. C
  20. C        B       REAL(N)
  21. C                THE RIGHT HAND SIDE VECTOR.
  22. C
  23. C     ON RETURN
  24. C
  25. C        B       THE SOLUTION VECTOR  X .
  26. C
  27. C     ERROR CONDITION
  28. C
  29. C        A DIVISION BY ZERO WILL OCCUR IF THE INPUT FACTOR CONTAINS
  30. C        A ZERO ON THE DIAGONAL.  TECHNICALLY THIS INDICATES
  31. C        SINGULARITY BUT IT IS USUALLY CAUSED BY IMPROPER SUBROUTINE
  32. C        ARGUMENTS.  IT WILL NOT OCCUR IF THE SUBROUTINES ARE CALLED
  33. C        CORRECTLY AND  INFO .EQ. 0 .
  34. C
  35. C     TO COMPUTE  INVERSE(A) * C  WHERE  C  IS A MATRIX
  36. C     WITH  P  COLUMNS
  37. C           CALL SPOCO(A,LDA,N,RCOND,Z,INFO)
  38. C           IF (RCOND IS TOO SMALL .OR. INFO .NE. 0) GO TO ...
  39. C           DO 10 J = 1, P
  40. C              CALL SPOSL(A,LDA,N,C(1,J))
  41. C        10 CONTINUE
  42. C
  43. C     LINPACK.  THIS VERSION DATED 08/14/78 .
  44. C     CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB.
  45. C
  46. C     SUBROUTINES AND FUNCTIONS
  47. C
  48. C     BLAS SAXPY,SDOT
  49. C
  50. C     INTERNAL VARIABLES
  51. C
  52.       REAL SDOT,T
  53.       INTEGER K,KB
  54. C
  55. C     SOLVE TRANS(R)*Y = B
  56. C
  57.       DO 10 K = 1, N
  58.          T = SDOT(K-1,A(1,K),1,B(1),1)
  59.          B(K) = (B(K) - T)/A(K,K)
  60.    10 CONTINUE
  61. C
  62. C     SOLVE R*X = Y
  63. C
  64.       DO 20 KB = 1, N
  65.          K = N + 1 - KB
  66.          B(K) = B(K)/A(K,K)
  67.          T = -B(K)
  68.          CALL SAXPY(K-1,T,A(1,K),1,B(1),1)
  69.    20 CONTINUE
  70.       RETURN
  71.       END
  72.