Fortran 中的“包装”子例程

Question

我是 Fortran 新手，很好奇如何正确“包装”子例程。

例如假设我有一个主程序调用某个子例程

outer

，检查标志，然后调用其他子例程

inner_1

或

inner_2

，具体取决于

flag

的值。它将参数传递给内部子例程。

天真地，我可以创建一个子例程

outer

，而不是检查标志并调用内部子例程。但这需要声明传递给

outer

的所有变量，以便将它们传递给内部子例程。对于许多争论来说，这似乎很麻烦。

这是实现此目的的标准方法，还是有一些我不知道的更好的方法？

我写了一个工作示例：

program main

    use m_mod,  only : outer

    implicit none

    real    :: a = 1.0
    integer :: b = 1
    integer :: flag

    flag = 1
    call outer(a,b,flag)

    flag = 2
    call outer(a,b,flag)

end program main

module m_mod

    implicit none

    private
    public  :: outer

    contains

    subroutine outer(a,b,flag)

        real, intent(in)    :: a
        integer, intent(in) :: b
        integer, intent(in) :: flag

        if (flag == 1) then
            call inner_1(a,b)
        else
            call inner_2(a,b)
        end if

    end subroutine outer

    subroutine inner_1(a,b)

        real, intent(in)    :: a
        integer, intent(in) :: b

        write(*,*) "inner_1-a", a
        write(*,*) "inner_1-b", b

    end subroutine inner_1

    subroutine inner_2(a,b)

        real, intent(in)    :: a
        integer, intent(in) :: b

        write(*,*) "inner_2-a", a
        write(*,*) "inner_2-b", b

    end subroutine inner_2

end module m_mod 

输出

 inner_1-a   1.00000000    
 inner_1-b           1
 inner_2-a   1.00000000    
 inner_2-b           1

正如预期的那样。我只是想知道是否有更好的方法来做到这一点！

Answer 1

如果您想保持内部例程独立（即可以从包装例程之外的其他例程调用它们），则没有明显的其他解决方案。否则，您可以将它们转换为包含的例程，而不必重复参数列表：

module m_mod

    implicit none

    private
    public  :: outer

    contains

    subroutine outer(a,b,flag)

        real, intent(in)    :: a
        integer, intent(in) :: b
        integer, intent(in) :: flag

        if (flag == 1) then
            call inner_1()
        else
            call inner_2()
        end if
    
    CONTAIN
        ! a, b, (and flag), are available to the contained routines
        ! thanks to host association

        subroutine inner_1()

            write(*,*) "inner_1-a", a
            write(*,*) "inner_1-b", b

        end subroutine inner_1

        subroutine inner_2()

            write(*,*) "inner_2-a", a
            write(*,*) "inner_2-b", b

        end subroutine inner_2

    end subroutine outer

end module m_mod