If we have three different Files with different Derived types,
MyTypeMod.f90:
MODULE MyTypeMod
TYPE, ABSTRACT :: MyType
INTEGER :: Num
END TYPE MyType
CONTAINS
END MODULE MyTypeMod
MyType1Mod.f90
MODULE MyType1Mod
USE MyTypeMod, ONLY : MyType
USE MyType2Mod, ONLY : MyType2
IMPLICIT NONE
TYPE, EXTENDS(MyType) :: MyType1
CONTAINS
PROCEDURE :: Type1EqualsType2
GENERIC :: ASSIGNMENT(=) => Type1EqualsType2
END TYPE MyType1
CONTAINS
SUBROUTINE Type1EqualsType2(Type1, Type2)
TYPE(MyType1), INTENT(OUT) :: Type1
TYPE(MyType2), INTENT(IN) :: Type2
Type1%Num = Type2%Num
END SUBROUTINE Type1EqualsType2
END MODULE MyType1Mod
MyType2Mod.f90
MODULE MyType1Mod
USE MyTypeMod, ONLY : MyType
USE MyType1Mod, ONLY : MyType1
IMPLICIT NONE
TYPE, EXTENDS(MyType) :: MyType2
CONTAINS
PROCEDURE :: Type2EqualsType1
GENERIC :: ASSIGNMENT(=) => Type2EqualsType1
END TYPE MyType2
CONTAINS
SUBROUTINE Type2EqualsType1(Type2, Type1)
TYPE(MyType2), INTENT(OUT) :: Type2
TYPE(MyType1), INTENT(IN) :: Type1
Type2%Num = Type1%Num
END SUBROUTINE Type2EqualsType1
END MODULE MyType2Mod
Here, In this case I couldn't able to compile the Program due to Module files Interdependent on each other. Can I use SubModules to solve the problem?
Unfortunately no, you can't do quite what you want using submodules. This is because both functions Type1EqualsType2
and Type2EqualsType1
require both MyType1
and MyType2
in their function interfaces. Even if you use submodules, both functions will have to have interfaces in their respective modules, and so the circular dependency will remain.
However, there are a couple of possible workarounds:
You can have the intent(in)
arguments of both functions be class(MyType)
, and only do type resolution using a select type
statement. This will allow you to move the function definitions to submodules and resolve the circular dependency, but will also mean that you have to handle cases where a different type which extends MyType
is passed to the function. Also, select type
can be a little slow, depending on your use case.
Code for this would look something like:
MODULE MyTypeMod
IMPLICIT NONE
TYPE, ABSTRACT :: MyType
INTEGER :: Num
END TYPE MyType
END MODULE MyTypeMod
MODULE MyType1Mod
USE MyTypeMod, ONLY : MyType
IMPLICIT NONE
TYPE, EXTENDS(MyType) :: MyType1
CONTAINS
PROCEDURE :: Type1EqualsType2
GENERIC :: ASSIGNMENT(=) => Type1EqualsType2
END TYPE
interface
module SUBROUTINE Type1EqualsType2(this, input)
TYPE(MyType1), INTENT(OUT) :: this
class(MyType), INTENT(IN) :: input
END SUBROUTINE
end interface
END MODULE
MODULE MyType2Mod
USE MyTypeMod, ONLY : MyType
IMPLICIT NONE
TYPE, EXTENDS(MyType) :: MyType2
CONTAINS
PROCEDURE :: Type2EqualsType1
GENERIC :: ASSIGNMENT(=) => Type2EqualsType1
END TYPE
interface
module SUBROUTINE Type2EqualsType1(this, input)
TYPE(MyType2), INTENT(OUT) :: this
class(MyType), INTENT(IN) :: input
END SUBROUTINE
end interface
END MODULE
submodule (MyType1Mod) MyType1Submod
use MyType2Mod, only : MyType2
implicit none
contains
module procedure MyType1EqualsMyType2
select type(input); type is(MyType1)
this%Num = input%Num
type is(MyType2)
this%Num = input%Num
class default
! Some kind of error handling goes here.
end select
end procedure
end submodule
submodule (MyType2Mod) MyType2Submod
use MyType1Mod, only : MyType1
implicit none
contains
module procedure MyType2EqualsMyType1
select type(input); type is(MyType1)
this%Num = input%Num
type is(MyType2)
this%Num = input%Num
class default
! Some kind of error handling goes here.
end select
end procedure
end submodule
You can instead replace the type-bound assignment(=)
definitions with generic assignment(=)
definitions. This avoids the runtime polymorphism, but means you have to define the assignments in a new module.
This would look something like:
MODULE MyTypeMod
IMPLICIT NONE
TYPE, ABSTRACT :: MyType
INTEGER :: Num
END TYPE MyType
END MODULE MyTypeMod
MODULE MyType1Mod
USE MyTypeMod, ONLY : MyType
IMPLICIT NONE
TYPE, EXTENDS(MyType) :: MyType1
END TYPE
END MODULE
MODULE MyType2Mod
USE MyTypeMod, ONLY : MyType
IMPLICIT NONE
TYPE, EXTENDS(MyType) :: MyType2
END TYPE
END MODULE
module MyEqualsMod
use MyType1Mod : only MyType1
use MyType2Mod : only MyType2
implicit none
interface assignment(=)
module procedure MyType1EqualsMyType2
module procedure MyType2EqualsMyType1
end interface
contains
subroutine MyType1EqualsMyType2(this,input)
type(MyType1), intent(out) :: this
type(MyType2), intent(in) :: input
this%Num = input%Num
end subroutine
subroutine MyType2EqualsMyType1(this,input)
type(MyType2), intent(out) :: this
type(MyType1), intent(in) :: input
this%Num = input%Num
end subroutine
end module