What is benefit of PASS in type-bound procedures?

Help
6

Typically I don’t use operator overloading a lot, and if possible I limit the use to non-polymorphic types. But I can see why that is needed and it makes sense franly.

As you remark, the case of reusing a procedure in multiple derived types is a bit strange.
What irks me a bit about this feature is the strong coupling it introduces.

Here is a potential use-case I’ve found for providing default settings, thematically related to the threads:

The example works with gfortran, ifort, ifx, flang, nvfortran and nagfor.

! linear_operators_demo.f90 --
!   Example of using passed-object dummy arguments as a means
!   of implementing a default fallback method.
!
!   This produces tight coupling of the problem class (linop) and the
!   solver class (krylov_method).
!
module linear_operators

implicit none
private

public :: dp, linop, matvec, preconditioner
public :: krylov_method, bicgstab
public :: linsolve

integer, parameter :: dp = kind(1.0d0)

! A linear operator of the form y = op(x)
type, abstract :: linop
    integer :: n = 0
contains
   procedure(apply_sub), deferred :: apply
end type

abstract interface
    subroutine apply_sub(op,x,y)
        import linop, dp
        class(linop), intent(in) :: op
        real(dp), intent(in) :: x(op%n)
        real(dp), intent(out) :: y(op%n)
    end subroutine
end interface

! Applies the y = A x operation, where A is a dense matrix
type, extends(linop) :: matvec
    ! Dense matrix, for the sake of this experiment
    real(dp), allocatable :: A(:,:)
contains
    procedure :: apply => apply_matvec

! N.b.: we could also make this method non_overridable
    procedure, pass(A) :: solve => solve_using_method
end type

! Applies the P = M^{-1} operation, by default this is just M = I
type, extends(linop) :: preconditioner
contains
    procedure :: apply => default_pc
end type

! Applies the A^{-1} operation, using a Krylov process
type, abstract :: krylov_method
contains
    procedure(solve_sub), deferred, pass(method) :: apply
end type

abstract interface
    subroutine solve_sub(A,b,x,P,method,info)
        import matvec, preconditioner, krylov_method, dp
        class(matvec), intent(in) :: A
        real(dp), intent(in) :: b(:)
        real(dp), intent(inout) :: x(:)
        class(preconditioner), intent(in), optional :: P
        class(krylov_method), intent(inout), optional :: method
        integer, intent(out) :: info
    end subroutine
end interface

! One particular Krylov method
type, extends(krylov_method) :: bicgstab
contains
    procedure, pass(method) :: apply => apply_bicgstab
end type

! Add to generic overload set, for solving different problems
interface linsolve
    module procedure :: solve_using_method
end interface

contains

    ! Dense matrix-vector product
    subroutine apply_matvec(op,x,y)
        class(matvec), intent(in) :: op
        real(dp), intent(in) :: x(op%n)
        real(dp), intent(out) :: y(op%n)
        y = matmul(op%A,x)
    end subroutine

    ! y = I x
    subroutine default_pc(op,x,y)
        class(preconditioner), intent(in) :: op
        real(dp), intent(in) :: x(op%n)
        real(dp), intent(out) :: y(op%n)
        y = x
    end subroutine

    subroutine apply_bicgstab(A,b,x,P,method,info)
        class(matvec), intent(in) :: A
        real(dp), intent(in) :: b(:)
        real(dp), intent(inout) :: x(:)
        class(preconditioner), intent(in), optional :: P
        class(bicgstab), intent(inout), optional :: method
        integer, intent(out) :: info

        ! this should always works in theory
        if (.not. present(method)) error stop "bicgstab method is not present."

        info = 0
        print *, "Calling fake bicgstab routine"

    end subroutine

    ! generic solve procedure with fallback to a default method
    subroutine solve_using_method(A,b,x,P,method,info)
        class(matvec), intent(in) :: A
        real(dp), intent(in) :: b(:)
        real(dp), intent(inout) :: x(:)
        class(preconditioner), intent(in), optional :: P
        class(krylov_method), intent(inout), optional :: method
        integer, intent(out) :: info
        if (present(method)) then
            call method%apply(A,b,x,P,info)
        else
            info = 0
            print *, "Calling fallback method"
        end if
    end subroutine

end module


program linear_operator_demo

    use linear_operators
    implicit none

    type(preconditioner) :: eye
    type(matvec) :: A
    class(krylov_method), allocatable :: method

    integer, parameter :: n = 3
    real(dp) :: x(n), b(n)
    integer :: info

    allocate( bicgstab :: method )

    call method%apply(A,b,x,info=info)
    call A%solve(b,x,method=method,info=info)
    call A%solve(b,x,info=info)

    call linsolve(A,b,x,P=eye,method=method,info=info)

end program

$ gfortran -Wall linear_operators_demo.f90 
$ ./a.out
 Calling fake bicgstab routine
 Calling fake bicgstab routine
 Calling fallback method
 Calling fake bicgstab routine