The R Project SVN R

Rev

Rev 86632 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 86632 Rev 86641
Line 102... Line 102...
102 
         do j = 1, p
 102 
         do j = 1, p
103 
            qraux(j) = dnrm2(n,x(1,j),1)
 103 
            qraux(j) = dnrm2(n,x(1,j),1)
104 
            work(j,1) = qraux(j)
 104 
            work(j,1) = qraux(j)
105 
            work(j,2) = qraux(j)
 105 
            work(j,2) = qraux(j)
106 
            if(work(j,2) .eq. 0.0d0) work(j,2) = 1.0d0
 106 
            if(work(j,2) .eq. 0.0d0) work(j,2) = 1.0d0
107 
         end do
 107 
         end do                 ! j
108 
      end if
 108 
      end if
109 
c
 109 
c
110 
c     perform the householder reduction of x.
 110 
c     perform the householder reduction of x.
111 
c
 111 
c
112 
      lup = min(n,p)
 112 
      lup = min(n,p)
Line 125... Line 125...
125 
            if (l .ge. k .or. qraux(l) .ge. work(l,2)*tol) exit
 125 
            if (l .ge. k .or. qraux(l) .ge. work(l,2)*tol) exit
126 
            do i=1,n
 126 
            do i=1,n
127 
               t = x(i,l)
 127 
               t = x(i,l)
128 
               do j=l+1,p
 128 
               do j=l+1,p
129 
                  x(i,j-1) = x(i,j)
 129 
                  x(i,j-1) = x(i,j)
130 
               end do
 130 
               end do           ! j
131 
               x(i,p) = t
 131 
               x(i,p) = t
132 
            end do
 132 
            end do              ! i
133 
            i = jpvt(l)
 133 
            i = jpvt(l)
134 
            t = qraux(l)
 134 
            t = qraux(l)
135 
            tt = work(l,1)
 135 
            tt = work(l,1)
136 
            ttt = work(l,2)
 136 
            ttt = work(l,2)
137 
            do j=l+1,p
 137 
            do j=l+1,p
138 
               jpvt(j-1) = jpvt(j)
 138 
               jpvt(j-1) = jpvt(j)
139 
               qraux(j-1) = qraux(j)
 139 
               qraux(j-1) = qraux(j)
140 
               work(j-1,1) = work(j,1)
 140 
               work(j-1,1) = work(j,1)
141 
               work(j-1,2) = work(j,2)
 141 
               work(j-1,2) = work(j,2)
142 
            end do
 142 
            end do              ! j
143 
            jpvt(p) = i
 143 
            jpvt(p) = i
144 
            qraux(p) = t
 144 
            qraux(p) = t
145 
            work(p,1) = tt
 145 
            work(p,1) = tt
146 
            work(p,2) = ttt
 146 
            work(p,2) = ttt
147 
            k = k - 1
 147 
            k = k - 1
148 
         end do
 148 
         end do                 ! (no index)
149 
         if (l .ne. n) then
 149 
         if (l .ne. n) then
150 
c
 150 
c
151 
c           compute the householder transformation for column l.
 151 
c           compute the householder transformation for column l.
152 
c
 152 
c
153 
            nrmxl = dnrm2(n-l+1,x(l,l),1)
 153 
            nrmxl = dnrm2(n-l+1,x(l,l),1)
Line 176... Line 176...
176 
                        else
 176 
                        else
177 
                           qraux(j) = dnrm2(n-l,x(l+1,j),1)
 177 
                           qraux(j) = dnrm2(n-l,x(l+1,j),1)
178 
                           work(j,1) = qraux(j)
 178 
                           work(j,1) = qraux(j)
179 
                        end if
 179 
                        end if
180 
                     end if
 180 
                     end if
181 
                  end do
 181 
                  end do        ! j
182 
               end if
 182 
               end if
183 
c
 183 
c
184 
c              Save the transformation.
 184 
c              Save the transformation.
185 
c
 185 
c
186 
               qraux(l) = x(l,l)
 186 
               qraux(l) = x(l,l)
187 
               x(l,l) = -nrmxl
 187 
               x(l,l) = -nrmxl
188 
            end if
 188 
            end if
189 
         end if
 189 
         end if
190 
      end do
 190 
      end do                    ! l
191 
      k = min(k - 1, n)
 191 
      k = min(k - 1, n)
192 
      return
 192 
      return
193 
      end
 193 
      end