The R Project SVN R

Rev

Rev 5457 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 5457 Rev 19762
Line -... Line 1...
- 
 
 1 
C  Modified 2002-05-20 for R to add a tolerance of positive definiteness.
- 
 
 2 
C
1 
c
 3 
c
2 
c     dpofa factors a double precision symmetric positive definite
 4 
c     dpofa factors a double precision symmetric positive definite
3 
c     matrix.
 5 
c     matrix.
4 
c
 6 
c
5 
c     dpofa is usually called by dpoco, but it can be called
 7 
c     dpofa is usually called by dpoco, but it can be called
Line 42... Line 44...
42 
      integer lda,n,info
 44 
      integer lda,n,info
43 
      double precision a(lda,*)
 45 
      double precision a(lda,*)
44 
c
 46 
c
45 
c     internal variables
 47 
c     internal variables
46 
c
 48 
c
47 
      double precision ddot,t
 49 
      double precision ddot,t,eps
48 
      double precision s
 50 
      double precision s
49 
      integer j,jm1,k
 51 
      integer j,jm1,k
- 
 
 52 
      data eps/1.d-14/
- 
 
 53 
 
50 
c     begin block with ...exits to 40
 54 
c     begin block with ...exits to 40
51 
c
 55 
c
52 
c
 56 
c
53 
         do 30 j = 1, n
 57 
         do 30 j = 1, n
54 
            info = j
 58 
            info = j
Line 62... Line 66...
62 
               s = s + t*t
 66 
               s = s + t*t
63 
   10       continue
 67 
   10       continue
64 
   20       continue
 68 
   20       continue
65 
            s = a(j,j) - s
 69 
            s = a(j,j) - s
66 
c     ......exit
 70 
c     ......exit
67 
            if (s .le. 0.0d0) go to 40
 71 
c            if (s .le. 0.0d0) go to 40
- 
 
 72 
            if (s .le. eps * abs(a(j,j))) go to 40
68 
            a(j,j) = dsqrt(s)
 73 
            a(j,j) = dsqrt(s)
69 
   30    continue
 74 
   30    continue
70 
         info = 0
 75 
         info = 0
71 
   40 continue
 76 
   40 continue
72 
      return
 77 
      return