유형 바운드 프로 시저의 다형성

Question

두 가지 이상의 유형에 대해 유형 바인드 프로 시저와 동일한 기능을 사용하는 방법이 있습니까? 예 : 다음과 같은 상황을 상상해보십시오 :

module definitions 
implicit none 

type type1 
    integer i 
    contains 
    procedure,pass :: init1 
end type 

type type2 
    integer i 
    contains 
    procedure,pass :: init2 
end type 

contains 

subroutine init1(x) 
    class(type1),intent(inout) :: x 
    x%i=3 
end subroutine 

subroutine init2(x) 
    class(type2),intent(inout) :: x 
    x%i=3 
end subroutine 

end module 

program test 
use definitions 

type(type1) ::a 
type(type2) ::b 

print*, a%i 
print*, b%i 
call a%init1 
print*, a%i 
print*, b%i 
call b%init2 
print*, a%i 
print*, b%i 

end program 

동일한 서브 루틴을 사용했지만 두 번 정의해야합니다. 그래서 저는

class(type1 .or. type2), intent(inout) :: x 

또는 이와 비슷한 것을 요청하고 있습니다. 이미 클래스 (*)를 사용해 보았습니다 만, 컴파일러가 x % i로 무엇을 해야할지 모르기 때문에 작동하지 않습니다. 정의되지 않았을 수도 있고, select 타입 블록과 조합되어 있지 않을 수도 있습니다. 실제 프로그램은 더 복잡하기 때문에 유형 정의의 유사한 부분을 병합 한 다음 두 유형을 정의하기 위해 쉽게 확장 할 수 없습니다. 미리 감사드립니다.

Answer 1

직접적으로 가능하지 않습니다. 그런데 왜 확장 된 기본 유형을 만들지 않습니까?

module definitions 
implicit none 

type base 
    integer i 
contains 
    procedure,pass :: init 
end type 


type, extends(base) :: type1 
end type 

type, extends(base) :: type2 
end type 

contains 

subroutine init(x) 
    class(base),intent(inout) :: x 
    x%i=3 
end subroutine 

end module 

program test 
use definitions 

type(type1) ::a 
type(type2) ::b 

print*, a%i 
print*, b%i 
call a%init 
print*, a%i 
print*, b%i 
call b%init 
print*, a%i 
print*, b%i 

end program 

편집 (오후) : 이것은 내가 실제로 생각했던 문제 해결 :

이

module definitions 
implicit none 

type base 
integer :: i 
contains 
    procedure,pass :: init 
end type 

type, extends(base) :: type1 
integer:: j 
end type 

type, extends(base) :: type2 
integer:: k 
end type 

contains 

subroutine init(x) 
    class(base),intent(inout) :: x 
    integer :: m 
    select type (x) 
    type is (type1) 
    m=x%j 
    type is (type2) 
    m=x%k 
    end select 
    x%i=3*m 
end subroutine 

end module 

program test 
use definitions 

type(type1) ::a 
type(type2) ::b 

a%j=2 
b%k=4 
print*, a%i 
print*, b%i 
call a%init 
print*, a%i 
print*, b%i 
call b%init 
print*, a%i 
print*, b%i 

end program 
                                        1,5   Top