Mercurial > octave-nkf
changeset 7563:438eb170e604
fixes in libcruft/qrupdate
| author | Jaroslav Hajek <highegg@gmail.com> |
|---|---|
| date | Thu, 06 Mar 2008 02:29:47 -0500 |
| parents | c827f5673321 |
| children | 90536e155fde |
| files | libcruft/ChangeLog libcruft/qrupdate/dqrinc.f libcruft/qrupdate/zqrinc.f |
| diffstat | 3 files changed, 10 insertions(+), 3 deletions(-) [+] |
line wrap: on
line diff
--- a/libcruft/ChangeLog Thu Mar 06 02:27:55 2008 -0500 +++ b/libcruft/ChangeLog Thu Mar 06 02:29:47 2008 -0500 @@ -1,3 +1,9 @@ +2008-03-06 Jaroslav Hajek <highegg@gmail.com> + + * qrupdate/dqrinc.f: Declare DGEMV external. + * qrupdate/zqrinc.f: Declare ZGEMV external. + Fix complex constant args in call to ZGEMV. + 2008-03-05 Jaroslav Hajek <highegg@gmail.com> * qrupdate/dch1dn.f, qrupdate/zch1dn.f: add "quick return" checks.
--- a/libcruft/qrupdate/dqrinc.f Thu Mar 06 02:27:55 2008 -0500 +++ b/libcruft/qrupdate/dqrinc.f Thu Mar 06 02:29:47 2008 -0500 @@ -40,7 +40,7 @@ integer m,n,k,j double precision Q(m,k),R(k,n),R1(k,n+1),x(m) double precision w - external xerbla,dcopy,dqrqhv + external xerbla,dcopy,dqrqhv,dgemv integer info,i,jj c quick return if possible if (m <= 0) return
--- a/libcruft/qrupdate/zqrinc.f Thu Mar 06 02:27:55 2008 -0500 +++ b/libcruft/qrupdate/zqrinc.f Thu Mar 06 02:29:47 2008 -0500 @@ -40,7 +40,7 @@ integer m,n,k,j double complex Q(m,k),R(k,n),R1(k,n+1),x(m) double complex w - external xerbla,zcopy,zqrqhv + external xerbla,zcopy,zqrqhv,zgemv integer info,i,jj c quick return if possible if (m <= 0) return @@ -59,7 +59,8 @@ if (j <= n) then call zcopy(k*(n+1-j),R(1,j),1,R1(1,j+1),1) end if - call zgemv('C',m,min(k,j-1),1d0,Q,m,x,1,0d0,R1(1,j),1) + call zgemv('C',m,min(k,j-1),dcmplx(1d0),Q,m,x,1, + + dcmplx(0d0),R1(1,j),1) if (j < k) then c eliminate tail, updating Q(:,j:k) and R1(j:k,j+1:n+1) jj = min(j,n)+1