在 FORTRAN 子例程中传递不同的变量集

Posted 2023-03-27

【中文标题】在 FORTRAN 子例程中传递不同的变量集

【英文标题】：Passing different set of variables in a FORTRAN subroutine

【发布时间】：2014-07-02 22:42:14

【问题描述】：

我想应用三种不同的方法，用整数开关的值选择。第一种方法使用两个整数，第二个是实数数组和一个整数，第三个是实数二维数组。在我当前的实现中，我分配并作为参数传递所有上述数据（2 int + real_array + int + real_2array）。我也可以使用一个模块，但它会是相似的。我正在寻找一种方法来仅定义我的方法将使用的数据（即仅用于方法 3 的矩阵），仅此而已。有什么建议吗？

编辑： 我已经制作了上述内容的简化版本。 主程序的一部分：

  INTEGER                             :: m, imeth
  REAL*8                              :: x, y
  REAL*8, DIMENSION(:), ALLOCATABLE   :: uu, wc
  REAL*8, DIMENSION(:,:), ALLOCATABLE :: BCH

  imeth = 0
  m = 64
  ALLOCATE(uu(m), uu_(m), wc(m))
  ALLOCATE(BCH(m,m))

  if (imeth .EQ. 0) then
     x = 1.0d0
     y = 2.0d0
  elseif (imeth .EQ. 1) then
     !Assign values to wc
  else
     !Assign values to BCH
  endif

  call subr(m,x,y,uu,uu_,imeth,BCH,wc)

  STOP
  END

和一个子程序

  SUBROUTINE subr(n,a,b,u,u_,imeth,DCH,ws)
  IMPLICIT NONE
  INTEGER,  INTENT(IN)  :: n, imeth
  REAL*8,   INTENT(IN)  :: u(n), DCH(n,n), ws(n)
  REAL*8,   INTENT(OUT) :: u_(n)
  INTEGER              :: i

  if (imeth .EQ. 0) then
     u_ = -u_ * 0.5d0 / (a+b)
  elseif (imeth .EQ. 1) then
     u_ = -u / ws
  else
     u_ = matmul(DCH,u)
  endif

  RETURN
  END SUBROUTINE subr

我希望主程序有一个像

这样的形式

  imeth = 0
  m = 64
  ALLOCATE(uu(m), uu_(m))


  if (imeth .EQ. 0) then
     a = 1.0d0
     b = 2.0d0
  elseif (imeth .EQ. 1) then
     ALLOCATE(wc(m))
     !Assign values to wc
  else
     ALLOCATE(BCH(m,m))
     !Assign values to BCH
  endif

  if (imeth .EQ. 0) then
     call subrA(m,x,y,uu,uu_)
  elseif (imeth .EQ. 1) then
     call subrB(m,wc,uu,uu_)
  else
     call subrC(m,BCH,uu,uu_)
  endif

【问题讨论】：

你的代码让情况一目了然。

你可能会写一个 p

@Theo - 如果您编辑此问题以更清楚地显示您想要完成的内容，使用一些代码以及您尝试过的内容不起作用，我相信您会得到一个很好的答案相当快。事实上，这个问题很难回答。我认为您可以使用可分配的对象或较新的编译器中的块来做您想做的事情，但我不确定。

现在投票重新开放 OP 已经发布了代码，她的问题更加清晰。

【参考方案1】：

编辑：在 OP 添加代码后，我认为将 optional 参数与 present 内在函数结合使用可能更适合此任务。然后子程序可以读取

SUBROUTINE subr(n,u_,a,b,u,DCH,ws)
  IMPLICIT NONE
  INTEGER,  INTENT(IN)           :: n
  REAL*8,   INTENT(OUT)          :: u_(n)
  REAL*8,   INTENT(IN),OPTIONAL  :: a(n)
  REAL*8,   INTENT(IN),OPTIONAL  :: b(n)
  REAL*8,   INTENT(IN),OPTIONAL  :: u(n)
  REAL*8,   INTENT(IN),OPTIONAL  :: DCH(n,n)
  REAL*8,   INTENT(IN),OPTIONAL  :: ws(n)
  INTEGER                        :: i

  if ( present(a) .and. present(b) ) then
     u_ = -u_ * 0.5d0 / (a+b)
  elseif ( present(u) .and. present(ws) ) then
     u_ = -u / ws
  elseif ( present(wch) .and. present(u) ) then
     u_ = matmul(DCH,u)
  else
     stop 'invalid combination'
  endif

END SUBROUTINE subr

---

这是旧答案，因为它仍然可能会有所帮助：

---

也许你可以试试interfaces:

module interface_test

  implicit none

  interface method
    module procedure method1
    module procedure method2
    module procedure method3
  end interface

contains

  subroutine method1(int1, int2)
    implicit none
    integer,intent(in)  :: int1
    integer,intent(out) :: int2

    int2 = 2*int1
  end subroutine

  subroutine method2(int, realArray)
    implicit none
    integer,intent(in)  :: int
    real,intent(out)    :: realArray(:)

    realArray = real(2*int)
  end subroutine

  subroutine method3(realArray)
    implicit none
    real,intent(inout)  :: realArray(:,:)

    realArray = 2*realArray
  end subroutine

end module

program test
  use interface_test, only: method
  implicit none
  integer :: int1, int2
  real    :: arr1D(10)
  real    :: arr2D(10,10)

  int1 = 1

  call method(int1, int2)
  print *, int2

  call method(int1,arr1D)
  print *, arr1D(1)

  arr2D = 1.
  call method(arr2D)
  print *, arr2D(1,1)
end program

【讨论】：

我编辑了我的问题，添加了一个最小的例子，但我认为这会有所帮助......我会试试这个。谢谢！

@Theo 如果我正确阅读了您的示例，您将明确调用三个 不同 子例程。然后，接口不是必需的！我怀疑您的问题更像是如何在这三个例程之间共享公共代码！