I am compiling a code in Fortran. If I use a recent version of Intel Fortran it compiles. However, I need to compile the same code with gfortran (I have gcc version 6.3.0 (GCC)).
At these two lines of the code
read(F%Unit) FileSettings%TCosmoTheoryParams
Write(F%Unit) CosmoSettings%TCosmoTheoryParams
I get the error `
Error: Data transfer element at (1) cannot have ALLOCATABLE components unless it is processed by a defined input/output procedure`
How to modify the code, keeping the compiler gcc?
The full compiler error, within the 'make' compilation
mpif90 -cpp -O3 -ffast-math -ffree-line-length-none -fopenmp -fmax-errors=4 -march=native -DMPI -DEFTCOSMOMC -I../EFTCAMB/ReleaseEFTMPI -JReleaseEFTMPI -IReleaseEFTMPI/ -c CosmoTheory.f90 -o ReleaseEFTMPI/CosmoTheory.o
CosmoTheory.f90:253:52:
read(F%Unit) FileSettings%TCosmoTheoryParams
1
Error: Data transfer element at (1) cannot have ALLOCATABLE components unless it is processed by a defined input/output procedure
CosmoTheory.f90:183:54:
Write(F%Unit) CosmoSettings%TCosmoTheoryParams
1
Error: Data transfer element at (1) cannot have ALLOCATABLE components unless it is processed by a defined input/output procedure
And the snippet of code where these lines are from:
subroutine TCosmoTheoryPredictions_ReadTheory(this, F, first)
Class(TCosmoTheoryPredictions) this
class(TFileStream) :: F
logical, intent(in) :: first
type(TCosmoTheorySettings), save :: FileSettings
!JD 02/14 new variables for handling new pk arrays
integer :: num_k, num_z
real(mcp), allocatable :: temp(:,:)
real(mcp), allocatable :: k(:), z(:)
real(mcp), allocatable :: cl(:)
real(mcp), allocatable :: valArray(:)
integer i,j
if (first) then
read(F%Unit) FileSettings%TCosmoTheoryParams
if (FileSettings%use_LSS) call F%ReadSizedArray(FileSettings%power_redshifts)
if (FileSettings%use_CMB) call F%ReadSizedArray(FileSettings%cl_lmax)
call F%ReadSizedArray(FileSettings%ArraySizes) !not used
end if
subroutine TCosmoTheoryPredictions_WriteTheory(this, F, first)
Class(TCosmoTheoryPredictions) this
class(TFileStream) :: F
logical, intent(in) :: first
integer ArraySizes(1)
real(mcp) :: valArray(6)
integer i,j
if (first .and. new_chains) then
Write(F%Unit) CosmoSettings%TCosmoTheoryParams
if (CosmoSettings%use_LSS) call F%WriteSizedArray(CosmoSettings%power_redshifts)
if (CosmoSettings%use_CMB) call F%WriteSizedArray(CosmoSettings%cl_lmax)
ArraySizes(1)=size(valArray)
call F%WriteSizedArray(ArraySizes)
end if
Definition of TCosmoTheorySettings:
Type, extends(TCosmoTheoryParams):: TCosmoTheorySettings
!Just add the allocatable components
integer, allocatable :: cl_lmax(:,:)
integer, allocatable :: ArraySizes(:)
!e.g. lmax_cl(1,1) is lmax for TT; zero if CL is not used; order is T, E, B, Phi
real(mcp), dimension(:), allocatable :: power_redshifts
contains
procedure, private :: Initialize_PKSettings
procedure, private :: Initialize_CMBSettings
procedure :: InitForLikelihoods => TCosmoTheorySettings_InitForLikelihoods
procedure :: ReadParams => TCosmoTheorySettings_ReadParams
end type TCosmoTheorySettings
Type TCosmoTheoryParams contains only ordinary non-allocatable and non-pointer data components and no procedures
Related
I want to pass a procedure pointer between two classes in modern Fortran.
this procedure pointer should
be called from within the second object
access the first ojects' components, without having it as dummy argument.
A clear example is here, imagine doing an object-oriented wrapper of an ODE solver:
module test_funptr
implicit none
public
type, public :: ode_solver
integer :: NEQ = 0
procedure(ode_api), pointer, nopass :: f => null()
contains
procedure :: run
end type ode_solver
type, public :: ode_problem
integer :: NEQ = 10
procedure(ode_api), pointer, nopass :: yprime => null()
contains
procedure :: init
end type ode_problem
abstract interface
subroutine ode_api(NEQ,YDOT)
integer, intent(in) :: NEQ
real(8), intent(inout) :: YDOT(NEQ)
end subroutine ode_api
end interface
contains
! Initialize problem variables
subroutine init(this,NEQ)
class(ode_problem), intent(inout) :: this
integer, intent(in) :: NEQ
! Associate function pointer
this%yprime => problem_api
contains
! nopass ODE solver API
subroutine problem_api(NEQ,YDOT)
integer, intent(in) :: NEQ
real(8), intent(inout) :: YDOT(NEQ)
integer :: i
print *, 'entered problem API with NEQ=',NEQ
forall(i=1:NEQ) YDOT(i) = real(i,8)
end subroutine
end subroutine init
subroutine run(this)
class(ode_solver), intent(inout) :: this
real(8) :: ydot(this%neq)
ydot = 0.0
print *, 'enter solver run with NEQ=',this%NEQ
print *, 'is function associated? ',associated(this%f)
call this%f(this%neq,ydot)
end subroutine run
end module test_funptr
program test
use test_funptr
type(ode_solver) :: solver
type(ode_problem) :: prob
call prob%init(10)
! Associate ode solver
solver%neq = prob%NEQ
solver%f => prob%yprime
call solver%run()
end program test
This program returns with gfortran-10:
enter solver run with NEQ= 10
is function associated? T
Program received signal SIGILL: Illegal instruction.
The procedure seems properly associated, but it can't be called. Am I doing something wrong passing the procedure pointers, or I'm doing something out-of-standard? I'm concerned the contained subroutine may go out of scope, but if so, how can I achieve this behavior?
The tricky part is of course that the function should access data from the other variable instance.
It is illegal to invoke a procedure pointer to an internal procedure, after the host procedure gets out of scope.
The draft of Fortran 2015 N2123 mentions this in NOTE 15.17
NOTE 15.17
An internal procedure cannot be invoked using a procedure
pointer from either Fortran or C after the host instance completes
execution, because the pointer is then undefined. While the host
instance is active, however, if an internal procedure was passed as an
actual argument or is the target of a procedure pointer, it could be
invoked from outside of the host subprogram.
... an example follows
Often, internal procedures are implemented using trampolines. That is, a piece of executable code placed on the stack, that enables accessing the local scope and calls the procedure itself. The pointer is then a pointer to the trampoline. Once the host function gets out of scope, the pointer to the stack is invalid.
As pointed out, internal (contained) procedures are not the way to go, as they cannot be targets to procedure pointers. Hopefully this will be catched by the compilers.
I've figured out an elegant way to accomplish the aim to pass an interfaced procedure between two classes this way:
class 1 needs to call that function: it must contain a pointer to class 2
The nopass function should be inside this class, as an internal procedure (this way, it'll never go out of scope)
This class must contain a (polymorphic) pointer to the instantiated object from class 2
class 2 contains the actual implementation, it should instantiate an abstract type that contains the same interfaced function, but with the derived type as dummy argument
Here I'm providing an implementation that works:
module odes
implicit none
type, abstract, public :: ode_problem
integer :: NEQ
contains
procedure(ode_api), deferred :: fun
end type ode_problem
type, public :: ode_solver
integer :: NEQ
class(ode_problem), pointer :: problem => null()
contains
procedure :: init
procedure :: run
end type ode_solver
abstract interface
subroutine ode_api(this,YDOT)
import ode_problem
class(ode_problem), intent(inout) :: this
real(8), intent(out) :: YDOT(this%NEQ)
end subroutine ode_api
end interface
contains
! Associate problem to ODE solver
subroutine init(this,my_problem)
class(ode_solver), intent(inout) :: this
class(ode_problem), intent(in), target :: my_problem
this%neq = my_problem%NEQ
this%problem => my_problem
end subroutine init
! call the nopass f77 interface function
subroutine run(this)
class(ode_solver), intent(inout) :: this
real(8) :: YDOT(this%NEQ)
integer :: i
if (.not.associated(this%problem)) stop 'solver not associated to a problem'
! This will be in general passed to another function as an argument
call ode_f77_api(this%NEQ,YDOT)
contains
subroutine ode_f77_api(NEQ,YDOT)
integer, intent(in) :: NEQ
real(8), intent(out) :: YDOT(NEQ)
! This is just a nopass interface to this problem's function that can
! access internal storage
call this%problem%fun(YDOT)
end subroutine ode_f77_api
end subroutine run
end module odes
! Provide an actual implementation
module my_ode_problem
use odes
implicit none
type, public, extends(ode_problem) :: exp_kinetics
real(8) :: k = -0.5d0
contains
procedure :: fun => exp_fun
end type exp_kinetics
contains
subroutine exp_fun(this,YDOT)
class(exp_kinetics), intent(inout) :: this
real(8), intent(out) :: YDOT(this%NEQ)
integer :: i
forall(I=1:this%NEQ) YDOT(i) = this%k*real(i,8)
print 1, this%NEQ,(i,YDOT(i),i=1,this%NEQ)
1 format('test fun! N=',i0,': ',*(/,10x,' ydot(',i0,')=',f5.2,:))
end subroutine exp_fun
end module my_ode_problem
program test_fun_nopass
use odes
use my_ode_problem
implicit none
type(exp_kinetics) :: prob
type(ode_solver) :: ode
prob%NEQ = 10
call ode%init(prob)
call ode%run()
stop 'success!'
end program test_fun_nopass
This program returns:
test fun! N=10:
ydot(1)=-0.50
ydot(2)=-1.00
ydot(3)=-1.50
ydot(4)=-2.00
ydot(5)=-2.50
ydot(6)=-3.00
ydot(7)=-3.50
ydot(8)=-4.00
ydot(9)=-4.50
ydot(10)=-5.00
STOP success!
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 am copying a variable of certain class in another of the same class. The compiler happily compiles this but I am worried that at run time the dynamic types may differ. Do I need to test that the two objects are of the same dynamic type to prevent copying rectangle in a square say or may I trust the compiler? What happens if a rectangle is copied in a square accidentally?
What I am trying to do is the following:
type :: simVars
class(stateVars), dimension(:), allocatable :: svars
integer :: count_
contains
procedure :: init => init_simVars
procedure :: destroy => dest_simVars
procedure :: add => add_to_simVars ! adds an observation to the time series
end type simVars
subroutine init_simVars(this,n)
!--> VERSION 1
class(simVars), intent(inout) :: this
integer, intent(in) :: n
allocate( this%svars(n) )
this%count_ = 0
end subroutine init_simVars
subroutine init_simVars(this,n,sVarsIni)
!--> VERSION 2
class(simVars), intent(inout) :: this
integer, intent(in) :: n
class(stateVars), intent(in) :: sVarsIni
allocate( this%svars(n),source=sVarsIni )
this%count_ = 0
end subroutine init_simVars
subroutine add_to_simvars(this,svars)
class(simVars), intent(inout) :: this
class(stateVars), intent(in) :: svars
this%count_ = this%count_+1
this%svars(this%count_) = svars
end subroutine add_to_simvars
subroutine doSimulation(simHist,sVarsIni)
class(simVars), intent(out) :: simHist
class(stateVars), intent(in) :: sVarsIni
!--> dynamic type 'stateVars1'
class(stateVars), allocatable :: sVars ! will be source allocated from 'iniState'
! initialize the state of the economy
allocate( sVars, source=sVarsIni ) ! "copies" 'sVarsIni' in 'sVars'
! initialize 'simHist'
!--> VERSION 1:
call simHist%init(nYears)
!--> VERSION 2:
call simHist%init(nYears,iniState)
! save today's variables
call simHist%add(sVars)
...
end subroutine doSimulation
Compiler (ifort 14) happily compiles both versions but I strongly suspect that VERSION 1 is wrong. In init_simVars this%svars will be allocated to dynamic type stateVars, in add_to_simvars sVars will have dynamic type stateVars1 and a copy in this%sVars (of type stateVars) will be attempted. I am quite surprised that the compiler compiles this even though it cannot determine the dynamic type of sVars in add_to_simvars. What would happen at run time, a seg fault or what?
VERSION 2 I believe is correct however I am somewhat reluctant to trust the compiler here therefore I am thinking I should ASSERT that this%sVars and sVars have the same dynamic type (ASSERT(SAME_TYPE_AS(this%sVars, sVars) ))? Is this a real concern or am I worried too much?
Another question is what happens when I do allocate( this%svars(n),source=sVarsIni ). I want to allocate the array this%sVars to be of size n and dynamic type sVarsIni. However sVarsIni is a scalar. Will it do what I want?
The difference is in these lines
allocate( this%svars(n) )
vs.
allocate( this%svars(n),source=sVarsIni )
where this%svars is class(svars) allocatable array and svarsIni is an class(stateVars) dummy argument.
That indeed changes a lot.
In the first case, it allocates it to the declared type, which is svars, in the other case it allocates to the dynamic type of the dummy argument, which is at least stateVars.
If you do version 1, it should than fail at add_to_simvars, because the dynamic types won't match.
I don't know if you overloaded the assignment in there or not. If you didn't it shouldn't even compile, because of the intrinsic assignment of polymorphic objects.
....
abstract interface
pure function fi(t,u) result (fu)
use NumberKinds
real(kp), dimension(:), intent(in) :: u
real(kp), intent(in) :: t
real(kp), dimension(size(u)) :: fu
end function fi
end interface
contains
pure function rk4_step(u,f,dt) result(un)
use NumberKinds
real(kp), intent(in) :: dt
real(kp), intent(in), dimension(:) :: u
real(kp), dimension(size(u)) :: k1,k2,k3,k4,un
procedure(fi) :: f
integer :: N
...
end function rk4_step
...
I get this error message with g95: G95 (GCC 4.0.3 (g95 0.94!) Jan 17 2013)
In file src/integrators.f95:34
pure function rk4_step(u,f,dt) result(un)
1
Error: Dummy procedure 'f' of PURE procedure at (1) must also be PURE
Makefile:28: recipe for target 'test_rk4' failed
I don't get it with gfortran: GNU Fortran (GCC) 4.8.2 20140206 (prerelease)
and the program compiles without further problems
Just a compiler bug. g95 is very old, when Fortran 2003 just started to be implemented in compilers. It has decent C interop, stream access and so on, but many other features are not implemented at all.
Don't use a compiler, that has not been updated for a long time (with a small exception recently) if you need modern features support.
You can try an interface block inside rk4_step instead of the abstract interface, that is Fortran 90 and works for me in g95.
pure function rk4_step(u,f,dt) result(un)
use NumberKinds
real(kp), intent(in) :: dt
real(kp), intent(in), dimension(:) :: u
real(kp), dimension(size(u)) :: k1,k2,k3,k4,un
integer :: N
interface
pure function f(t,u) result (fu)
use NumberKinds
real(kp), dimension(:), intent(in) :: u
real(kp), intent(in) :: t
real(kp), dimension(size(u)) :: fu
end function f
end interface
end function rk4_step
I have a simple fortran function that computes the Kronecker product:
function kron(A, B)
implicit none
real, intent(in) :: A(:, :), B(:, :)
integer :: i, j, ma, na, mb, nb
real, dimension(:, :) :: kron
ma = ubound(A, 1)
na = ubound(A, 2)
mb = ubound(b, 1)
nb = ubound(b, 2)
forall(i=1:ma, j=1:na)
kron(mb*(i-1)+1:mb*i, nb*(j-1)+1:nb*j) = A(i,j)*B
end forall
end function kron
It's inside a module, but when I compile it with gfortran -static -ffree-form -std=f2003 -Wall, I get these errors:
function kron(A, B)
1
Error: Array 'kron' at (1) cannot have a deferred shape
Is this error occurring because you're supposed to know the size of the array to be returned beforehand?
That is exactly what the error is telling you: kron must have an explicit shape. If you do not want to pass the array sizes beforehand, you'd have to define kron as
real, dimension(lbound(a,dim=1):ubound(a,dim=1),&
lbound(a,dim=2):ubound(a,dim=2)) :: kron
Using this particular explicit declaration above does compile for me on gfortran 4.6.3.
A deferred-shape array that has the ALLOCATABLE attribute is referred to as an allocatable array. Its bounds and shape are determined when storage is allocated for it by an ALLOCATE statement.
try this
real, intent(in), allocatable, dimension(:, :: A(:, :), B(:, :)
You just need to define the allocatable array as allocatable, i.e replace the kron definition with;
real, allocatable, dimension(:,:) :: kron
This also compiles fine in 4.6.3 and is defined at:
https://docs.roguewave.com/codedynamics/2017.0/html/index.html#page/TotalViewLH/totalviewlhug-examining-data.09.10.html
Hopefully this should save you some effort, especially considering there is no need to define a lower bound here!