0

我完全迷路了。

我尝试将两个可选参数传递给 fortran 中的函数，这两个是未知长度的数组。代码编译得很好，但是当程序运行时，它在 PRESENT(arg) 函数的评估过程中崩溃。命令行中没有错误消息，而是弹出窗口错误通知，并告诉我“main.exe 已停止工作”有关如何解决此问题的任何想法？

这是代码，我删除了所有不必要的内容。

MODULE types
  ! Underlying data types: Bra, Ket, and Oper
  type bra
    complex*8, dimension(:,:), allocatable  :: dat
    integer*4                               :: typ ! = "Bra"
    integer*4, dimension(2)                 :: dims
  end type bra

  type ket
    complex*8, dimension(:,:), allocatable  :: dat
    integer*4                               :: typ ! = "Ket"
    integer*4, dimension(2)                 :: dims
  end type ket

  type oper
    complex*8, dimension(:,:), allocatable  :: dat
    integer*4                               :: typ ! = "Operator"
    integer*4, dimension(2)                 :: dims
  end type oper
END MODULE types

MODULE basics
  ! The types are declared in an extra module, to be imported here
  ! Otherwise it is not possible to use derived types in procedures
  use types

  interface operator (*)
    ! "Quantum" multiplication
    procedure otk ! Operator  Times Ket         O  *|B > = |C>
  end interface

  CONTAINS
  ! Fock state
  function fock(N,M)
    ! N is the dimension of the underlying array
    ! M is the number of photons inside
    ! M=1 is vacuum
    integer*4 :: N,M
    type(ket) :: fock

    ! Check is the passed dimensions are okay
    if (N<2 .or. M<0 .or. M > N-1) then
      print*,'Invalid input while making a fock state'
      print*,'N=',N,'M=',M
      stop
    end if

    ! Allocate and initilaize with zeros
    allocate(fock%dat(N,1))
    fock%dat = (0d0,0d0)

    ! Now actually make the state by replacing a zero with 1
    fock%dat(M+1,1) = (1d0,0d0)

    ! Set type of the object to 'ket'
    fock%typ = 2

    ! Set the dimensions
    fock%dims = [N,1]
  end function fock

  ! Identity matrix
  function qeye(N)
    integer*4   :: N,i
    type(oper)  :: qeye

    ! Allocate and initilaize with zeros
    allocate(qeye%dat(N,N))
    qeye%dat = (0d0,0d0)

    ! Set diagonal elements to 1
    do i = 1,N
      qeye%dat(i,i) = (1d0,0d0)
    end do

    ! Set type of the object to 'oper'
    qeye%typ = 4

    ! Set the dimensions
    qeye%dims = [N,N]
  end function qeye

  ! Operator Times Ket
  function otk(left, right)
    type(oper), intent(in)  :: left
    type(ket), intent(in)   :: right
    type(ket)               :: otk
    ! If the operator is as wide, as the state is high, do matrix multiplication
    if (left%dims(2) == right%dims(1)) then
      ! Result is a Ket vector again
      allocate(otk%dat(left%dims(1),1))
      otk%dat = matmul(left%dat,right%dat)
      ! Also set data type and dimensions of the result
      otk%dims = [right%dims(1),1]
      otk%typ = 2
      return
    else
      print*,'You are trying to use an operator on a ket of inconsistent dimensions'
      print*,left%dims,'and',right%dims
      stop
    end if
  end function otk
end module basics

MODULE RK
  ! Import modules to work with quantum objects
  use types
  use basics

  contains
  subroutine rungekutta(state,HAM,times,results)
    ! In-/Output:
    ! Starting state, also final state
    type(ket)             :: state 
    ! Function delivering time dependent hamiltonian
    type(oper), external  :: HAM 
    ! Array with times at which to do calculations
    real*8, dimension(:)  :: times
    ! Placeholder for the length of a given time step
    real*8                :: t_0, t_step
    ! Optional array of ket states to hold all the intermediate results
    type(ket), dimension(:),optional  :: results 

    ! Variables for internal calculations
    type(ket) :: psi0

    ! Looping coefficients
    integer*8 :: ii
    ! Start of the calculations
    ! (The actual Runge-Kutta method is different, but not needed now)
    results(1) = state
    do ii = 1, size(times)-1
      t_0     = times(ii)
      t_step  = times(ii+1) - times(ii)

      psi0    = results(ii)
      results(ii+1) = HAM(t_0) * psi0   
    end do

    ! Save the last calculated state to the input/output variable
    state = results(size(results)) 
  end subroutine rungekutta
end MODULE RK

module dummy
  ! Import modules to work with quantum objects
  use types
  use basics

  CONTAINS
  ! Define Hamiltonian function

  function testHAM(t, freqs, coefs)
    type(oper)  :: testHAM
    real*8      :: t

    ! Optional variables is the Hamiltonian is time dependent
    real*8, dimension(:), optional  :: freqs, coefs

    testHAM = qeye(2)
    ! Variable part
    if (.NOT.present(freqs)) then
      print*,'gotcha'
    end if
  end function testHAM
end module dummy

program main
  ! Import modules to work with quantum objects
  use types
  use basics
  use RK

  ! Import hamilton definition
  use dummy

  IMPLICIT NONE

  ! Define variables
  type(ket)              :: start, goal
  real*8, dimension(:), allocatable  :: timesarr
  integer*4              :: N,i,M,j,k,l,mm
  type(ket), dimension(:), allocatable  :: results

  ! Set number of steps, and the total time
  N = 5000
  allocate(timesarr(N))
  timesarr = [0d0,1d0]

  start=fock(2,0)

  ! Allocate the vector holding the results
  allocate(results(N))
  results = start

  call rungekutta(start,testHAM,timesarr,results)
end program main

我也在“结果”数组和其他地方使用可选关键字，它工作正常。我真的很感激任何帮助，因为我真的没有心情处理这些东西，因为它会使代码更加混乱:)

提前致谢！

4

2 回答 2

1

具有可选参数的过程需要一个显式接口，以便在引用该过程的任何范围内都可以访问该过程。

提供的代码不符合此要求。

请注意，该过程被引用了两次。

在执行顺序中，第一个引用 - 当testHAM过程与HAM主程序中调用 rungekutta 的虚拟参数相关联时 - 可以 - 显式接口可用（标识符用于模块过程 - 因此显式接口是自动的） .

但是执行顺序中的第二个引用 - 当HAM调用虚拟过程时 - 不正常。使用带有外部属性的类型声明语句“仅”声明虚拟参数。这并没有为过程提供显式接口。

（就语言本身而言 - 我的观点是，如果您必须（甚至只是“应该”）使用外部属性，那么您的编码就会表现出糟糕的风格。）

正确的直接方法是使用为虚拟过程参数提供显式接口的方法之一 - 可能通过接口块或具有proc-interface规范的过程声明语句。

如果虚拟过程的接口所需的相关特性与过程的实际接口不匹配testHAM（这里假设rungekutta过程不关心或想知道可选参数），那么您可能需要使用一个包装过程或类似的方法来转发过程调用。

编辑添加：虽然标准不要求它 - 期望编译器对此用法发出警告是合理的。虽然具有可选参数的过程与具有隐式接口的伪过程的关联是“合法的”，但无论如何都不可能使用伪过程。这可能值得与您的 Fortran 处理器供应商讨论。

于 2013-10-24T01:13:46.970 回答
0

lanH 当然是对的。一个明确的解决方案如下所示：

MODULE types
  ! Underlying data types: Bra, Ket, and Oper
  type bra
    complex*8, dimension(:,:), allocatable  :: dat
    integer*4                               :: typ ! = "Bra"
    integer*4, dimension(2)                 :: dims
  end type bra

  type ket
    complex*8, dimension(:,:), allocatable  :: dat
    integer*4                               :: typ ! = "Ket"
    integer*4, dimension(2)                 :: dims
  end type ket

  type oper
    complex*8, dimension(:,:), allocatable  :: dat
    integer*4                               :: typ ! = "Operator"
    integer*4, dimension(2)                 :: dims
  end type oper
END MODULE types

MODULE basics
  ! The types are declared in an extra module, to be imported here
  ! Otherwise it is not possible to use derived types in procedures
  use types

  interface operator (*)
    ! "Quantum" multiplication
    procedure otk ! Operator  Times Ket         O  *|B > = |C>
  end interface

  CONTAINS
  ! Fock state
  function fock(N,M)
    ! N is the dimension of the underlying array
    ! M is the number of photons inside
    ! M=1 is vacuum
    integer*4 :: N,M
    type(ket) :: fock

    ! Check is the passed dimensions are okay
    if (N<2 .or. M<0 .or. M > N-1) then
      print*,'Invalid input while making a fock state'
      print*,'N=',N,'M=',M
      stop
    end if

    ! Allocate and initilaize with zeros
    allocate(fock%dat(N,1))
    fock%dat = (0d0,0d0)

    ! Now actually make the state by replacing a zero with 1
    fock%dat(M+1,1) = (1d0,0d0)

    ! Set type of the object to 'ket'
    fock%typ = 2

    ! Set the dimensions
    fock%dims = [N,1]
  end function fock

  ! Identity matrix
  function qeye(N)
    integer*4   :: N,i
    type(oper)  :: qeye

    ! Allocate and initilaize with zeros
    allocate(qeye%dat(N,N))
    qeye%dat = (0d0,0d0)

    ! Set diagonal elements to 1
    do i = 1,N
      qeye%dat(i,i) = (1d0,0d0)
    end do

    ! Set type of the object to 'oper'
    qeye%typ = 4

    ! Set the dimensions
    qeye%dims = [N,N]
  end function qeye

  ! Operator Times Ket
  function otk(left, right)
    type(oper), intent(in)  :: left
    type(ket), intent(in)   :: right
    type(ket)               :: otk
    ! If the operator is as wide, as the state is high, do matrix multiplication
    if (left%dims(2) == right%dims(1)) then
      ! Result is a Ket vector again
      allocate(otk%dat(left%dims(1),1))
      otk%dat = matmul(left%dat,right%dat)
      ! Also set data type and dimensions of the result
      otk%dims = [right%dims(1),1]
      otk%typ = 2
      return
    else
      print*,'You are trying to use an operator on a ket of inconsistent dimensions'
      print*,left%dims,'and',right%dims
      stop
    end if
  end function otk
end module basics

MODULE RK
  ! Import modules to work with quantum objects
  use types
  use basics

  contains
  subroutine rungekutta(state,HAM,times,results)
    ! In-/Output:
    ! Starting state, also final state
    type(ket)             :: state 
    ! PeMa: Function delivering time dependent hamiltonian (now a correct interface)
    interface
    function HAM(t,freqs,coefs)
       use types
       ! type(oper),external :: HAM
       ! Edit (see comments) :
       type(oper) :: HAM
       real(8)      :: t
       real(8), dimension(:),allocatable,optional :: freqs, coefs
    end function
    end interface

    ! PeMa: define testing arrays to test the otional arguments:
    real(8), dimension(:),allocatable :: a, b

    ! Array with times at which to do calculations
    real*8, dimension(:)  :: times
    ! Placeholder for the length of a given time step
    real*8                :: t_0, t_step
    ! Optional array of ket states to hold all the intermediate results
    type(ket), dimension(:),optional  :: results 

    ! Variables for internal calculations
    type(ket) :: psi0

    ! Looping coefficients
    integer*8 :: ii
    ! Start of the calculations
    ! (The actual Runge-Kutta method is different, but not needed now)

    !PeMa: my testing arrays
    allocate(a(1:2))
    allocate(b(1:2))
    a=(/1d0,3d0/)
    b=(/2d0,4d0/)

    results(1) = state
    do ii = 1, size(times)-1
      t_0     = times(ii)
      t_step  = times(ii+1) - times(ii)

      psi0    = results(ii)

      !PeMa: use one of the next to lines and you see in the output that it's working now:
      results(ii+1) = HAM(t_0,a,b) * psi0   
      !results(ii+1) = HAM(t_0) * psi0   
    end do

    ! Save the last calculated state to the input/output variable
    state = results(size(results)) 
  end subroutine rungekutta
end MODULE RK

module dummy
  ! Import modules to work with quantum objects
  use types
  use basics

  CONTAINS
  ! Define Hamiltonian function

  function testHAM(t, freqs, coefs)
    type(oper)  :: testHAM
    real*8      :: t

    ! PeMa: Optional variables is the Hamiltonian is time dependent (I'm using allocatable to be sure about the 'position labeling' ... sorry can't say it better)
    real*8, dimension(:), allocatable,optional  :: freqs, coefs

    testHAM = qeye(2)
    ! Variable part
    !PeMa: I inserted some 'else' to test both possibilities: 
    if (.NOT.present(freqs)) then
      print*,'gotcha'
    else
      print*,freqs,coefs
    end if
  end function testHAM
end module dummy

program main
  ! Import modules to work with quantum objects
  use types
  use basics
  use RK

  ! Import hamilton definition
  use dummy

  IMPLICIT NONE

  ! Define variables
  type(ket)              :: start, goal
  real*8, dimension(:), allocatable  :: timesarr
  integer*4              :: N,i,M,j,k,l,mm
  type(ket), dimension(:), allocatable  :: results

  ! Set number of steps, and the total time (PeMa: 5 is enough ;-) )
  N = 5
  allocate(timesarr(N))
  timesarr = [0d0,1d0]

  start=fock(2,0)

  ! Allocate the vector holding the results
  allocate(results(N))
  results = start

  call rungekutta(start,testHAM,timesarr,results)
end program main

（希望）所有我改变的地方都标有“PeMa”。现在它不仅在编译（可能无处不在），而且真的在做它应该做的事情。您可以通过在 rungecutta 中使用不同的函数调用命令输入和输出两行来测试这一点。希望我能帮助你！最好的

于 2013-10-24T21:05:08.870 回答