回 帖 发 新 帖 刷新版面

主题:程序中无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

回复列表 (共2个回复)

沙发

发现了里面的几个小问题,后来修改了下,但是还有个错误:
fetal error:eig function has generated  error message from lover-level routines;
我把程序贴上,高手们都给我看下吧,谢谢啦


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*m)) 
  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
   r0=0.0
   l0=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=transpose(r0)
         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

板凳

搞出来啦

我来回复

您尚未登录,请登录后再回复。点此登录或注册