走进LAPACK(三)续

五、BLAS和LAPACK的常用函数

  7、特征值和特征向量(Eigenvalues and eigenvectors,A*v(j)= λ(j)*v(j)u(j)H*A = λ(j)*u(j)H

    lapack函数(dgeev, zgeev for eigenvalues and eigenvectors; dgegv, zgegv for generalized eigenvalues and eigenvectors)

   函数原型:  call dgeev(jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, work, lwork, info)

   输出:wr wi vl vr (具体看程序说明)

program main

implicit none
real(8)
:: aaa(2,2),work(60),wr(2),wi(2),vl(2,2),vr(2,2)
integer :: lda,n,ldvl,ldvr,lwork,info
character :: jobvl,jobvr

aaa=reshape((/1,3,2,4/),(/2,2/))
jobvl='N'
jobvr='V'
n=2
lda=2
ldvl=1
ldvr=2
lwork=60
wr=0.;wi=0.

call dgeev(jobvl, jobvr, n, aaa, lda, wr, wi, vl, ldvl, vr, ldvr, work, lwork, info)

print *,wr,wi
print *,vl,vr

end program

输出结果

image

8、海森伯简化(Hessenberg reduction,A = Q*H*QH

lapack函数(dgehrd, zgehrd; dorghr, zunghr for computing Q

函数原型:call dgehrd(n, ilo, ihi, a, lda, tau, work, lwork, info)

              call dorghr(n, ilo, ihi, a, lda, tau, work, lwork, info)

program main

implicit none
real(8)
:: aaa(3,3),hhh(3,3),qqq(3,3),tau(2),work(3)
integer :: n,ilo,ihi,lda,info,lwork,i,j

aaa=reshape((/1,4,7,2,5,8,3,6,9/),(/3,3/))
n=3
ilo=1
ihi=3
lda=3
lwork=3
hhh=0.;qqq=0.
call dgehrd(n, ilo, ihi, aaa, lda, tau, work, lwork, info)
forall(i=1:3,j=1:3,i<=j+1)
hhh(i,j)=aaa(i,j)
end forall
print
*,'hhh='
print *,hhh

print *,'---------------------------'
call dorghr(n, ilo, ihi, aaa, lda, tau, work, lwork, info)
qqq=aaa
print *,'qqq='
print *,qqq

end program

输出结果

image

9、逆矩阵(Matrix inverse,R=inv(X))

lapack函数(dgesv, zgesv

原型同矩阵左除

program main

implicit none
real(8)
:: aaa(2,2),bbb(2,2),rrr(2,2)
integer :: n,nrhs,lda,ldb,ipiv(2),info

aaa=reshape((/1.d0,3.d0,2.d0,4.d0/),(/2,2/))
!bbb为单位矩阵
bbb=reshape((/1.d0,0.d0,0.d0,1.d0/),(/2,2/))

n=2
nrhs=2
lda=2
ldb=2

call dgesv( n, nrhs, aaa, lda, ipiv, bbb, ldb, info )

rrr=bbb
print *,bbb

end program

输出结果

image

10、LU分解(LU factorization,P*X=L*U)

lapack函数(dgetrf, zgetrf

同行列式

program main

implicit none
real(8)
:: aaa(3,3),ppp(3,3),lll(3,3),uuu(3,3),temp
integer :: m,n,lda,ipiv(3),info,i,j

aaa=reshape((/1,4,7,2,5,8,3,6,8/),(/3,3/))
ppp=0.;lll=0.;uuu=0.
m=3
n=3
lda=3

call dgetrf( m, n, aaa, lda, ipiv, info )

do i=1,3
do j=1,3
if(i>j) then
lll(i,j)=aaa(i,j)
elseif(i==j) then
lll(i,j)=1.
uuu(i,j)=aaa(i,j)
else
uuu(i,j)=aaa(i,j)
endif
enddo
enddo

forall
(i=1:3,j=1:3,i==j)
ppp(i,j)=1.
end forall

do
i=1,3
do j=1,3
temp=ppp(i,j)
ppp(i,j)=ppp(ipiv(i),j)
ppp(ipiv(i),j)=temp
enddo
enddo

print
*,'P='
print *,ppp
print *,'L='
print *,lll
print *,'U='
print *,uuu
end program

输出结果

image

posted on 2010-09-26 22:54  PcX  阅读(4590)  评论(1编辑  收藏  举报

导航