I am a bit confused as I am running my code to do scalar-vector multiplication using u = v * scalar and v = scalar * u
I thought the following code would give me ambiguous declaration for
the generic '*'. How are the functions vsm_real32, vsm_real64, and
vsm_real128 not conflicting with function svm?
Procedure :: vsm_real32, vsm_real64, &
vsm_real128
Procedure, Pass (tb) :: svm
Generic :: Operator (*) => vsm_real32, &
vsm_real64, vsm_real128, &
svm
Contains
Function vsm_real32 (tb, sc_real32) Result (ta)
Type (Vector) :: ta
Class (Vector), Intent (In) :: tb
Real (Real32), Intent (In) :: sc_real32
Call vsmd (ta, tb, sc_real32, "*")
End Function vsm_real32
Function vsm_real64 (tb, sc_real64) Result (ta)
Type (Vector) :: ta
Class (Vector), Intent (In) :: tb
Real (Real64), Intent (In) :: sc_real64
Call vsmd (ta, tb, sc_real64, "*")
End Function vsm_real64
Function vsm_real128 (tb, sc_real128) Result (ta)
Type (Vector) :: ta
Class (Vector), Intent (In) :: tb
Real (Real128), Intent (In) :: sc_real128
Call vsmd (ta, tb, sc_real128, "*")
End Function vsm_real128
Function svm (sc, tb) Result (ta)
Type (Vector) :: ta
Class (*), Intent (In) :: sc
Class (Vector), Intent (In) :: tb
Call vsmd (ta, tb, sc, "*")
End Function svm
The generic binding is for an operator. The requirement for procedures to be distinguishable is based on the position of the dummy arguments only.
(For the expression a * b, the first dummy argument always corresponds to a, the second to b. Passed arguments don't influence disambiguation in this case.)
The vsm_* functions all have a required second dummy argument that varies in real kind from function to function. That second argument is therefore distinguishable, therefore the vsm_* functions are all distinguishable.
The second argument of svm function is of type Vector. This is a different type to the type of the second argument of the vsm_* functions (REAL), therefore the second argument is distinguishable, therefore the svm function is distinguishable from all of the vsm_* functions.
Refer F2008 C1212.
Related
How can I get a unique name of a variable type in Fortran? An ideal case is shown below:
for the case
real::a
type(some)::x
I want to implement some function f(x) so that
f(a) = "real"
f(x) = "some"
The return value of f need not be a string, other cases, a unique integer for instance, is OK. Is such a built-in function exist?
No, such capability does not exist in Fortran. Some programming languages do have this (e.g. C++, it has almost anything someone can invent and some more https://en.cppreference.com/w/cpp/types/type_info/name but do note the disclaimers about uniqueness and mangling).
You can make a generic function for some limited set of types yourself
interface type_name
procedure type_name_real
procedure type_name_some
end interface
function type_name_real(o) result(res)
character(:), allocatable :: res
real, intent(in) :: o
res = "real"
end function
function type_name_some(o) result(res)
character(:), allocatable :: res
type(some), intent(in) :: o
res = "some"
end function
This obviously concerns the declared type and non-polymorphic entities. But your question did not show any polymorphism.
in the code below, I am using derived type functions to be able to have a common api for generating new derived types from current objects. I realize that the compiler can't get type information from allocate statements as the object could also be deallocated and reallocated as something else, but I am curious if there is a cleaner way to work with the allocated object as the proper derived type other than a select type statement. Something about it just feels funny since within the function I absolutely know what its type is even if the compiler doesn't
module poly
implicit none
type, abstract :: parent
contains
procedure(i_new_child), deferred, pass(this) :: new_child
end type parent
interface
function i_new_child(this) result(child)
import
class(parent), intent(in) :: this
class(parent), allocatable :: child
end function i_new_child
end interface
type, extends(parent) :: child1
integer :: a
contains
procedure, pass(this) :: new_child => new_child1
end type child1
contains
function new_child1(this) result(child)
class(child1), intent(in) :: this
class(parent), allocatable :: child
allocate(child1 :: child)
! child%a = 1 ! 'a' at (1) is not a member of the 'parent' structure
select type (child)
class is (child1)
child%a = 1
end select
end function new_child1
end module poly
In cases where "complicated" construction is required, allocate a variable of the concrete type and then MOVE_ALLOC that variable across to the result.
function new_child1(this) result(child)
class(child1), intent(in) :: this
class(parent), allocatable :: child
type(child1), allocatable :: tmp
allocate(tmp)
tmp%a = 1
! Real world complex construction goes here.
! Once construction of tmp is complete:
call move_alloc(tmp, child)
end function new_child1
For trivial/simple construction, use the structure constructor in combination with automatic allocation on assignment to a polymorphic variable.
function new_child1(this) result(child)
class(child1), intent(in) :: this
class(parent), allocatable :: child
child = child1(a=1)
end function new_child1
I would like to know how to create a function that either returns a real, an integer or a string.
For example, the call would be write(*,*)dt%get() where get() would return :
an integer if dt%isInteger = .true.
a real if dt%isReal = .true.
a character if dt%isStr = .true.
I believe this might be possible by using an abstract interface to make procedure get() point to either procedure getInteger(), getReal() or getStr() but the abstract interface definition needs to define the ouput type which is, in my case, variable.
Here is the related code:
type :: dt
real(dp) :: realValue
integer :: integerValue
character(*) :: strValue
logical :: isReal, isInteger, isStr
procedure(intf), pointer :: get
contains
procedure :: getReal, getInteger, getStr
end type
abstract interface
function intf(self)
import dt
class(dt) :: self
??? :: intf
end function
end interface
Any idea ?
That is simply impossible in Fortran.
You can use a generic interface with different specific functions, but these functions must have arguments of different types (see how several intrinsic functions, like transfer() use a mold argument). This is called the TKR (type, kind, rank) resolution. Generic functions cannot be distinguished based on a value of an argument.
type :: dt
real(dp) :: realValue
integer :: integerValue
character(*) :: strValue !!!! <= THIS IS WRONG !!!!
logical :: isReal, isInteger, isStr
contains
generic :: get => getReal, getInteger, getStr
procedure :: getReal, getInteger, getStr
end type
function getReal(self, mold)
class(dt) :: self
real, intent(in) :: mold
end function
function getInteger(self, mold)
class(dt) :: self
integer, intent(in) :: mold
end function
function getString(self, mold)
class(dt) :: self
character(*), intent(in) :: mold
end function
As you see, you have to know the correct type when calling get(). You call it like
real_variable = object%get(1.0)
integer_variable = object%get(1)
Be also careful about strings of different lengths. I marked it above. You probably want character(:), allocatable.
You can make also function which returns a generic container and then extract the value from the container. The extraction could even be done directly using an overloaded assignment for the container.
You could also just return an unlimited polymorphic variable (class(*)).
I defined a derived type and encountered some problems with memory deallocation although I had written the final procedure. The code is as follows
module ModuleCoordinate
implicit none
type :: TCoordinate
real(8),dimension(:),pointer :: Coordinate => NULL()
contains
procedure :: TCoordinateAssignment
generic,public :: Assignment(=) => TCoordinateAssignment
final :: TCoordinateDel
end type TCoordinate
interface TCoordinate
module procedure :: TCoordinateInit
end interface TCoordinate
contains
subroutine TCoordinateDel(self)
type(TCoordinate),intent(inout) :: self
if(associated(self%Coordinate))deallocate(self%Coordinate)
end subroutine TCoordinateDel
subroutine TCoordinateAssignment(O1,O2)
class(TCoordinate),intent(out) :: O1
type(TCoordinate),intent(in) :: O2
if(associated(O2%Coordinate))allocate(O1%Coordinate,source=O2%Coordinate)
end subroutine TCoordinateAssignment
type(TCoordinate) function TCoordinateInit(IVal1,IVal2) result(self)
real(8),intent(in) :: IVal1,IVal2
allocate(self%Coordinate(2))
self%Coordinate=(/IVal1,IVal2/)
end function TCoordinateInit
end module ModuleCoordinate
The test code is as follows
program test
implicit none
integer(4),parameter :: NLoop=40000
integer(4) :: i
do i=1,NLoop
call TestMemory1()
call TestMemory2()
end do
pause
end program test
subroutine TestMemory1()
use ModuleCoordinate
implicit none
integer(4),parameter :: DN=10
integer(4) :: i
type(TCoordinate),dimension(DN) :: a
do i=1,DN
a(i)=TCoordinate(1.0_8,1.0_8)
end do
end subroutine TestMemory1
subroutine TestMemory2()
use ModuleCoordinate
implicit none
type(TCoordinate) :: b1,b2,b3,b4,b5,b6,b7,b8,b9,b10
b1=TCoordinate(1.0_8,1.0_8)
b2=TCoordinate(1.0_8,1.0_8)
b3=TCoordinate(1.0_8,1.0_8)
b4=TCoordinate(1.0_8,1.0_8)
b5=TCoordinate(1.0_8,1.0_8)
b6=TCoordinate(1.0_8,1.0_8)
b7=TCoordinate(1.0_8,1.0_8)
b8=TCoordinate(1.0_8,1.0_8)
b9=TCoordinate(1.0_8,1.0_8)
b10=TCoordinate(1.0_8,1.0_8)
end subroutine TestMemory2
It turns out that the subroutine TestMemory2 is OK while TestMemory1 is not, which means that when an array of this derived type is declared the final procedure doesn't work and the memory leaks.
However, if I delete the => NULL() on the right of the Coordinate in the definition of this derived type, both subroutines seem to work well.
What makes the difference when the pointer Coordinate is being deallocated?
The complier is ifort_2013_sp1.3.174 if it matters.
In the description of the finalization process we see (Fortran 2008, 4.5.6.2)
If the dynamic type of the entity has a final subroutine whose dummy argument has the same kind type parameters and rank as the entity being finalized, it is called with the entity as an actual argument. Otherwise, if there is an elemental final subroutine whose dummy argument has the same
kind type parameters as the entity being finalized, it is called with the entity as an actual argument. Otherwise, no subroutine is called at this point.
There is a final subroutine for the derived type provided only for scalar (rank-0) entities. To have finalization for your rank-1 entity the simplest way (it seems, in this case) is to make the subroutine you have elemental.
I'm slightly reluctant to mention the =>NULL() aspect as I have no current means of testing what I'm about to write, but I'll speculate.
Without the =>NULL() default initialization the pointer component has undefined association status. This means, that when you do
b1=TCoordinate(1.0_8,1.0_8)
interesting things happen.
As part of the assignment b1 is finalized on entry to TCoordinateAssignment. The finalization involves calling associated with the pointer which is of undefined association status. This is not allowed (with the consequence that any result could come about).
Suppose that I want to pass a function to another function via f1(f2(k, g, x), other, junk) (f1 is defined as f1(func, other, junk) and it involves expressions like func(other).) Further suppose that both of these functions are contained in a third function f3(k, g). By calling f3(k, g) with some values of k and g, f2 isn't really a function of three variables anymore, is it? It's only a function of x since k and g are now constants. So what I want to know is whether or not there's somehow a way of saying "look, f2, you didn't know what k and g were when I defined you, but now you do since I told f3 what they were, so you can just consider yourself as a function of x, so when I pass you to f1, it sees and uses a function of only one variable."
What I think you are looking for is sometimes called a "functor/function object" or lambda expression - the ability to wrap a procedure with a number of arguments up in a way that it can be called with fewer arguments (the missing arguments being specified via other means).
In Fortran 77 this was typically approximated by passing the "missing" arguments through behind the scenes in a common block. Fortran 90/95's varied that by letting you use module variables. Both these approaches have the downside that only a single instance of the wrapped procedure can be extant at the one time, though the use of modules over common blocks is a vastly superior option for other reasons.
Fortran 2003 introduces other options - using derived types and type extension. This requires changes to the code of f1 - instead of having a dummy procedure argument the function takes a polymorphic argument, the declared type of which has a binding that has the interface similar to the former argument of f1 but with a passed object. The missing arguments then become components in extensions of that declared type. This approach brings with it a vast increase in flexibility and capability, not the least of which is that multiple instances of the wrapped procedure can then be extant at any one time, at the cost of some verbosity.
Fortran 2008 introduces another option using internal procedures, with the missing arguments passed via host association from a host procedure to the internal procedure. (This approach was not available in previous standards because internal procedures were not permitted to be passed as actual procedure arguments). Multiple instances of the wrapped procedure can be extant through the use of procedure pointers.
Examples for the four different approaches attached. Note that the other and junk entities have not been declared in any of the examples of the F3 procedure, and there may be some other omissions (or what I would consider very poor programming style) for the sake of the example. Further, note that the four approaches differ greatly in terms of the flexibility and robustness of the code (likelihood that programmer error being caught, etc).
C*******************************************************************************
C FORTRAN 77
FUNCTION F1(FUNC,OTHER,JUNK)
F1=FUNC(OTHER)+JUNK
END FUNCTION F1
C
FUNCTION F2(K,G,X)
F2=K+G+X
END FUNCTION F2
C
FUNCTION F3(K,G)
COMMON /F2COM/KC,GC
KC=K
GC=G
F3=F1(F2WRAP,OTHER,JUNK)
END FUNCTION F3
C
FUNCTION F2WRAP(X)
COMMON /F2COM/KC,GC
F2WRAP=F2(KC,GC,X)
END FUNCTION F2WRAP
!*******************************************************************************
! Fortran 90/95
MODULE m1990
IMPLICIT NONE
INTEGER :: km
REAL :: gm
CONTAINS
FUNCTION F2Wrap(x)
REAL :: x
!****
! F2 unchanged from F77, though good practice would be to make
! it (and F1 and F3) module procedures.
! ensure it had an explicit interface here.
F2Wrap = F2(km,gm,x)
END FUNCTION F2Wrap
END MODULE m1990
FUNCTION F3(k,g)
USE m1990
IMPLICIT NONE
INTEGER :: k
REAL :: g, F3
!****
km = k
gm = g
! F1 unchanged from F77.
F3=F1(F2Wrap, other, junk)
END FUNCTION F3
!*******************************************************************************
! Fortran 2003
MODULE m2003
IMPLICIT NONE
TYPE Functor
CONTAINS
PROCEDURE(fun_intf), DEFERRED :: fun
END TYPE Functor
ABSTRACT INTERFACE
FUNCTION fun_intf(f,x)
IMPLICIT NONE
IMPORT :: Functor
CLASS(Functor), INTENT(IN) :: f
REAL :: x, fun_intf
END FUNCTION fun_intf
END INTERFACE
TYPE F2Functor
INTEGER :: k
REAL : g
CONTAINS
PROCEDURE :: fun => F2_wrap
END TYPE F2Functor
CONTAINS
FUNCTION F2_wrap(f,x)
CLASS(F2Functor), INTENT(IN) :: f
REAL :: F2_wrap, x
! F2 unchanged from F77
F2_wrap = F2(f%k, f%g, x)
END FUNCTION f2_wrap
! F1 modified. Now takes a polymorphic argument in-place of the
! dummy procedure - explicit interface REQUIRED.
FUNCTION F1(f, other, junk)
CLASS(Functor), INTENT(IN) :: f
REAL :: F1, other
INTEGER :: junk
F1 = f%fun(other) + junk
END FUNCTION
END MODULE m2003
! Good practice would make this a module procedure.
FUNCTION f3(k,g)
USE m2003
IMPLICIT NONE
TYPE(F2Functor) :: f
REAL F3, g
INTEGER :: k
!****
f%k = k
f%g = g
F3 = F1(f, other, junk)
END FUNCTION f3
!*******************************************************************************
! Fortran 2008 (use of procedure pointers not illustrated).
! Should be a module proc, etc...
FUNCTION F3(k,g)
REAL :: F3, g
INTEGER :: k
INTEGER :: k_host
REAL :: g_host
k_host = k
g_host = g
! F1 unchanged from F77 (though good practice is..., etc)
F3 = F1(F2Wrap, other, junk)
CONTAINS
FUNCTION F2Wrap(x)
REAL :: x, F2Wrap
! F2 unchanged from F77.
F2Wrap = F2(k_host, g_host, x)
END FUNCTION F2Wrap
END FUNCTION F3
Supposing that I am interpreting this correctly, then yes.
program func_test
integer :: a, b
a = 4
b = 3
print *,f3(a,b)
print *,f3(b,a)
contains
function f3(k,g)
integer :: k, g, x, f3
x = 2
f3 = f1(f2(k,g,x), 3, 13)
end function f3
function f2(k, g, x)
integer :: k, g, x, f2
f2 = k+g*x
end function f2
function f1(func, other, junk)
integer :: func, other, junk
f1 = func + other*junk
end function f1
end program func_test
Unless I am mistaken, f2(k,g,x) in this example will be evaluated and then sent to f1 as an integer. If you wanted f2 to be called from f1, then you would also have to pass the arguments k, g, and x from f3 to f1.