| 查看: 848 | 回复: 1 | ||
[求助]
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,  =dcmc(2, =dbdo i=1,n mc(3,i)=a(i) end do mc(4, =dbmc(5, =dcmc(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 |
回复此楼» 猜你喜欢
献血感触
已经有4人回复
-
评审有感
已经有16人回复
-
反应很差，大量原料没有反应
已经有3人回复
-
Sci. Bull. 悲剧经验
已经有4人回复
-
找博士生导师
已经有7人回复
-
上海大学实验技术岗位非升即走
已经有11人回复
-
26/27申博自荐-锂/钠电池方向
已经有4人回复
-
同样的基金本子，换个专家直接从C变A！
已经有3人回复
-
别被青基扩招骗了！26年科研内卷才刚刚开始
已经有4人回复
-
26/27博士推荐
已经有4人回复
2楼2014-11-09 12:42:50
5