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