Mercurial > hg > octave-nkf
diff scripts/linear-algebra/krylov.m @ 3457:e031284eea27
[project @ 2000-01-19 08:49:56 by jwe]
author | jwe |
---|---|
date | Wed, 19 Jan 2000 08:50:14 +0000 |
parents | 3234a698073a |
children | 3e3e14ad5149 |
line wrap: on
line diff
--- a/scripts/linear-algebra/krylov.m +++ b/scripts/linear-algebra/krylov.m @@ -46,38 +46,49 @@ function [Uret,H,nu] = krylov(A,V,k,eps1,pflg); defeps = 1e-12; - if(nargin < 3 | nargin > 5) - usage("[U,nu] = krylov(A,V,k{,eps1,pflg})") - elseif(nargin < 5) + + if (nargin < 3 || nargin > 5) + usage ("[U, nu] = krylov (A, V, k, eps1, pflg)") + elseif (nargin < 5) pflg = 0; # default permutation flag endif + if(nargin < 4) eps1 = defeps; # default tolerance parameter endif - if(isempty(eps1)) eps1 = defeps; endif - - na = is_square(A); - if( !na ) error("A(%d x %d) must be square",rows(A),columns(A)); endif - [m,kb] = size(V); - if(m != na); - error("A(%d x %d), V(%d x %d): argument dimensions do not match", ... - na,na,m,kb) + if (isempty (eps1)) + eps1 = defeps; + endif + + na = is_square (A); + if (! na) + error ("A(%d x %d) must be square", rows (A), columns (A)); endif - if( !is_scalar(k) ) - error("krylov: third argument must be a scalar integer") + [m, kb] = size(V); + if (m != na) + error("A(%d x %d), V(%d x %d): argument dimensions do not match", + na, na, m, kb) endif - Vnrm = norm(V,Inf); + if (! is_scalar (k)) + error ("krylov: third argument must be a scalar integer"); + endif + + Vnrm = norm (V, Inf); - # check for trivial solution - if(Vnrm == 0) - Uret = []; nu = 0; return; + ## check for trivial solution + if (Vnrm == 0) + Uret = []; + nu = 0; + return; endif # identify trivial null space - abm = max(abs([A,V]')); nzidx = find(abm != 0); zidx = find(abm == 0); + abm = max (abs ([A, V]')); + nzidx = find (abm != 0); + zidx = find (abm == 0); # set up vector of pivot points pivot_vec = 1:na; @@ -85,85 +96,86 @@ iter = 0; alpha = []; nh = 0; - while (length(alpha) < na) & (columns(V) > 0) & (iter < k) + while (length(alpha) < na) && (columns(V) > 0) && (iter < k) iter++; - # get orthogonal basis of V + ## get orthogonal basis of V jj = 1; - while(jj <= columns(V) & length(alpha) < na) - nu = length(alpha)+1; # index of next Householder reflection + while (jj <= columns (V) && length (alpha) < na) + ## index of next Householder reflection + nu = length(alpha)+1; short_pv = pivot_vec(nu:na); q = V(:,jj); short_q = q(short_pv); - if(norm(short_q) < eps1) - # insignificant column; delete - nv = columns(V); - if(jj != nv) - [V(:,jj),V(:,nv)] = swap(V(:,jj),V(:,nv)); - # FIX ME: H columns should be swapped too. Not done since - # Block Hessenberg structure is lost anyway. + if (norm (short_q) < eps1) + ## insignificant column; delete + nv = columns (V); + if (jj != nv) + [V(:,jj), V(:,nv)] = swap (V(:,jj), V(:,nv)); + ## XXX FIXME XXX -- H columns should be swapped too. Not done + ## since Block Hessenberg structure is lost anyway. endif V = V(:,1:(nv-1)); - nu = nu - 1; # one less reflection - + ## one less reflection + nu--; else - # new householder reflection - if(pflg) - # locate max magnitude element in short_q - asq = abs(short_q); - maxv = max(asq); - maxidx = find(asq == maxv); + ## new householder reflection + if (pflg) + ## locate max magnitude element in short_q + asq = abs (short_q); + maxv = max (asq); + maxidx = find (asq == maxv); pivot_idx = short_pv(maxidx(1)); - # see if need to change the pivot list - if(pivot_idx != pivot_vec(nu)) + ## see if need to change the pivot list + if (pivot_idx != pivot_vec(nu)) swapidx = maxidx(1) + (nu-1); - [pivot_vec(nu),pivot_vec(swapidx)] = ... - swap(pivot_vec(nu),pivot_vec(swapidx)); + [pivot_vec(nu), pivot_vec(swapidx)] = ... + swap (pivot_vec(nu), pivot_vec(swapidx)); endif endif - # isolate portion of vector for reflection + ## isolate portion of vector for reflection idx = pivot_vec(nu:na); jdx = pivot_vec(1:nu); - [hv,av,z] = housh(q(idx),1,0); + [hv, av, z] = housh (q(idx), 1, 0); alpha(nu) = av; U(idx,nu) = hv; # reduce V per the reflection V(idx,:) = V(idx,:) - av*hv*(hv' * V(idx,:)); if(iter > 1) - # FIX ME: not done correctly for block case + ## XXX FIXME XXX -- not done correctly for block case H(nu,nu-1) = V(pivot_vec(nu),jj); endif - # advance to next column of V - jj=jj+1; + ## advance to next column of V + jj++; endif endwhile - # check for oversize V (due to full rank) - if( ( columns(V) > na ) & ( length(alpha) == na ) ) - # trim to size + ## check for oversize V (due to full rank) + if ((columns (V) > na) && (length (alpha) == na)) + ## trim to size V = V(:,1:na); - elseif( columns(V) > na ) + elseif (columns(V) > na) krylov_V = V krylov_na = na - krylov_length_alpha = length(alpha) - error("This case should never happen; submit bug report."); + krylov_length_alpha = length (alpha) + error ("This case should never happen; submit a bug report"); endif - if(columns(V) > 0) - # construct next Q and multiply - Q = zeros(size(V)); - for kk=1:columns(Q) + if (columns (V) > 0) + ## construct next Q and multiply + Q = zeros (size (V)); + for kk = 1:columns (Q) Q(pivot_vec(nu-columns(Q)+kk),kk) = 1; endfor - # apply Householder reflections + ## apply Householder reflections for ii = nu:-1:1 idx = pivot_vec(ii:na); hv = U(idx,ii); @@ -172,34 +184,36 @@ endfor endif - # multiply to get new vector; + ## multiply to get new vector; V = A*Q; - # project off of previous vectors - nu = length(alpha); - for i=1:nu - hv = U(:,i); av = alpha(i); + ## project off of previous vectors + nu = length (alpha); + for i = 1:nu + hv = U(:,i); + av = alpha(i); V = V - av*hv*(hv'*V); H(i,nu-columns(V)+(1:columns(V))) = V(pivot_vec(i),:); end endwhile - # Back out complete U matrix - # back out U matrix ; - j1 = columns(U); - for i=j1:-1:1; + ## Back out complete U matrix + ## back out U matrix ; + j1 = columns (U); + for i = j1:-1:1; idx = pivot_vec(i:na); hv = U(idx,i); av = alpha(i); - U(:,i) = zeros(na,1); + U(:,i) = zeros (na, 1); U(idx(1),i) = 1; U(idx,i:j1) = U(idx,i:j1)-av*hv*(hv'*U(idx,i:j1)); endfor - nu = length(alpha); + nu = length (alpha); Uret = U; - if( max(max( abs(Uret(zidx,:)) )) > 0) - warning("krylov: trivial null space corrupted; set pflg=1 or eps1>%e",eps1); + if (max (max (abs (Uret(zidx,:)))) > 0) + warning ("krylov: trivial null space corrupted; set pflg = 1 or eps1 > %e", + eps1); endif endfunction