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 function that returns an array, say
function f(A)
implicit none
real, intent(in) :: A(5)
real, intent(out) :: f(5)
f = A+1
end
My question is, how can I define f in the main program unit? E.g.
program main
implicit none
real :: A(5)
real, dimension(5), external :: f ! does not work
...
end
You need an explicit interface. You can do this in a few ways.
Explicitly in the scoping unit that calls f:
interface
function f(A)
implicit none
real, intent(in) :: A(5)
real :: f(5)
end function
end interface
Place the function in your program host scope as an internal function:
program main
...
contains
function f(A)
implicit none
real, intent(in) :: A(5)
real :: f(5)
f = A+1
end
end program
Place the function in a module:
module A
contains
function f(A)
implicit none
real, intent(in) :: A(5)
real :: f(5)
f = A+1
end
end module
program main
use A
...
end program
Use the explicit interface from a different procedure with the same arguments and return type, kind and rank.
program main
interface
function r5i_r5o(r5)
implicit none
real, intent(in) :: r5(5)
real :: r5i_r5o(5)
end function
end interface
procedure(r5i_r5o) :: f
...
end program
function f(A)
implicit none
real, intent(in) :: A(5)
real :: f(5)
f = A+1
end
The cleanest way of doing this is option #3 using modules. This gives you the benefit of an automatic explicit interface (not needing to do option #1 everywhere you call f) and makes your function available everywhere the module is used rather than limited to a specific scoping unit as in option #2. Option #4 can be handy if you have many procedures with the same argument and return types since one explicit interface can be re-used for all of them.
This shows three different ways to specify function results, and how to use modules to organize your functions:
module so_func
INTEGER, PARAMETER :: MAX_SIZE = 5
TYPE MY_DATA
INTEGER :: SIZE
REAL, DIMENSION(MAX_SIZE) :: DATA
ENDTYPE
contains
FUNCTION f1(A,N) RESULT(X)
implicit none
INTEGER, INTENT(IN) :: N
REAL, INTENT(IN) :: A(N)
REAL :: X(N)
! ....
X = 1.0+A
END FUNCTION f1
TYPE(MY_DATA) FUNCTION f2(A,N)
implicit none
INTEGER, INTENT(IN) :: N
REAL, INTENT(IN) :: A(N)
! ....
f2%SIZE = N
f2%DATA(1:N) = 1.0+A
END FUNCTION f2
FUNCTION f3(A,N)
implicit none
INTEGER, INTENT(IN) :: N
REAL, INTENT(IN) :: A(N)
REAL :: f3(N)
! ....
f3 = 1.0+A
END FUNCTION f3
end module
program SO_RESULT
use so_func
implicit none
integer, parameter :: n=5
REAL :: A(n), y1(n), y3(n)
TYPE(MY_DATA) :: y2
INTEGER :: i
! Variables
A =(/ (i, i=1,n) /)
y1 = f1(A,n)
y2 = f2(A,n)
y3 = f3(A,n)
end program SO_RESULT
I am writing a code with a lot of 2D arrays and manipulation of them. I would like the code to be as concise as possible, for that I would like to use as many 'implicit' operation on array as possible but I don't really know how to write them for 2D arrays.
For axample:
DO J=1,N
DO I=1,M
A(I,J)=B(J)*A(I,J)
ENDDO
ENDDO
become easily:
DO J=1,N
A(:,J)=B(J)*A(:,J)
ENDDO
Is there a way to reduce also the loop J?
Thanks
For brevity and clarity, you could wrap these operations in a derived type. I wrote a minimal example which is not so concise because I need to initialise the objects, but once this initialisation is done, manipulating your arrays becomes very concise and elegant.
I stored in arrays_module.f90 a derived type arrays2d_T which can hold the array coefficients, plus useful information (number of rows and columns). This type contains procedures for initialisation, and the operation you are trying to perform.
module arrays_module
implicit none
integer, parameter :: dp = kind(0.d0) !double precision definition
type :: arrays2d_T
real(kind=dp), allocatable :: dat(:,:)
integer :: nRow, nCol
contains
procedure :: kindOfMultiply => array_kindOfMuliply_vec
procedure :: init => initialize_with_an_allocatable
end type
contains
subroutine initialize_with_an_allocatable(self, source_dat, nRow, nCol)
class(arrays2d_t), intent(inOut) :: self
real(kind=dp), allocatable, intent(in) :: source_dat(:,:)
integer, intent(in) :: nRow, nCol
allocate (self%dat(nRow, nCol), source=source_dat)
self%nRow = nRow
self%nCol = nCol
end subroutine
subroutine array_kindOfMuliply_vec(self, vec)
class(arrays2d_t), intent(inOut) :: self
real(kind=dp), allocatable, intent(in) :: vec(:)
integer :: iRow, jCol
do jCol = 1, self%nCol
do iRow = 1, self%nRow
self%dat(iRow, jCol) = vec(jCol)*self%dat(iRow, jCol)
end do
end do
end subroutine
end module arrays_module
Then, in main.f90, I check the behaviour of this multiplication on a simple example:
program main
use arrays_module
implicit none
type(arrays2d_T) :: A
real(kind=dp), allocatable :: B(:)
! auxilliary variables that are only useful for initialization
real(kind=dp), allocatable :: Aux_array(:,:)
integer :: M = 3
integer :: N = 2
! initialise the 2d array
allocate(Aux_array(M,N))
Aux_array(:,1) = [2._dp, -1.4_dp, 0.3_dp]
Aux_array(:,2) = [4._dp, -3.4_dp, 2.3_dp]
call A%init(aux_array, M, N)
! initialise vector
allocate (B(N))
B = [0.3_dp, -2._dp]
! compute the product
call A%kindOfMultiply(B)
print *, A%dat(:,1)
print *, A%dat(:,2)
end program main
Compilation can be as simple as gfortran -c arrays_module.f90 && gfortran -c main.f90 && gfortran -o main.out main.o arrays_module.o
Once this object-oriented machinery exists, call A%kindOfMultiply(B) is much clearer than a FORALL approach (and much less error prone).
No one has mentioned do concurrent construct here, which has the potential to automatically parallelize and speed up your code,
do concurrent(j=1:n); A(:,j)=B(j)*A(:,j); end do
A one-line solution can be achieved by using FORALL:
FORALL(J=1:N) A(:,J) = B(J)*A(:,J)
Note that FORALL is deprecated in the most recent versions of the standard, but as far as I know, that is the only way you can perform that operation as a single line of code.
I'd like to pass a "pointer" to imaginary part of a complex Fortran array to a BLAS function that operates on real numbers only. I mean a "pointer" in a C language sense, as I do not want any data copying involved.
For example, consider the following simple code (my actual code is slightly more complicated):
function foo(c1, c2, n) result(r)
complex, dimension(:), intent(in) :: c1, c2
integer, intent(in) :: n
real :: r
real, external :: SDOT
r = SDOT(n, c1(1)%re, 2, c2(1)%im, 2)
end function foo
Unfortunately, %re and %im are specified in Fortran 2008 only. Moreover, I'm not sure the standard allows to apply complex part selector to the individual elements of array, as neither of my compilers support that.
gfortran complains with "Unexpected ‘%’ for nonderived-type variable".
Is there any other way to achieve what I need?
What I would do is to first create a subroutine with an explicit shape or assumed size real argument with one rank of size 2 added:
function foo(c1, c2, n) result(r)
complex, dimension(:), intent(in) :: c1, c2
integer, intent(in) :: n
real :: r
real, external :: bar
r = bar(c1, c2, n)
end function foo
function bar(c1, c2, n) result(r)
real, dimension(2,n), intent(in) :: c1, c2
integer, intent(in) :: n
real :: r
r = SDOT(n, c1(1,:), 2, c2(2,:), n)
end function
Keep bar in a different source file and with implicit interface so that the compiler does not complain. For discussion about validity of this see Is the storage of COMPLEX in fortran guaranteed to be two REALs?
Unfortunately, it will still create temporary copies of the arrays. Only if you used assumed shape arguments in SDOT and have explicit interface for that it would actually help to avoid copies.
Even if you created Fortran real pointers for the real and imaginary part, still a temporary copy would be made if you passed it to an external function.
As per suggestion of #Vladimir F, I ended up with the following code.
bar.F file:
function bar(c1, c2, n) result(r)
real, intent(in) :: c1(*), c2(*)
integer, intent(in) :: n
real :: r
r = SDOT(n, c1(1), 2, c2(2), 2)
end function bar
foo.F file:
function foo(c1, c2, n) result(r)
complex, dimension(:), intent(in) :: c1, c2
integer, intent(in) :: n
real :: r
real, external :: bar
r = bar(c1, c2, n)
end function foo
function foo(c1, c2, n) result(r)
complex, dimension(:), intent(in) :: c1, c2
integer, intent(in) :: n
real :: r
REAL, DIMENSION(n) :: reality, dreamy
real, external :: SDOT
Reality = REAL(c1)
DReamy = IMAG(c2)
r = SDOT(n, Reality, 1, Dreamy, 1)
end function foo
As AIMAG and REAL are ELEMENTAL, you should be able to put them In the SDOT call as they be a temporary vector on the stack.