主题:程序中无sqtr也出error?
run-time error M0:MATH
--sqrt:DOMAIN error
中间的是文件错误省略
Incrementally linked image--pc correlation disable
以上是出错信息,但是我程序里没有sqrt函数啊?这是怎么啦?
程序贴上来给各位大侠看下吧。这里先感谢下 asymptotic 和 cgl_lgs 给我的帮助。
program main
use IMSL
! use linear_operators
implicit none
real, parameter::pi=3.14159265
complex, parameter:: fi=(0.0, 1.0)
real t,f,w
complex,allocatable::h(:,:)
complex,allocatable::h0(:,:)
complex,allocatable::r0(:,:)
complex,allocatable::l0(:,:)
! complex, allocatable:: h0(:,:)
real, allocatable:: eigenvalue(:) !特征值的矩阵
integer ::i,n,m
n=4
m=4
allocate(h(4*m*n,4*m*n))
allocate(h0(4*n,4*n),r0(4*n,4*n),l0(4*n,4*n))
allocate(eigenvalue(4*n))
w=0.0
t=1.0
f=0.25
call hmatr(h, n,m)
eigenvalue=eig(h)
do i=1,4*n*m
write(*,"('eigenvalue=',f10.7)")eigenvalue(i)
! write(*,"('eigenvector=['3(f5.2'')']')")eigenvector(:,i)
end do
stop
contains
subroutine hmatr(h,n,m)
integer n,m
complex h(:,:)
complex h0(4*n,4*n)
complex r0(4*n,4*n)
complex l0(4*n,4*n)
integer:: j,n0,x
complex:: c(4,4),a(4,4),b(4,4),r(4,4),l(4,4)
h0=0.0
a=0.0
h=0.0
a(1, 4)=t
b=transpose(a)
c=0.0
r=0.0
l=0.0
do n0=1,2*n-1,2
r(2,1)=t*exp(fi*(pi-2*pi*f/3*(3*n0/2+1/4)))
r(3,4)=t*exp(fi*(pi-2*pi*f/3*(3*(n0+1)/2+1/4)))
l(1,2)=conjg(r(2,1))
l(4,3)=conjg(r(3,4))
c(1,1)=w
c(2,1)=t*exp(fi*(-pi+2*pi/3*f*(1.5*n0+1/4)))
c(1,2)=conjg(c(2,1)) !t*exp(fi*(-pi+2*pi/3*f*(1.5*n0+1/4)))
c(2, 2) = w
c(2, 3) = t
c(3, 2) = t
c(3, 3) = w
c(3, 4) = t*exp(-fi*(-pi+2*pi/3*f*(1.5*(n0+1)+1/4)))
c(4, 3) = conjg( c(3, 4) ) !t*exp(-fi*(-pi+2*pi/3*f*(1.5*(n0+1)+1/4)))
c(4, 4) = w
j=2*n0-1
do j=1,4*n-3,4
r0(j:j+3,j:j+3)=r
l0(j:j+3,j:j+3)=l
h0(j:j+3,j:j+3)=c
if(j==1) then
h0(j:j+3,j+4:j+7)=b;
h0(j:j+3,4*n-3:4*n)=a;
else if(j>=5.and.j<4*n-3) then
h0(j:j+3,j+4:j+7)=b;
h0(j:j+3,j-4:j-1)=a;
else
h0(4*n-3:4*n,1:4)=b;
h0(j:j+3,j-4:j-1)=a;
end if
end do
end do
do x=1,4*(m-1)*n+1,4*n
H(x:x+4*n-1,x:x+4*n-1)=h0;
if( x==1) then
h(x:x+4*n-1,x+4*n:8*n)=r0
h(x:x+4*n-1,(m-1)*4*n+1:m*4*n)=l0
elseif( x>=4*n+1 .and. x<4*(m-1)*n+1) then
h(x:x+4*n-1,x+4*n:x+8*n-1)=r0
h(x:x+4*n-1,x-4*n:x-1)=l0
else
h(x:x+4*n-1,1:4*n)=r0
h(x:x+4*n-1,x-4*n:x-1)=l0
end if
end do
end subroutine hmatr
end program main
--sqrt:DOMAIN error
中间的是文件错误省略
Incrementally linked image--pc correlation disable
以上是出错信息,但是我程序里没有sqrt函数啊?这是怎么啦?
程序贴上来给各位大侠看下吧。这里先感谢下 asymptotic 和 cgl_lgs 给我的帮助。
program main
use IMSL
! use linear_operators
implicit none
real, parameter::pi=3.14159265
complex, parameter:: fi=(0.0, 1.0)
real t,f,w
complex,allocatable::h(:,:)
complex,allocatable::h0(:,:)
complex,allocatable::r0(:,:)
complex,allocatable::l0(:,:)
! complex, allocatable:: h0(:,:)
real, allocatable:: eigenvalue(:) !特征值的矩阵
integer ::i,n,m
n=4
m=4
allocate(h(4*m*n,4*m*n))
allocate(h0(4*n,4*n),r0(4*n,4*n),l0(4*n,4*n))
allocate(eigenvalue(4*n))
w=0.0
t=1.0
f=0.25
call hmatr(h, n,m)
eigenvalue=eig(h)
do i=1,4*n*m
write(*,"('eigenvalue=',f10.7)")eigenvalue(i)
! write(*,"('eigenvector=['3(f5.2'')']')")eigenvector(:,i)
end do
stop
contains
subroutine hmatr(h,n,m)
integer n,m
complex h(:,:)
complex h0(4*n,4*n)
complex r0(4*n,4*n)
complex l0(4*n,4*n)
integer:: j,n0,x
complex:: c(4,4),a(4,4),b(4,4),r(4,4),l(4,4)
h0=0.0
a=0.0
h=0.0
a(1, 4)=t
b=transpose(a)
c=0.0
r=0.0
l=0.0
do n0=1,2*n-1,2
r(2,1)=t*exp(fi*(pi-2*pi*f/3*(3*n0/2+1/4)))
r(3,4)=t*exp(fi*(pi-2*pi*f/3*(3*(n0+1)/2+1/4)))
l(1,2)=conjg(r(2,1))
l(4,3)=conjg(r(3,4))
c(1,1)=w
c(2,1)=t*exp(fi*(-pi+2*pi/3*f*(1.5*n0+1/4)))
c(1,2)=conjg(c(2,1)) !t*exp(fi*(-pi+2*pi/3*f*(1.5*n0+1/4)))
c(2, 2) = w
c(2, 3) = t
c(3, 2) = t
c(3, 3) = w
c(3, 4) = t*exp(-fi*(-pi+2*pi/3*f*(1.5*(n0+1)+1/4)))
c(4, 3) = conjg( c(3, 4) ) !t*exp(-fi*(-pi+2*pi/3*f*(1.5*(n0+1)+1/4)))
c(4, 4) = w
j=2*n0-1
do j=1,4*n-3,4
r0(j:j+3,j:j+3)=r
l0(j:j+3,j:j+3)=l
h0(j:j+3,j:j+3)=c
if(j==1) then
h0(j:j+3,j+4:j+7)=b;
h0(j:j+3,4*n-3:4*n)=a;
else if(j>=5.and.j<4*n-3) then
h0(j:j+3,j+4:j+7)=b;
h0(j:j+3,j-4:j-1)=a;
else
h0(4*n-3:4*n,1:4)=b;
h0(j:j+3,j-4:j-1)=a;
end if
end do
end do
do x=1,4*(m-1)*n+1,4*n
H(x:x+4*n-1,x:x+4*n-1)=h0;
if( x==1) then
h(x:x+4*n-1,x+4*n:8*n)=r0
h(x:x+4*n-1,(m-1)*4*n+1:m*4*n)=l0
elseif( x>=4*n+1 .and. x<4*(m-1)*n+1) then
h(x:x+4*n-1,x+4*n:x+8*n-1)=r0
h(x:x+4*n-1,x-4*n:x-1)=l0
else
h(x:x+4*n-1,1:4*n)=r0
h(x:x+4*n-1,x-4*n:x-1)=l0
end if
end do
end subroutine hmatr
end program main