24小时热门版块排行榜

返回列表

petersonic

铁虫 (初入文坛)

应助: 0 (幼儿园)
金币: 104
帖子: 9
在线: 4.5小时
虫号: 3266032
注册: 2014-06-10
专业: 工程热物理与能源利用

[求助] Fortan 反幂法求解矩阵按模最小特征值问题

本人用fortran反幂法求解最小特征值，其中求解线性方程组的部分由于是带状阵，因此采用了压缩空间的存储方式C（m,n）
但是子程序单独调试都能通过，放在一起就有问题了，哪位大神帮忙看看

program homework

implicit none
!定义
Integer , parameter :: p = SELECTED_REAL_KIND(8)
real(p) :: a(501),db=0.16,dc=-0.064,mc(5,501)
real(p) :: Rs
integer :: i,n=501,m=5

!a初始化
do i=1,n
a(i)=(1.64-0.024*i)*sin(0.2*i)-0.64*exp(0.1/i)
end do
!给C赋初值5*501
mc(1,

=dc
mc(2,

=db
do i=1,n
mc(3,i)=a(i)
end do
mc(4,

=db
mc(5,

=dc
mc(1,1)=0.0
mc(1,2)=0.0
mc(2,1)=0.0
mc(5,n)=0.0
mc(4,n)=0.0
mc(5,n-1)=0.0

!求Rs(即按模最小的特征值)，反幂法
call InPowoe(mc,m,n,Rs)
write(*,*)
write(*,*) "Rs===============",Rs
end program homework

!*****************************************************
!子程序反幂法求特征值(Inverse power of eigenvalue)    *
!*****************************************************
subroutine InPowoe(c,m,n,r)
implicit none
Integer , parameter :: p = SELECTED_REAL_KIND(8)
integer :: m,n
real(p) :: r,c(m,n)
real(p) :: u(n),y(n),t,max,flag
real(p) :: sum
integer :: i
sum=0.0
max=1.0
flag=1.0
u(1)=1.0
do i=2,n
u(i)=1.0
end do

!计算
do while(flag>=0.00001)
  do i=1,n
sum=sum+u(i)*u(i)
  end do
t=sqrt(sum)
sum=0.0

  do i=1,n
y(i)=u(i)/t
  end do

  !A*u=y,求解带状线性方程组
call LU(c,u,y,m,n)
  !特征值
  do i=1,n
sum=sum+y(i)*u(i)
  end do
r=sum
sum=0.0
  !结束判断
  flag=abs(r-max)/abs(r)
  max=r
end do
r=1.0/r
end subroutine InPowoe

subroutine LU(a,x,b,m,n)
implicit none
Integer , parameter :: p = SELECTED_REAL_KIND(8)
integer :: i,j,k,r,s,t,m,n
real(p) :: a(m,n),x(n),b(n),c(m,n)
real(p) :: sum
sum=0.0
r=2
s=2

do i=1,m
  c(i,

=a(i,

end do
!分解
do k=1,n
  do j=k,min(k+s,n)
do t=max(1,k-r,j-s),k-1
   sum=sum+c(k-t+s+1,t)*c(t-j+s+1,j)
end do
c(k-j+s+1,j)=c(k-j+s+1,j)-sum
sum=0.0
  end do

  if(k<n) then
  do i=k+1,min(k+r,n)
do t=max(1,i-r,k-s),k-1
   sum=sum+c(i-t+s+1,t)*c(t-k+s+1,k)
end do
c(i-k+s+1,k)=(c(i-k+s+1,k)-sum)/c(s+1,k)
sum=0.0
  end do
  end if
end do

!求解
do i=2,n
  do t=max(1,i-r),i-1
   sum=sum+c(i-t+s+1,t)*b(t)
  end do
  b(i)=b(i)-sum
  sum=0.0
end do
x(n)=b(n)/c(s+1,n)
do i=n-1,1,-1
do t=i+1,min(i+s,n)
   sum=sum+c(i-t+s+1,t)*x(t)
end do
x(i)=(b(i)-sum)/c(s+1,i)
sum=0.0
end do
end subroutine LU

回复此楼

» 猜你喜欢

基金申报已经有5人回复
基金委咋了？2026年的指南还没有出来？已经有7人回复
国自然申请面上模板最新2026版出了吗？已经有17人回复
纳米粒子粒径的测量已经有8人回复
疑惑？已经有5人回复
计算机、0854电子信息（085401-058412）调剂已经有5人回复
Materials Today Chemistry审稿周期已经有5人回复
溴的反应液脱色已经有7人回复
推荐一本书已经有12人回复
常年博士招收(双一流，工科) 已经有4人回复

1楼 2014-11-09 12:41:04

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

petersonic

铁虫 (初入文坛)

应助: 0 (幼儿园)
金币: 104
帖子: 9
在线: 4.5小时
虫号: 3266032
注册: 2014-06-10
专业: 工程热物理与能源利用

笑脸地方为

回复此楼

2楼2014-11-09 12:42:50

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

相关版块跳转我要订阅楼主 petersonic 的主题更新

返回列表