The R Project SVN R

Rev

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

Rev 71593 Rev 76636
Line 82... Line 82...
82 
c     blas daxpy,ddot,dscal,dnrm2
 82 
c     blas daxpy,ddot,dscal,dnrm2
83 
c     fortran dabs,dmax1,min0,dsqrt
 83 
c     fortran dabs,dmax1,min0,dsqrt
84 
c
 84 
c
85 
      subroutine dqrdc2(x,ldx,n,p,tol,k,qraux,jpvt,work)
 85 
      subroutine dqrdc2(x,ldx,n,p,tol,k,qraux,jpvt,work)
86 
      integer ldx,n,p
 86 
      integer ldx,n,p
87 
      integer jpvt(*)
 87 
      integer jpvt(p)
88 
      double precision x(ldx,*),qraux(*),work(p,2),tol
 88 
      double precision x(ldx,p),qraux(p),work(p,2),tol
89 
c
 89 
c
90 
c     internal variables
 90 
c     internal variables
91 
c
 91 
c
92 
      integer i,j,l,lp1,lup,k
 92 
      integer i,j,l,lp1,lup,k
93 
      double precision dnrm2,tt,ttt
 93 
      double precision dnrm2,tt,ttt
94 
      double precision ddot,nrmxl,t
 94 
      double precision ddot,nrmxl,t
95 
c
 95 
c
96 
c
 96 
c
97 
c     compute the norms of the columns of x.
 97 
c     compute the norms of the columns of x.
98 
c
 98 
c
- 
 
 99 
      if (n .gt. 0) then
- 
 
 100 
c       avoid accessing element beyond the bound
99 
      do 70 j = 1, p
 101 
         do 70 j = 1, p
100 
         qraux(j) = dnrm2(n,x(1,j),1)
 102 
            qraux(j) = dnrm2(n,x(1,j),1)
101 
         work(j,1) = qraux(j)
 103 
            work(j,1) = qraux(j)
102 
         work(j,2) = qraux(j)
 104 
            work(j,2) = qraux(j)
103 
         if(work(j,2) .eq. 0.0d0) work(j,2) = 1.0d0
 105 
            if(work(j,2) .eq. 0.0d0) work(j,2) = 1.0d0
104 
   70 continue
 106 
  70     continue
- 
 
 107 
      endif
105 
c
 108 
c
106 
c     perform the householder reduction of x.
 109 
c     perform the householder reduction of x.
107 
c
 110 
c
108 
      lup = min0(n,p)
 111 
      lup = min0(n,p)
109 
      k = p + 1
 112 
      k = p + 1