1c Copyright (C) 2008, 2009 VZLU Prague, a.s., Czech Republic 2c 3c Author: Jaroslav Hajek <highegg@gmail.com> 4c 5c This file is part of qrupdate. 6c 7c qrupdate is free software; you can redistribute it and/or modify 8c it under the terms of the GNU General Public License as published by 9c the Free Software Foundation; either version 3 of the License, or 10c (at your option) any later version. 11c 12c This program is distributed in the hope that it will be useful, 13c but WITHOUT ANY WARRANTY; without even the implied warranty of 14c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15c GNU General Public License for more details. 16c 17c You should have received a copy of the GNU General Public License 18c along with this software; see the file COPYING. If not, see 19c <http://www.gnu.org/licenses/>. 20c 21 subroutine dqrtv1(n,u,w) 22c purpose: generates a sequence of n-1 Givens rotations that 23c eliminate all but the first element of a vector u. 24c arguments: 25c n (in) the length of the vector u 26c u (io) on entry, the vector u. 27c on exit, u(2:n) contains the rotation sines, u(1) 28c contains the remaining element. 29c w (o) on exit, w contains the rotation cosines. 30c 31 integer n 32 double precision u(*),w(*) 33 external dlartg 34 double precision rr,t 35 integer i 36c quick return if possible. 37 if (n <= 0) return 38 rr = u(n) 39 do i = n-1,1,-1 40 call dlartg(u(i),rr,w(i),u(i+1),t) 41 rr = t 42 end do 43 u(1) = rr 44 end subroutine 45