Функция Fortran PRESENT() с предполагаемым массивом длины дает сбой EDITED

Для процедуры с необязательными аргументами требуется явный интерфейс, чтобы процедура была доступна в любой области, где на процедуру ссылаются.

Представленный код не соответствует этому требованию.

Обратите внимание, что процедура упоминается дважды.

В порядке выполнения первая ссылка — когда процедура testHAM связана с фиктивным аргументом HAM при вызове rungekutta в основной программе — в порядке — доступен явный интерфейс (идентификатор для процедуры модуля — поэтому явный интерфейс автоматический).

А вот вторая ссылка в порядке выполнения — при вызове фиктивной процедуры HAM — не годится. Фиктивный аргумент объявляется «только» с использованием оператора объявления типа с внешним атрибутом. Это не дает процедуре явного интерфейса.

(С языком как есть - мое мнение таково, что если вам нужно (или даже просто «должно») использовать внешний атрибут, то ваш код демонстрирует плохой стиль.)

Правильный непосредственный подход состоит в том, чтобы использовать один из методов предоставления аргументу фиктивной процедуры явного интерфейса - возможно, через интерфейсный блок или оператор объявления процедуры со спецификацией proc-interface.

Если желаемые релевантные характеристики интерфейса фиктивной процедуры не соответствуют фактическому интерфейсу процедуры testHAM (здесь предполагается, что процедура rungekutta не заботится или не хочет знать о необязательных аргументах), тогда вам может понадобиться использовать процедуру-оболочку или аналогичный подход для пересылки вызова процедуры.

Изменить, чтобы добавить: хотя стандарт не требует этого, было бы разумно ожидать предупреждения от компилятора для такого использования. Хотя ассоциация процедуры с необязательными аргументами с фиктивной процедурой с неявным интерфейсом является «законной», в этом случае фиктивная процедура в любом случае не может быть использована. Возможно, стоит обсудить это с поставщиком вашего процессора Fortran.

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. Надеюсь, я смог вам помочь! Лучший