I have two routines one calling the other that selects according to type.
matc_a calls takano. When I call takano from matc_a, would I need
so wrap the call to takano within Select Type or can I just call is
as follows
Case ("takano")
Call takano (a)
There are the two routines
Subroutine takano &
( &
a &
)
Class (*), Intent (out) :: a
Select Type (a)
Type Is (Real (Real32))
a = atan ( Real(1,Real32) / Real(49,Real32) )
Type Is (Real (Real64))
a = atan ( Real(1,Real64) / Real(49,Real64) )
Type Is (Real (Real128))
a = atan ( Real(1,Real128) / Real(49,Real128) )
End Select
End Subroutine takano
Subroutine matc_a &
( &
a, strategy &
)
Class (*), Intent (out) :: a
Character (len=*) :: strategy
Select Case (Trim (strategy))
Case ("takano")
Select Type (a)
Type Is (Real (Real32))
Call takano (a)
Type Is (Real (Real64))
Call takano (a)
Type Is (Real (Real128))
Call takano (a)
End Select
End Select
End Subroutine matc_a
Yes, you can just use the shorter version and avoid the first type selection.
It doesn't matter whether you use one inside takano or not. The important thing is that it accepts a polymorphic dummy argument.
BTW, it seems to me you are emulating a dynamic typed language in Fortran. I am not sure, whether that is wise.
Related
I have a program dealing with calculations for an engine. There are multiple limiters that need to be considered (pressure ratio, temperature, ect.). These are organized from users perspective in groups, with some parameters common to all groups and some not.
Because during the run time I need to work with these limiters depending on the requirements, potentially changing them during various calculation steps it would make sense to organize these in an array of polymorphic elements, depending on what each limiter group needs. In principle it works, but not quite how I want to.
I wrote a small program to test different method shown below:
Here is the module with derived types etc.
module ArrayTest
interface init_limiter
module procedure :: initGroup1, initGroup2
end interface
type :: base
contains
procedure, pass :: setup => idontwanttodothis
procedure, pass :: print_param
end type base
type, extends(base) :: Group1
real :: p1
contains
procedure, pass :: init => initGroup1
procedure, pass :: print_param => printGroup1
end type Group1
type, extends(base) :: Group2
integer :: p1
real :: rDummy
contains
procedure, pass :: init => initGroup2
procedure, pass :: print_param => printGroup2
end type Group2
type ArrElem
integer :: a, b, c
class(base), allocatable :: param
end type ArrElem
type(ArrElem), dimension(5) :: T1, T2
contains
subroutine idontwanttodothis(self, iDummy, rDummy)
class(base) :: self
integer, optional :: iDummy
real, optional :: rDummy
select type (self)
type is(group1); call self.init(rDummy)
type is(group2); call self.init(iDummy,rDummy)
end select
end subroutine idontwanttodothis
subroutine print_param(self)
class(base) :: self
select type(self)
type is(group1); call self.print_param()
type is(group2); call self.print_param()
class default; write(*,'(A)') 'Type:: Unknown'
end select
end subroutine print_param
pure subroutine initGroup1(self, x)
class(Group1), intent(inout) :: self
real, intent(in) :: x
self.p1 = x
end subroutine initGroup1
pure subroutine initGroup2(self, x, y)
class(Group2), intent(inout) :: self
integer, intent(in) :: x
real, intent(in) :: y
self.p1 = x
self.rDummy = y
end subroutine initGroup2
subroutine printGroup1(self)
class(Group1) :: self
write(*,'(A,F5.2)') 'Type:: Group1 ',self.p1
end subroutine printGroup1
subroutine printGroup2(self)
class(Group2) :: self
write(*,'(A,I2,F5.2)') 'Type:: Group2 ',self.p1, self.rDummy
end subroutine printGroup2
end module ArrayTest
And here is the main program:
program TestAlloc
use ArrayTest
call main()
contains
subroutine main
integer i
type(group1) :: g1Dummy
!Option 1
g1Dummy.p1 = 29
allocate(T1(1).param, source = g1Dummy)
!Option 2
allocate(Group2::T1(2).param)
select type(dummy => T1(2).param)
type is(Group2); call dummy.init(12,8.7)
end select
!Option 3
allocate(Group2::T1(3).param)
call T1(3).param.setup(3, 4.5)
!Option 4
allocate(Group1::T1(4).param)
call init_limiter(T1(4).param, 8.) !this does not work
call init_limiter(g1Dummy, 8.) !this works
T2 = T1
do i=1,5
if(allocated(T2(i).param)) call T2(i).param.print_param()
end do
return
end subroutine main
end program TestAlloc
Options 1, 2 and 3 work. Option 4 doesn't. Is there any way to make this work? i.e. overload a function call for an allocatable parameter?
p.s. Overriding inherited function through child will work, but that will require both parent and children to have the same interface, which I find inconvenient, might as well use option 3 then.
To my knowledge, there is no way to make this work.
As far as the compiler is concerned, at compile time T1(4).param is of class(base), and it only becomes type(Group1) at runtime. Since you have not defined init_limiter for class(base), only for class(Group1) and class(Group2), the compiler has no appropriate init_limiter function to call.
Your init_limiter functions are not polymorphic, they simply share an interface, so the compiler has no way of treating them the same at compile time and calling the correct one at runtime using polymorphism.
p.s. Overriding inherited function through child will work, but that will require both parent and children to have the same interface, which I find inconvenient, might as well use option 3 then.
This is essentially the crux of your problem. You want to call a function with a different number of arguments depending on the runtime type of an object. Fortran is not set up to handle this case; the number and type of function arguments must be known at compile time.
One potential workaround, which you might or might not consider an improvement, is to use the select type construct. This allows you to turn runtime information (the type of T1(4).param) into compile time information (the signature of the function to call). This would look something like
allocate(Group1::T1(4).param)
select type(foo => T1(4).param); type is(Group1)
call init_limiter(foo, 8.)
end select
Is there a way to conditionally set a public data structure?
For example:
MODULE EXAMPLE
USE DATA_TYPE_Define, ONLY: DATA_TYPE_A, DATA_TYPE_B
USE PARAMETER, ONLY: CaseAisTrue
! Disable all implicit typing
IMPLICIT NONE
! ------------
! Visibilities
! ------------
! Everything private by default
PRIVATE
! The shared data
PUBLIC :: DATA
! ------------------------------------------------
! The shared data
! ------------------------------------------------
IF (CaseAisTrue) Then
TYPE(DATA_TYPE_A), SAVE :: DATA
ELSE
TYPE(DATA_TYPE_B), SAVE :: DATA
END IF
CONTAINS
...
Where DATA_TYPE_A and DATA_TYPE_B are two different data structures/derived types.
Is there any good way to set this up besides introducing more public variables?
Thank you!
I see two options.
Can this change at runtime? Then, the only reason you may need to access the same DATA anywhere else in the code later is because DATA_TYPE_A and DATA_TYPE_B have essentially the same API. This is a typical example object-oriented programming pattern: you want the two data types share the same API:
! The base class
type, abstract, public :: DATA_TYPE
end type DATA_TYPE
type, public, extends(DATA_TYPE) :: DATA_TYPE_A
[...]
end type DATA_TYPE_A
type, public, extends(DATA_TYPE) :: DATA_TYPE_B
[...]
end type DATA_TYPE_B
If you need to keep switching between the data types you're accessing, you can have two separate variables for them:
! Actual shared data, here or elsewhere
type(DATA_TYPE_A), target, SAVE :: DATA_A
type(DATA_TYPE_B), target, SAVE :: DATA_B
And point to them using a pointer:
class(DATA_TYPE), public, pointer :: DATA => null()
! Set pointer
subroutine set_data(mode)
integer, intent(in) :: mode
select case (mode)
case (1); DATA => DATA_A
case (2); DATA => DATA_B
case default; nullify(DATA)
end select
end subroutine set_data
Otherwise, if you don't change it that often, you could just use polymorphic allocation, that would be more elegant:
! Actual shared data
class(DATA_TYPE), allocatable :: DATA
And allocate the right type whenever needed:
! Polymorphic allocation
subroutine set_data(mode)
integer, intent(in) :: mode
integer :: ierr
! Deallocate first
deallocate(DATA,stat=ierr) ! don't stop if not already allocated
select case (mode)
case (1); allocate(DATA,source=DATA_A)
case (2); allocate(DATA,source=DATA_B)
case default; return
end select
end subroutine set_data
Should this be fixed (parameterized) at compile time? Then, a compiler pre-processor will be most useful. For example, with the C pre-processor, you'd have:
#define DATATYPE_IS_A
#ifdef DATATYPE_IS_A
type(DATA_TYPE_A), parameter :: DATA = [...]
#else
type(DATA_TYPE_B), parameter :: DATA = [...]
#endif
This latter option is performed before compilation, i.e., that datatype is enforced and can never be changed.
Is there possibility to use indexing directly on a function's return value? Something like this:
readStr()(2:5)
where readStr() is a function which returns a character string or an array. In many other languages it is quite possible, but what about Fortran? The syntax in my example of course does not compile. Is there any other syntax to be used?
No, that is not possible in Fortran. You could, however, alter your function to take an additional index array that determines which elements are returned. This example illustrates this possibility using an interface to allow for an optional specification of the indices (simplified greatly thanks to the comment by IanH):
module test_mod
implicit none
contains
function squareOpt( arr, idx ) result(res)
real, intent(in) :: arr(:)
integer, intent(in), optional :: idx(:)
real,allocatable :: res( : )
real :: res_( size(arr) )
integer :: stat
! Calculate as before
res_ = arr*arr
if ( present(idx) ) then
! Take the sub-set
allocate( res(size(idx)), stat=stat )
if ( stat /= 0 ) stop 'Cannot allocate memory!'
res = res_(idx)
else
! Take the the whole array
allocate( res(size(arr)), stat=stat )
if ( stat /= 0 ) stop 'Cannot allocate memory!'
res = res_
endif
end function
end module
program test
use test_mod
implicit none
real :: arr(4)
integer :: idx(2)
arr = [ 1., 2., 3., 4. ]
idx = [ 2, 3]
print *, 'w/o indices',squareOpt(arr)
print *, 'w/ indices',squareOpt(arr, idx)
end program
No.
But if it bothers you, you can write your own user defined functions and operators to achieve a similar outcome without having to store the result of the function reference in a separate variable.
You can avoid declaring another variable if you use associate. Whether it is any better or clearer than a temporary variable must be decided by the user. The result has to be stored somewhere anyway.
associate(str=>readStr())
print *, str(2:5)
end associate
It will not be very useful for this specific case with a potentially long string but might be more useful for other similar cases that get linked here as duplicates.
I am having trouble in implementing an approach to call Newton's method in a Fortran program.
So I want to use Newton's method to solve an equation following the link
However, my program is slightly different with the example above. In my case, the equation requires some additional information which are produced during runtime.
subroutine solve(f, fp, x0, x, iters, debug)
which means the f is calculated not only based on x, but also a few other variables (but x is the unknown).
I have a solution, which only works for a simple case:
I used a module to include Newton's solver. I also defined a derived data type to hold all the arguments inside the module. It works good now.
My question is: I need to call the Newton's method many times, and each time the arguments are different. How should I design the structure of the modules? Or should I use a different solution?
I provided a simple example below:
module solver
type argu
integer :: m
end type argu
type(argu):: aArgu_test !should I put here?
contains
subroutine solve(f, fp, x0, x, iters, debug)
...
!m is used inside here
end subroutine solve
subroutine set_parameter(m_in)
aArgu%m = m_in
end subroutine set_parameter()
end module solver
And the calling module is:
!only one set of argument, but used many times
module A
use module solver
do i = 1, 4, 1
set_parameter(i)
!call Newtow method
...
enddo
end module A
!can I use an array for argu type if possible?
module B
use module solver
type(argu), dimension(:), allocable :: aArgu ! or should I put here or inside solver module?
end module B
My understanding is that if I put the argu object inside the solver module, then all solver calling will use the same arguments (I can still save all of them inside module A using the above method). In that case, I have to update the arguments during each for loop?
Because the program runs using MPI/OpenMP, I want to make sure there is no overwritten among threads.
Thank you.
There is a common pattern in modern Fortran for the problem you are facing (partial function application). Unlike other languages, Fortran doesn't have function closures, so making a lexical scope for a function is a little "convoluted" and kind of limited.
You should really consider revisiting all the links #VladmirF shared on the comment, most of them apply straightforwardly to your case. I will give you an example of a solution.
This is a solution without using a wrapper type. I will use a feature included in Fortran 2008 standard: passing an internal procedure as an argument. It is compatible with the latest gfortran, Intel and many others.
If you can't access a compiler with this feature or if you prefer a solution with a derived type, you can refer to this answer.
module without_custom_type
use, intrinsic :: iso_fortran_env, only: r8 => real64
use :: solver
contains
subroutine solve_quad(a, b, c, x0, x, iters, debug)
integer, intent(in) :: a, b, c
real(r8), intent(in) :: x0
real(r8), intent(out) :: x
integer, intent(out) :: iters
logical, intent(in) :: debug
call solve(f, fp, x0, x, iters, debug)
contains
real(r8) function f(x)
real(r8),intent(in) :: x
f = a * x * x + b * x + c
end
real(r8) function fp(x)
real(r8),intent(in) :: x
fp = 2 * a * x + b
end
end
end
The rationale of this code is: as f and fp lay inside of the solve_quad procedure, they have access to the arguments a, b and c by host association, without touching those function's signatures. The resulting effect is like changing the arity of the function.
Testing it with gfortran 8.0 and the solver implementation from the link you shared, I got this:
program test
use, intrinsic :: iso_fortran_env, only: r8 => real64
use :: without_custom_type
implicit none
real(r8) :: x, x0
integer :: iters
integer :: a = 1, b = -5, c = 4
x0 = 0
call solve_quad(a, b, c, x0, x, iters, .false.)
print *, x, iters
! output: 1.0000000000000000, 5
x0 = 7
call solve_quad(a, b, c, x0, x, iters, .false.)
print *, x, iters
! output: 4.0000000000000000, 6
end
After discussing with a colleague, I have a solution to my question 2.
If we have only one argument object for the solver module, then all the calling will access the same arguments because they share the same memory space.
To avoid this, we want to pass the argument object as an argument into the solver.
So instead of using the default solver subroutine, we will re-write the Newton's method so it can accept additional argument.
(I used the simplest Newton subroutine earlier because I wanted to keep it untouched.)
In this way, we will define an array of argument objects and pass them during runtime.
Thank you for the comments.
I have a subroutine (minimal example)
subroutine treatfunction(f,input,output)
external, real::f
real, intent(in):: input
real, intent(out):: output
output = f(input) + f(1.0) ! i.e. f has only one argument
end subroutine
and a function with two arguments
real function fun(x,a)
real,intent(in)::x,a
Now for a given a fixed at runtime, I want to pass fun to treatfunction. So ideally, I would want to call something like
call treatfunction(fun(:,a=a0), input=myinput, output=myoutput)
What is the most elegant way of doing this with the Fortran2003 features gfortran-5 supports?
Of course, I could insert an optional dummy argument a in treatfunction and call f either with f(x) or f(x,a) depending on present(a) in the subroutine's body. But changing the subroutine is not elegant.
In Fortran 2008 you can pass internal functions as arguments and gfortran supports it.
subroutine calling()
a0 = ...
call treatfunction(wrapper, input=myinput, output=myoutput)
contains
real function wrapper(x)
real, intent(in) :: x
wrapper = fun(x,a0)
end function
end subroutine
BTW, I would stay away from external it is evil, use interface blocks.