I have a Vector derived type
Type :: Vector
Real (Real32), Allocatable :: r32(:)
Real (Real64), Allocatable :: r64(:)
Real (Real128), Allocatable :: r128(:)
Contains
Procedure :: set => vector_set, &
vector_tutvc, &
vector_vctvc
If I call the subroutine as in (a) I get everything working
correctly, however when using (b) I am getting
Error: Rank mismatch in argument 'u' at (1) (scalar and rank-1)
(a) Call vcr % vector_tutvc (r)
(b) Call vcr % set (r)
Here are more details
Subroutine vector_set (t, u, v, w)
Class (Vector), Intent(InOut) :: t
Class (*), Intent (In) :: u
Class (*), Intent (In), Optional :: v, w
Subroutine vector_tutvc (u, tu)
Class (Vector), Intent(InOut) :: u
Class (*), Intent (In) :: tu(:)
Here is code for test program
Type (Vector) :: vcr
Real (Real32), Allocatable :: r(:)
r = [ &
1.0000000, 0.9999965, 0.9999931, 0.9999896, 0.9999862, &
0.9999829, 0.9999796, 0.9999763, 0.9999731, 0.9999699, &
0.9999668, 0.9999637, 0.9999607 &
]
Call vcr % set (r)
In the type-bound procedure declaration
procedure :: binding => procedure
the type-bound procedure procedure has the binding name binding.
From your mention of overloading and your choice of indentation, it seems like you expect the statement
Procedure :: set => vector_set, &
vector_tutvc, &
vector_vctvc
to be such that the binding name set is generic, referring to each of those procedures. In fact, the statement above is the same as
Procedure :: set => vector_set, &
vector_tutvc => vector_tutvc, &
vector_vctvc => vector_vctvc
To establish overloading, you need to use a generic binding, such as
Procedure :: vector_set, vector_tutvc,vector_vctvc
Generic :: set => vector_set, vector_tutvc, vector_vctvc
module type_Vector
use, intrinsic :: iso_fortran_env, only: &
sp => REAL32, &
dp => REAL64, &
qp => REAL128
! Explicit typing only
implicit none
! Everything is private unless stated otherwise
private
public :: Vector
! Declare derived data type
type, public :: Vector
real (sp), allocatable :: r32(:)
real (dp), allocatable :: r64(:)
real (qp), allocatable :: r128(:)
contains
procedure, private :: vector_set
procedure, private :: vector_tutvc
generic, public :: set => &
vector_set, &
vector_tutvc
end type Vector
contains
subroutine vector_set(this, u, v, w)
class (Vector), intent(in out) :: this
class (*), intent (in) :: u
class (*), optional, intent (in) :: v
class (*), optional, intent (in) :: w
end subroutine vector_set
subroutine vector_tutvc(this, tu)
class (Vector), intent (in out) :: this
class (*), intent (in) :: tu(:)
end subroutine vector_tutvc
end module type_Vector
program main
use, intrinsic :: iso_fortran_env, only: &
sp => REAL32, &
stdout => OUTPUT_UNIT, &
compiler_version, &
compiler_options
use type_Vector, only: &
Vector
! Explicit typing only
implicit none
type (Vector) :: vcr
real (sp), allocatable :: r(:)
r = [ &
1.0000000_sp, 0.9999965_sp, 0.9999931_sp, 0.9999896_sp, 0.9999862_sp, &
0.9999829_sp, 0.9999796_sp, 0.9999763_sp, 0.9999731_sp, 0.9999699_sp, &
0.9999668_sp, 0.9999637_sp, 0.9999607_sp &
]
call vcr%set(r)
write( stdout, '(/4A/)' ) 'This file was compiled by ', &
compiler_version(), ' using the options ', &
compiler_options()
end program main
set is now a generic type-bound procedure.
This file was compiled by GCC version 5.3.1 20160528 using the options -mtune=generic -march=x86-64 -O3 -std=f2008ts
Related
Following a previous question I had (Fortran TYPE inheritance on runtime (declared by user)), I am using a factory method to generate an array of different types. Below is a simplified version of what I'm doing,
module multiarray
use iso_fortran_env, only: real64
implicit none
integer, parameter :: dp = real64
! abstract list type
type, abstract :: list
contains
procedure(in), deferred, pass(self) :: addval ! add a variable
procedure(out), deferred, pass(self) :: getval ! extract variable
end type
abstract interface
subroutine in(self,val)
import :: list
implicit none
class(list), intent(inout) :: self
class(*), intent(in) :: val
end subroutine
subroutine out(self,val)
import :: list
implicit none
class(list), intent(in) :: self
class(*), intent(out) :: val
end subroutine
end interface
! real(dp) element extension
type, extends(list) :: real_num
real(dp) :: var
contains
procedure, pass(self) :: addval => addreal
procedure, pass(self) :: getval => getreal
end type
! similar for character, logical, etc types
...
! wrapper
type wrapper
class(list), ALLOCATABLE :: arg
end type
contains
! real(dp) subroutines
subroutine addreal(self,val)
implicit none
class(real_num), intent(inout) :: self
class(*), intent(in) :: val
select type(val)
type is (real(dp))
self%var = val
end select
end subroutine
subroutine getreal(self,val)
implicit none
class(real_num), intent(in) :: self
class(*), intent(out) :: val
select type(val)
type is (real(dp))
val = self%var
end select
end subroutine
! similar for character, logical, etc types
...
! factory method
function get_list(val) result(pt)
class(*), intent(in) :: val
class(list), allocatable :: pt
select type(val)
type is (real(dp))
allocate(real_num :: pt)
type is (character(*))
...
end select
end function
end module
I use the wrapper type to generate an allocatable array of type list
type(wrapper) :: A(5)
real(dp) :: x
A(1)%arg = get_list(90.d0) ! Set A(1) as type real
call A(1)%arg%addval(90.d0) ! A(1) is a real of value 90
call A(1)%arg%getval(x) ! set x = A(1) to use elsewhere
The variable var is defined as a generic class in the abstract interface, it can be of real, character, logical, etc type. I then use a select type construct to match the addval=>addreal subroutine argument since var is of type class(*) in the abstract interface.
Is there a way to define an interface inside the abstract interface (nested), in a way that I don't need to have the select type in addreal (since I already know it's input needs to be a real type)? Or is there a better way, simpler way, to achieve what I'm trying to do with the variable type array? Thanks!
I think you don't want to have both class(*) inputs and an abstract base class. I think you want to have either one:
a non-polymorphic container class that can contain any (class(*)) element types, for example, a key-value pair in a dictionary;
a polymorphic container class if a limited set of types should later have a shared API.
In your case it seems you want maximum flexibility, I would vote for having a unique container class and making usage of class(*), like in the following example I've just made up:
! FP 2022-07-25
module myList
use iso_fortran_env
implicit none
type, public :: listElement
class(*), allocatable :: x
contains
procedure :: set
procedure :: get_any
procedure :: get_typed
procedure, private :: print
generic :: write(formatted) => print
end type listElement
contains
! Map accepted types
elemental logical function isAccepted(val)
class(*), intent(in) :: val
select type (input=>val)
type is (real(real32)); isAccepted = .true.
type is (character(*)); isAccepted = .true.
class default; isAccepted = .false.
end select
end function isAccepted
! Print value
subroutine print(this, unit, iotype, v_list, iostat, iomsg)
class(listElement), intent(in) :: this
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, intent(in) :: v_list(:)
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
if (.not.allocated(this%x)) then
write(unit,*,iostat=iostat) 'null'
else
select type (myVar => this%x)
type is (real(real32)); write(unit,*,iostat=iostat) myVar
type is (character(*)); write(unit,*,iostat=iostat) myVar
class default; write(unit,*,iostat=iostat) "ERROR"
end select
endif
end subroutine print
subroutine set(this,val)
class(listElement), intent(inout) :: this
class(*), intent(in) :: val
integer :: ierr
deallocate(this%x,stat=ierr) ! force deallocate
allocate(this%x,source=val)
end subroutine set
! Can be anything, but "val" must be declared "class(*), allocatable"
subroutine get_any(this,val)
class(listElement), intent(in) :: this
class(*), intent(out), allocatable :: val
allocate(val,source=this%x)
end subroutine get_any
subroutine get_typed(this,val)
class(listElement), intent(in) :: this
class(*), intent(out) :: val ! has a type that can't change
if (.not.isAccepted(val)) stop ' trying to return value to a class thats not supported '
if (.not.allocated(this%x)) return ! will return garbage
select type (outVal => val)
type is (real(real32));
select type (thisVal => this%x)
type is (real(real32)); outVal = thisVal
type is (real(real64)); outVal = real(thisVal,real32)
class default; stop 'error trying to convert list element to real32'
end select
type is (character(*));
select type (thisVal => this%x)
type is (character(*)); outVal = trim(thisVal)
class default; stop 'error trying to convert list element to character'
end select
class default
stop 'trying to return value to a class thats not accepted '
end select
end subroutine get_typed
end module myList
program tryList
use myList
implicit none
type(listElement) :: A(5)
integer :: i
character(255) myChar
real(real32) :: r32
real(real64) :: r64
call A(1)%set(123.45)
call A(2)%set("hello world!")
call A(3)%set(123.45d0)
do i=1,3
print *, 'A(',i,')=',A(i)
end do
call A(1)%get_typed(r64); print *, 'r64=',r64
call A(1)%get_typed(r32); print *, 'r32=',r32
call A(2)%get_typed(myChar); print *, 'myChar=',myChar
call A(2)%get_typed(r32) ! stop on error
end program
Notice that:
In general, this should work with any variables (class(*)), but if you want to use the fully polymorphic interface, the input variable must be defined as class(*), allocatable anywhere else, so, not exactly handy.
You want to have some helper routines and/or an enumerator type that help you map/handle all types you want to be contained, this example is just a stub.
I have a module which defines a Type, with its methods, plus some other Type-unrelated methods as well.
module TypeDef
type, public :: T
...
contains
...
procedure type_proc
end type
...
contains !module
subroutine type_proc( this, ... )
class(T), target :: this
...
call gen_proc( arg_1, arg_n-1, this, arg_n+1 )
...
end subroutine type_proc
...
subroutine gen_proc( arg_1, ..., arg_n-1, tv, arg_n+1 )
! this is a general module routine.
! NOT type related
implicit none
...
class(T), pointer, intent(in) :: tv
...
if ( cond ) tv%member = 0
...
end subroutine gen_proc
end module
At a given point, I call, from a variable type(T), public :: var its member method type_proc(), which at its interior calls a general module procedure gen_proc(). In there, for some conditions, I may need to change some member(s) of the ACTUAL object calling the method's tree (i.e. var). To do so, I pass this as a constant pointer to call gen_proc() to have its address passed at the function call, and access its members.
But, I get the error as described.
Same if I pass it by reference and not as a const pointer.
I cannot see if I do something mistakenly. Here Intel Fortran error #6633: The type of the actual argument differs from the type of the dummy argument there's something similar, but there, the call happens in a different program unit.
EDIT 2:
Ok, this compiled and run as expected..
module test
type, public :: T
real, allocatable :: m1(:)
real, allocatable :: m2(:)
integer :: may_change
contains
procedure :: t_proc
procedure :: all_t
end type
private :: all_t
contains
subroutine t_proc( this, n )
implicit none
class(T), target :: this
integer, intent(in) :: n
call this%all_t( n )
call gen_proc( n, this%m1, this%m2, this )
end subroutine t_proc
subroutine all_t( this, n )
implicit none
class(T) :: this
integer, intent(in) :: n
allocate( this%m1( n ) )
allocate( this%m2( n ) )
end subroutine
subroutine gen_proc( n, m1, m2, Tt )
implicit none
integer, intent(in) :: n
real, intent(in) :: m1(n), m2(n)
class(T), intent(in), pointer :: Tt
if ( .true. ) Tt%may_change = 1
print *, ' may change = ', Tt%may_change
end subroutine gen_proc
end module test
module varmod
use test
type(T), public :: var
end module varmod
program main
use varmod, only: var
implicit none
integer, parameter :: n = 2
var%may_change = 0
call var%t_proc( n )
end program main
So, even more than before, I don't know what could be wrong on the actual code...
I have a little problem i cant find the solution to, but i'm sure there is one.
I define a type in a module, and want to use that type as an argument to a constructor in another module. Something like this:
First File:
module Simulation_mod
use SolverParameters_mod
type, public :: Simulation_class
type(SolverParameters_class), public :: SolverParameters
end type
type(Simulation_class), public :: Simulation
end module
Second file:
module SolverParameters_mod
implicit none
type, public :: SolverParameters_class
private
real :: MaxRelError
integer :: MaxNumberIter
integer :: NumericalDamping
real, dimension(:), allocatable :: InitialValue
end type SolverParameters_class
end module
Third file:
module Solver_mod
use Simulation_mod
type, public :: Solver_class
private
real :: MaxRelError
integer :: MaxNumberIter
integer :: NumericalDamping
real, dimension(:), allocatable :: InitialValue
end type Solver_class
interface Solver_class
module procedure InitSolver
end interface Solver_class
contains
subroutine InitSolver(VarSolverParameters)
! Declaring part
type(Solver_class) :: Solver
class(SolverParameters), intent(in) :: VarSolverParameters
! Executing part
Solver%MaxRelError = VarSolverParameters%GetMaxRelError
Solver%MaxNumberIter = VarSolverParameters%GetMaxNumberIter
Solver%NumericalDamping = VarSolverParameters%GetNumericalDamping
Solver%InitialValue = VarSolverParameters%GetInitialValue
end subroutine InitSolver
end module Solver_mod
The Getter functions are defined properly. When trying to compile, i get error #6457: This derived type name has not been declared. [SOLVERPARAMETERS]
class(SolverParameters), intent(in) :: VarSolverParameters
--------------^
How do i achieve to pass the object SolverParameters to the constructor InitSolver of type Solver_class?
I'm binding Fortran code with a C dll, and I would like to have a Fortran array inter-operable with C. I currently have the following subroutine to bind the Fortran array with a C double*:
SUBROUTINE Pack_Inputs( Input , In_X )
TYPE( InputType ) , INTENT(INOUT) :: Input
REAL(KIND=C_DOUBLE) , ALLOCATABLE , TARGET , INTENT(INOUT) :: In_X(:)
IF ( .NOT. ALLOCATED(In_X) ) ALLOCATE( In_X (Input%Xlen) )
DO i = 1,Input%C_obj%Xlen
In_X(i) = Input%X(i)
END DO
Input%C_obj%X = C_LOC(In_X)
END SUBROUTINE Pack_Inputs
However, what I don't like about the current code is that I am constantly allocating memory, and having to unpack the array when the C dll is entered (partly driven by my reluctance to use the SAVE attribute on In_X(:)). I would rather much declare In_X once, inside a Fortran derived type. This leads to the motivation for this post. In this derived type:
USE , INSTRINSIC :: ISO_C_BINDING
TYPE , PUBLIC :: InputType
TYPE(InputType_C) :: C_obj
REAL(KIND=C_DOUBLE) , ALLOCATABLE , TARGET :: In_X(:)
REAL , DIMENSION(:) , ALLOCATABLE :: X
REAL , DIMENSION(:) , ALLOCATABLE :: Y
REAL , DIMENSION(:) , ALLOCATABLE :: Z
INTEGER , DIMENSION(:) , ALLOCATABLE :: index
INTEGER :: Xlen
INTEGER :: Ylen
INTEGER :: Zlen
INTEGER :: indexlen
END TYPE InputType
I get the error:
REAL(KIND=C_DOUBLE) , ALLOCATABLE , TARGET :: In_X(:)
1
Error: Attribute at (1) is not allowed in a TYPE definition
Is there a way to eliminate this error?
I have encountered this problem before, and the solution that worked for me was to to declare the component as POINTER instead of ALLOCATABLE, TARGET. I am not sure whether the Fortran standard does not support it, or this feature is just not implemented by the compilers. I was using ifort v12.0.2.137.
Would this be an acceptable solution for you? You would then be able to use it as pointer target.
TYPE , PUBLIC :: InputType
TYPE(InputType_C) :: C_obj
REAL(KIND=C_DOUBLE),DIMENSION(:),POINTER :: In_X => NULL()
REAL , DIMENSION(:) , ALLOCATABLE :: X
REAL , DIMENSION(:) , ALLOCATABLE :: Y
REAL , DIMENSION(:) , ALLOCATABLE :: Z
INTEGER , DIMENSION(:) , ALLOCATABLE :: index
INTEGER :: Xlen
INTEGER :: Ylen
INTEGER :: Zlen
INTEGER :: indexlen
END TYPE InputType
Then, you can associate the In_X pointer with target data:
In_X(1:Input%C_obj%Xlen) => Input%X(1:Input%C_obj%Xlen)
Note that Input%X will need to have a TARGET attribute as well.
In Fortran, you can pass a function/subroutine A as an argument to another function/subroutine B, but can you store A for later retrieval and use?
for example, this is allowed in C
int foo(float, char, char) { /*whatever*/};
int (*pointerToFunction)(float, char, char);
pointerToFunction = foo;
In Fortran you can pass a subroutine as an argument
subroutine foo
! whatever
end subroutine foo
subroutine bar(func)
call func
end subroutine bar
program x
call bar(foo)
end program
but how can you store the address of foo in a similar way to C ?
Starting from so-called "Fortran 2003" (ISO/IEC 1539-2004) procedure pointers is a part of the Fortran language. It's definitely of the major new features of Fortran language.
Usage example from Fortran Wiki.
Stefano, you mentioned strategy design pattern. In Fortran 2003 you can use pure OOP way to implement it (without procedure pointers). Offhand example:
strategies.f90
module strategies
implicit none
private
public :: strategies_transportation_strategy, &
strategies_by_taxi_strategy, &
strategies_by_bus_strategy
type, abstract :: strategies_transportation_strategy
contains
procedure(transportation_strategy_go), deferred :: go
end type strategies_transportation_strategy
type, extends(strategies_transportation_strategy) :: strategies_by_taxi_strategy
contains
procedure :: go => strategies_by_taxi_strategy_go
end type strategies_by_taxi_strategy
type, extends(strategies_transportation_strategy) :: strategies_by_bus_strategy
contains
procedure :: go => strategies_by_bus_strategy_go
end type strategies_by_bus_strategy
abstract interface
subroutine transportation_strategy_go(this)
import strategies_transportation_strategy
class(strategies_transportation_strategy), intent(in) :: this
end subroutine transportation_strategy_go
end interface
contains
subroutine strategies_by_taxi_strategy_go(this)
class(strategies_by_taxi_strategy), intent(in) :: this
print *, "We are using taxi."
end subroutine strategies_by_taxi_strategy_go
subroutine strategies_by_bus_strategy_go(this)
class(strategies_by_bus_strategy), intent(in) :: this
print *, "We are using public transport."
end subroutine strategies_by_bus_strategy_go
end module strategies
vehicles.f90
module vehicles
use strategies
implicit none
private
public :: vehicles_vehicle, &
vehicles_taxi, &
vehicles_bus
type, abstract :: vehicles_vehicle
private
class(strategies_transportation_strategy), allocatable :: transportation_strategy
contains
procedure :: set_transportation_strategy => vehicle_set_transportation_strategy
procedure :: go => vehicle_go
end type vehicles_vehicle
type, extends(vehicles_vehicle) :: vehicles_taxi
contains
procedure :: init => taxi_init
end type vehicles_taxi
type, extends(vehicles_vehicle) :: vehicles_bus
contains
procedure :: init => bus_init
end type vehicles_bus
contains
subroutine vehicle_go(this)
class(vehicles_vehicle), intent(in) :: this
call this%transportation_strategy%go()
end subroutine vehicle_go
subroutine vehicle_set_transportation_strategy(this, new_transportation_strategy)
class(vehicles_vehicle), intent(inout) :: this
class(strategies_transportation_strategy), intent(in) :: new_transportation_strategy
if (allocated(this%transportation_strategy)) then
deallocate (this%transportation_strategy)
end if
allocate (this%transportation_strategy, source=new_transportation_strategy)
end subroutine vehicle_set_transportation_strategy
subroutine taxi_init(this)
class(vehicles_taxi), intent(out) :: this
type(strategies_by_taxi_strategy) :: by_taxi_strategy
call this%set_transportation_strategy(by_taxi_strategy)
end subroutine taxi_init
subroutine bus_init(this)
class(vehicles_bus), intent(out) :: this
type(strategies_by_bus_strategy) :: by_bus_strategy
call this%set_transportation_strategy(by_bus_strategy)
end subroutine bus_init
end module vehicles
main.f90
program main
use vehicles
implicit none
type(vehicles_taxi) :: taxi
type(vehicles_bus) :: bus
call taxi%init()
call bus%init()
call taxi%go()
call bus%go()
end program main
At least works using gfortran 4.6 (20100925).
The following codes demonstrate how to use procedure pointers:
module my_mod
implicit none
contains
subroutine sub1()
write(*,*) 'the first suboutine is being used'
end subroutine sub1
subroutine sub2()
write(*,*) 'the second subroutine is being used'
end subroutine sub2
end module my_mod
program procTest
use my_mod
implicit none
integer :: n
procedure(sub1), pointer:: funPointer => NULL()
write(*,'(A)') "Please enter your option"
read(*,*) n
select case( n )
case( 1 )
funPointer => sub1
case( 2 )
funPointer => sub2
case DEFAULT
funPointer => sub1
end select
call funPointer()
end program procTest