This question follows Fortran : Is it possible to overload a procedure in a abstract interface?.

Following the second option suggested by Federico Perini in its answer, I wrote the following code where a question is asked to the user to choose between line, rectangle or box.

module myModule
    implicit none

    type, abstract :: shape_t
    contains

        ! Put init in a generic interface
        procedure(abstract_init), deferred, private  :: shared_init
        generic :: init => shared_init

        procedure(abstract_print), deferred :: print_size
    end type shape_t

    abstract interface
        subroutine abstract_init(this,length1,length2,length3)
            import shape_t
            class(shape_t), intent(inout) :: this
            real, intent(in) :: length1,length2,length3
        end subroutine abstract_init

        subroutine abstract_print(this)
            import shape_t
            class(shape_t), intent(in) :: this
        end subroutine abstract_print
    end interface

    type, extends(shape_t) :: line_t
        real :: length
    contains
        procedure :: shared_init => init_line
        procedure :: init_line_1d
        generic   :: init => init_line_1d
        procedure :: print_size => print_linesize
    end type line_t

     type, extends(shape_t) :: rectangle_t
        real :: length,width
    contains
        procedure :: shared_init => init_rectangle
        procedure :: init_rectangle_2d
        generic   :: init => init_rectangle_2d
        procedure :: print_size => print_rectanglesize
    end type rectangle_t

    type, extends(shape_t) :: box_t
        real :: length,width,height
    contains
        procedure :: shared_init => init_box
        procedure :: print_size => print_boxsize
    end type box_t

contains
    subroutine init_line_1d(this,length1)
        class(line_t), intent(inout) :: this
        real, intent(in) :: length1
        this%length = length1
    end subroutine init_line_1d
    subroutine init_line(this,length1,length2,length3)
        class(line_t), intent(inout) :: this
        real, intent(in) :: length1,length2,length3
        call init_line_1d(this,length1)
    end subroutine init_line

    subroutine print_linesize(this)
        class(line_t), intent(in) :: this
        print*,'Line size',this%length,'meter'
    end subroutine print_linesize

    subroutine init_rectangle(this,length1,length2,length3)
        class(rectangle_t), intent(inout) :: this
        real, intent(in) :: length1,length2,length3
        call init_rectangle_2d(this,length1,length2)
    end subroutine init_rectangle
    subroutine init_rectangle_2d(this,length1,length2)
        class(rectangle_t), intent(inout) :: this
        real, intent(in) :: length1,length2
        this%length = length1
        this%width = length2
    end subroutine init_rectangle_2d

    subroutine print_rectanglesize(this)
        class(rectangle_t), intent(in) :: this
        print*,'Rectangle area',this%length*this%width,'meter^2'
    end subroutine print_rectanglesize

        subroutine init_box(this,length1,length2,length3)
        class(box_t), intent(inout) :: this
        real, intent(in) :: length1,length2,length3
        this%length = length1
        this%width = length2
        this%height = length3
    end subroutine init_box

    subroutine print_boxsize(this)
        class(box_t), intent(in) :: this
        print*,'Box volume',this%length*this%width*this%height,'meter^3'
    end subroutine print_boxsize

end module myModule

program main

    use myModule

    implicit none

    class(shape_t), allocatable :: dynamic_typing
    integer :: choice
    
    print *,'choice (1:line, 2:rectangle or 3:box)'
    read(*,'(i1)') choice
    select case (choice)
        case(1)
            allocate(line_t::dynamic_typing)
        case(2)
            allocate(rectangle_t::dynamic_typing)
        case(3)
            allocate(box_t::dynamic_typing)
        case default
            print *,'not permitted'
            stop
    end select
    
    select type (dynamic_typing)
        type is (line_t)
            call dynamic_typing%init(4.0)
            call dynamic_typing%print_size()
        type is (rectangle_t)
            call dynamic_typing%init(4.0,3.0)
            call dynamic_typing%print_size()
        type is (box_t)
            call dynamic_typing%init(4.0,3.0,2.0)
            call dynamic_typing%print_size()
    end select

end program main

But I am not able to avoid the select type part. I would like to avoid it and do the stuff DIRECTLY in the select case part. Something like that :

select case (choice)
    case(1)
        allocate(line_t::dynamic_typing)
        call dynamic_typing%init(4.0)
        call dynamic_typing%print_size()
    case(2)
        allocate(rectangle_t::dynamic_typing)
        call dynamic_typing%init(4.0,3.0)
        call dynamic_typing%print_size()
    case(3)
        allocate(box_t::dynamic_typing)
        call dynamic_typing%init(4.0,3.0,2.0)
        call dynamic_typing%print_size()
    case default
        print *,'not permitted'
        stop
end select

Is it possible or not ?

CodePudding user response：

Not. While you can't reference the type-bound procedures for a polymorphic object where the declared type is abstract, if you know the name of the specific procedure you can call it directly, passing the "this" argument explicitly.

The problem, though, is that the declared type of "this" in each of those procedures is an extension of the abstract type shape_t, and as such you can't pass an argument whose declared type is smaller than the extension. I discuss this in https://stevelionel.com/drfortran/2020/06/30/doctor-fortran-in-not-my-type/

Using select type makes the declared type, within each select block, be the named type and therefore you're allowed to pass it to the procedure.

Your code using select type is straightforward and clean.