Matrix fortran中zheev例程的问题

Matrix fortran中zheev例程的问题,matrix,fortran,lapack,Matrix,Fortran,Lapack,我想写一个程序,计算伊辛系统的哈密顿量。程序的第一部分工作正常,我得到了我想要的矩阵,但是当我试图用子程序zheev得到这个复数*16矩阵的特征值时,出现了一个问题。正如我读到的,我必须调用它2次,以便为整数lwork分配尽可能好的值。但是对于给定的矩阵,我得到的不是特征值(-2.236,-1,1,2.236),而是(132,0,1,0)。谁能帮帮我吗 多谢各位 module matrices implicit none type matrix complex*16, dimensi

我想写一个程序,计算伊辛系统的哈密顿量。程序的第一部分工作正常,我得到了我想要的矩阵,但是当我试图用子程序zheev得到这个复数*16矩阵的特征值时,出现了一个问题。正如我读到的,我必须调用它2次,以便为整数lwork分配尽可能好的值。但是对于给定的矩阵,我得到的不是特征值(-2.236,-1,1,2.236),而是(132,0,1,0)。谁能帮帮我吗

多谢各位

module matrices
 implicit none
 type matrix
    complex*16, dimension(:,:), allocatable :: el
    integer :: row, col
 end type

 contains 

    type(matrix) function assign0(row, col)
       integer :: ii, jj, row, col
       assign0%row = row
       assign0%col = col
       allocate(assign0%el(assign0%row, assign0%col))
       do ii = 1, assign0%row
          do jj = 1, assign0%col
             assign0%el(ii, jj) = cmplx(0d0, 0d0)
          enddo
       enddo
    end function assign0

    type(matrix) function assignid(row, col)
       integer :: ii, jj, row, col
       assignid%row = row
       assignid%col = col
       allocate(assignid%el(assignid%row, assignid%col))
       do ii = 1, assignid%row
          jj = ii
          assignid%el(ii, jj) = cmplx(1d0, 0d0)
       enddo
    end function assignid

    type(matrix) function assignsigx()
       allocate(assignsigx%el(assignsigx%row, assignsigx%col))         
       assignsigx = assign0(2, 2)
       assignsigx%el(1, 2) = (1d0, 0d0)
       assignsigx%el(2, 1) = (1d0, 0d0)
    end function 

    type(matrix) function assignsigz() 
       allocate(assignsigz%el(assignsigz%row, assignsigz%col))
       assignsigz = assign0(2, 2)
       assignsigz%el(1, 1) = (1d0, 0d0)
       assignsigz%el(2, 2) = (-1d0, 0d0)
    end function

    type(matrix) function prodscal(lambda, ma1)
       type(matrix) :: ma1
       real :: lambda
       integer :: ii, jj
       prodscal%row = ma1%row
       prodscal%col = ma1%col
       allocate(prodscal%el(prodscal%row, prodscal%col))
       do ii = 1, ma1%row
          do jj = 1, ma1%col
             prodscal%el(ii, jj) = lambda*ma1%el(ii, jj)
          enddo
       enddo
    end function prodscal

    type(matrix) function matsum(ma1, ma2, sign)
       type(matrix) :: ma1, ma2
       integer :: ii, jj, sign
       matsum%row = ma1%row
       matsum%col = ma1%col
       allocate(matsum%el(matsum%row, matsum%col))
       do ii = 1, ma1%row
          do jj = 1, ma1%col
             if (sign .gt. 0) then
                matsum%el(ii, jj) = ma1%el(ii, jj) + ma2%el(ii, jj)
             else
                matsum%el(ii, jj) = ma1%el(ii, jj) - ma2%el(ii, jj)
             endif
          enddo
       enddo       
    end function matsum

    type(matrix) function tensprod(ma1, ma2)
       type(matrix) :: ma1, ma2
       integer :: ii, jj, kk, ll
       tensprod%row = ma1%row*ma2%row
       tensprod%col = ma1%col*ma2%col
       allocate(tensprod%el(tensprod%row, tensprod%col))
       tensprod = assign0(tensprod%row, tensprod%col)
       do ii = 1, ma1%row
          do jj = 1, ma1%col
             do kk = 1, ma2%row
                do ll = 1, ma2%col
                   tensprod%el((ii - 1)*ma2%row + kk, (jj - 1)*ma2%col + ll) = ma1%el(ii, jj)*ma2%el(kk, ll)
                enddo
             enddo
          enddo
       enddo
    end function tensprod

 end module matrices

    program test
       use matrices
       implicit none

       interface 
          function getdim()
             integer :: getdim
          end function getdim
       end interface

       integer :: row, col, ii, jj, N, ind, info, lwork, aus
       type(matrix), dimension(2, 2) :: arrmat1, arrmat2
       type(matrix), dimension(2) :: element1, element2, element3
       type(matrix) :: elementtot, elementtot1, elementtot2
       real :: lambda
       double precision, dimension(:), allocatable :: w, rwork
       complex*16, dimension(:), allocatable :: work
       N = 2        

       allocate(w(15))
       allocate(rwork(15))
       allocate(work(15))

       lwork = -1
       aus = 2
       lambda = 1d0
       do ii = 1, N
          ind = ii
          do jj = 1, N
             if(jj .eq. ind) then
                arrmat1(ii, jj) = assignsigz()
             else
                arrmat1(ii, jj) = assignid(2, 2)
             endif
          enddo
       enddo

       do ii = 1, N
          ind = ii
          do jj = 1, N
             if(jj .eq. ind) then
                arrmat2(ii, jj) = assignsigx()
             else
                arrmat2(ii, jj) = assignid(2, 2)
             endif
          enddo
       enddo

       do ii = 1, N
          element1(ii) = tensprod(arrmat1(ii, 1), arrmat1(ii, 2))
          if (N .gt. 2) then
             do jj = 3, N
                element1(ii) = tensprod(element1(ii), arrmat1(ii, jj))
             enddo
          endif
       enddo

       do ii = 1, N
          element2(ii) = tensprod(arrmat2(ii, 1), arrmat2(ii, 2))
          if (N .gt. 2) then
             do jj = 3, N
                element2(ii) = tensprod(element2(ii), arrmat2(ii, jj))
             enddo
          endif
       enddo              

       do ii = 1, N - 1              
          element3(ii) = assign0(2**N, 2**N)
          element3(ii)%el = matmul(element2(ii + 1)%el, element2(ii)%el)
       enddo

       elementtot = assign0(2**N, 2**N)
       elementtot1 = assign0(2**N, 2**N)
       elementtot2 = assign0(2**N, 2**N)

       do ii = 1, N 
          elementtot1 = matsum(elementtot1, element1(ii), 1)
       enddo

       do ii = 1, N - 1
          elementtot2 = matsum(elementtot2, element3(ii), 1)
       enddo

       elementtot2 = prodscal(lambda, elementtot2)

       elementtot = matsum(elementtot1, elementtot2, 1)

       do ii = 1, 2**N 
          write(*,'(20G12.4)') elementtot%el(ii, 1:2**N)
       enddo                   

       call zheev('N', 'U', 2**N, elementtot%el, 2**N, w, work, lwork, rwork, info)
       lwork = int(work(1))
       call zheev('N', 'U', 2**N, elementtot%el, 2**N, w, work, lwork, rwork, info)           

       print*, '***', info

       do ii = 1, 2**N
          write(*,'(20G12.4)') work(ii)
       enddo

       stop

    end program test 

您的
assignsigx
assignsigz
函数正在根据各自返回值的
col
组件的未定义值为其返回值分配空间。您可能希望传入要使用的
大小,就像在
assign0
assignid
函数中一样。或者直接取出引用未定义组件的分配行,让后续分配使用
assign0
处理它

如果我去掉第33行和第39行,在启用完全检查的情况下使用NAG Fortran编译器编译和运行会告诉我

Extension: test.f90, line 4: Byte count on numeric data type
           detected at *@16
Extension: test.f90, line 112: Byte count on numeric data type
           detected at *@16
Questionable: test.f90, line 199: Variable AUS set but never referenced
Warning: test.f90, line 199: Unused local variable COL
Warning: test.f90, line 199: Unused interface for procedure GETDIM
Warning: test.f90, line 199: Unused local variable ROW
Questionable: test.f90, line 17: Intrinsic function CMPLX with double precision argument and no KIND= argument returns single precision result
Questionable: test.f90, line 29: Intrinsic function CMPLX with double precision argument and no KIND= argument returns single precision result
[NAG Fortran Compiler normal termination, 8 warnings]
Runtime Error: test.f90, line 87: Reference to undefined variable MA2%EL(KK,LL)
Program terminated by fatal error
Abort (core dumped)
ii
1
时,在第145行第一次调用
tensprod
时发生崩溃。
ma2%el(kk,ll)
中的
kk
ll
分别为
1和
2
。这似乎是因为您没有将
assignid
中的非对角元素归零。如果我也这样做,那么我明白了

Extension: test.f90, line 4: Byte count on numeric data type
           detected at *@16
Extension: test.f90, line 113: Byte count on numeric data type
           detected at *@16
Questionable: test.f90, line 200: Variable AUS set but never referenced
Warning: test.f90, line 200: Unused local variable COL
Warning: test.f90, line 200: Unused interface for procedure GETDIM
Warning: test.f90, line 200: Unused local variable ROW
Questionable: test.f90, line 17: Intrinsic function CMPLX with double precision argument and no KIND= argument returns single precision result
Questionable: test.f90, line 30: Intrinsic function CMPLX with double precision argument and no KIND= argument returns single precision result
[NAG Fortran Compiler normal termination, 8 warnings]
   2.000       0.000       0.000       0.000       0.000       0.000       1.000       0.000    
   0.000       0.000       0.000       0.000       1.000       0.000       0.000       0.000    
   0.000       0.000       1.000       0.000       0.000       0.000       0.000       0.000    
   1.000       0.000       0.000       0.000       0.000       0.000      -2.000       0.000    
Runtime Error: zheev.f90, line 1: Invalid reference to procedure ZHEEV - Dummy array WORK (number 7) has 36 elements but actual argument only has 15 elements
Program terminated by fatal error
Abort (core dumped)
因此,我认为,正如弗朗西斯卡勒斯所指出的那样,你没有调整工作的大小确实是一个问题

如果我根据新的
lwork
调整
work
的大小(通过取消分配并再次分配),我会得到结果

   2.000       0.000       0.000       0.000       0.000       0.000       1.000       0.000    
   0.000       0.000       0.000       0.000       1.000       0.000       0.000       0.000    
   0.000       0.000       1.000       0.000       0.000       0.000       0.000       0.000    
   1.000       0.000       0.000       0.000       0.000       0.000      -2.000       0.000    
 *** 0
   36.00       0.000    
   0.000       0.000    
   1.000       0.000    

顺便说一句,为什么要以打印
工作
作为结束?在执行工作区查询时,唯一感兴趣的事情应该是
工作(1)

我没有仔细查看,但是您执行了工作区查询,然后不做任何事情来将工作区大小调整到最佳大小(但告诉子例程它的大小)。