i am writing a program in Fortran which uses .mod files, .dll libraries and .h headers.
I must be forgetting something when i call the compiler, because i get the error:
undefined reference to '__[module_name]_MOD_[function_name]', where [module_name] is the name of one of the modules used by the main program and [function_name] is the name of a function contained in the module.
The only source file is called MAIN.f90:
! WORHP workspace access macros
#include "worhp/macros.h"
MODULE WORHP_INTERFACE
USE std
USE problem_definition_tools
CONTAINS
SUBROUTINE OBJ(N,X,F) BIND(C)
INTEGER(WORHP_INT) :: N
REAL(WORHP_DOUBLE) :: X(N),F
INTENT(in) :: N, X
INTENT(out) :: F
F = X(1)
END SUBROUTINE OBJ
SUBROUTINE CON(N,M,X,G) BIND(C)
INTEGER(WORHP_INT) :: N,M
REAL(WORHP_DOUBLE) :: X(N),G(M)
INTENT(in) :: N, M, X
INTENT(out) :: G
TYPE (orbit) :: O
O = final_orbit(X)
G = [O%Lp, O%La]
END SUBROUTINE CON
SUBROUTINE DOBJ(N,dfnnz,DFROW,X,DF) BIND(C)
INTEGER(WORHP_INT) :: N,dfnnz,DFROW(DFnnz)
REAL(WORHP_DOUBLE) :: X(N),DF(DFnnz)
INTENT(in) :: N, DFnnz, DFrow, X
INTENT(out) :: DF
DF = [1, 0, 0, 0, 0, 0]
END SUBROUTINE DOBJ
SUBROUTINE DCON(N,M,DGnnz,DGROW,DGCOL,X,DG) BIND(C)
INTEGER(WORHP_INT) :: N,M,DGnnz,DGROW(DGnnz),DGCOL(DGnnz)
REAL(WORHP_DOUBLE) :: X(N),DG(DGnnz)
INTENT(in) :: N,M,DGnnz,DGrow,DGcol,X
INTENT(out) :: DG
! Dummy
END SUBROUTINE DCON
SUBROUTINE HESS(N,M,HMnnz,HMrow,HMcol,X,Mu,HM) BIND(C)
INTEGER(WORHP_INT) :: N, M, HMnnz, HMrow(HMnnz), HMcol(HMnnz)
REAL(WORHP_DOUBLE) :: X(N),Mu(M),HM(HMnnz)
INTENT(in) :: N, M, HMnnz, HMrow, HMcol, X, Mu
INTENT(out) :: HM
! Dummy
END SUBROUTINE HESS
END MODULE WORHP_INTERFACE
program MAIN
USE WORHP_INTERFACE
USE Worhp_User
INTEGER (WORHP_INT) :: Mode, N, M, DFnnz, DGnnz, HMnnz
PARAMETER (N=6, M=2, DFnnz=1, DGnnz=12, HMnnz=12)
INTEGER (WORHP_INT) :: DFrow(DFnnz), DGrow(DGnnz), DGcol(DGnnz)
INTEGER (WORHP_INT) :: HMrow(HMnnz), HMcol(HMnnz)
INTEGER (WORHP_INT) :: Iparam(10)
REAL (WORHP_DOUBLE) :: X(N), L(N+M), U(N+M), Dparam(10)
REAL (WORHP_DOUBLE) :: Infty = 1d20
! Check Version of library and header files
CHECK_WORHP_VERSION
L = [9000.0, 0.0, 0.0, 0.0, 0.0, 0.0, 200000.0, 35786000.0]
U = [10000.0, 5.0, 180.0, 0.15, 180.0, 0.15, 200000.0, 35786000.0]
X = [9520.00, 1.47490136, 71.50755639, 0.09948622, 97.00248532, 0.09296147]
DFrow = [6]
DGrow = [1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2]
DGcol = [1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6]
HMrow = [1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2]
HMcol = [1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6]
! Get default parameter values
Mode = 0
CALL WorhpSimple(Mode, N, M, X, L, U, Dparam, Iparam, &
DFnnz, DFrow, DGnnz, DGrow, DGcol, HMnnz, HMrow, HMcol, &
OBJ, CON, DOBJ, DCON, HESS)
! User-defined derivatives are available
Iparam(1) = 1
Iparam(2) = 0
Iparam(3) = 0
! Run the solver
Mode = 1
CALL WorhpSimple(Mode, N, M, X, L, U, Dparam, Iparam, &
DFnnz, DFrow, DGnnz, DGrow, DGcol, HMnnz, HMrow, HMcol, &
OBJ, CON, DOBJ, DCON, HESS)
end
The function final_orbit called by the subroutine CON is contained in the module "problem_definition_tools".
For the compilation i use the following windows batch file called "compile.bat"
x86_64-w64-mingw32-gfortran src\MAIN.f90 -cpp -Iinclude -Ifinclude\worhp -Ifinclude\aerospace -Jobj -Lbin -lworhp -o bin\megaceppa.exe
which gives the error
undefined reference to '__problem_definition_tools_MOD_final_orbit'
I run the command from the directory 'Test' which has the following structure
\bin\
libworhp.dll
\finclude
\worhp\
std.mod
\aerospace\
problem_definition_tools.mod
\include
\worhp\
macros.h
\lib
libworhp.lib
\obj
worhp_interface.mod
\src
MAIN.f90
compile.bat
I would like to specify that the module "problem_definition_tools" is written by me, and i know for sure that it works because i already used it in another program. Moreover, i re-compiled it with x86_64-w64-mingw32-gfortran in order to avoid any compatibility issues with this program.
I am sure that there is something wrong in the way i call the compiler, but i can't figure it out because of my limited experience with Fortran. I also triend to search for similar questions on this website, but i couldn't find anything closely related to my problem.
I think it might be related to some declaration of final_orbit function.
It seems close to the following problem:
Linking fortran module: "undefined reference"
And I think the problem should be located in the code of module problem_definition_tools
Related
I have three functions that to the same thing but for different dummy argument types: flip, flipLogical and flipInt. Their very code is actually exactly the same! There is another function, called flip3D, which is only for real dummy arguments, that calls flip from its inside. This is the way that everything is working right now:
function flip(data)
real, dimension(:,:), intent(in) :: data
real, dimension(:,:), allocatable :: flip
integer :: m, n, i
m = size(data,1)
n = size(data,2)
allocate(flip(m,n))
do i=1,m
flip(m-i+1,:) = data(i,:)
end do
end function flip
function flipLogical(data)
logical, dimension(:,:), intent(in) :: data
logical, dimension(:,:), allocatable :: flipLogical
integer :: m, n, i
m = size(data,1)
n = size(data,2)
allocate(flipLogical(m,n))
do i=1,m
flipLogical(m-i+1,:) = data(i,:)
end do
end function flipLogical
function flipInt(data)
integer, dimension(:,:), intent(in) :: data
integer, dimension(:,:), allocatable :: flipInt
integer :: m, n, i
m = size(data,1)
n = size(data,2)
allocate(flipInt(m,n))
do i=1,m
flipInt(m-i+1,:) = data(i,:)
end do
end function flipInt
function flip3D(data)
real, dimension(:,:,:), intent(in) :: data
real, dimension(:,:,:), allocatable :: flip3D
integer :: m, n, o, j
m = size(data, 1)
n = size(data, 2)
o = size(data, 3)
allocate(flip3D(n, m, o))
do j = 1, o
flip3D(:,:,j) = flip(data(:,:,j))
end do
end function flip3D
Although this is working just fine, it is terrible ugly. I want to have a polymorphic function flip which just works for any type and that I can call from flip3D providing a real variable as dummy argument. I'm trying something like that:
function flip(data)
class(*), dimension(:,:), intent(in) :: data
class(*), dimension(:,:), allocatable :: flip
integer :: m, n, i
m = size(data,1)
n = size(data,2)
allocate(flip(m,n), mold=data)
do i=1,m
flip(m-i+1,:) = data(i,:)
end do
end function flip
but then I receive the errors
script.f90:698:7:
flip(m-i+1,:) = data(i,:)
1 Error: Nonallocatable variable must not be polymorphic in intrinsic assignment at (1) - check that there is a matching specific subroutine for '=' operator
script.f90:714:23:
flip3D(:,:,j) = flip(data(:,:,j))
1 Error: Can't convert CLASS(*) to REAL(4) at (1)
I would have done this with a generic function implemented via a template but note that
function flip(data)
class(*), dimension(:,:), intent(in) :: data
class(*), dimension(:,:), allocatable :: flip
integer :: i
flip = data([(i,i=m,1,-1)],:)
end function flip
compiles with gfortran.
EDIT: Given the template file flip.i90:
function Qflip(Qdata)
dimension Qdata(:,:)
intent(in) Qdata
dimension Qflip(size(Qdata,1),size(Qdata,2))
integer i
do i = 1, size(Qdata,1)
Qflip(size(Qdata,1)-i+1,:) = Qdata(i,:)
end do
end function Qflip
We can compile flip.f90:
module real_mod
implicit real(Q)
private
public flip
interface flip
module procedure Qflip
end interface flip
contains
include 'flip.i90'
end module real_mod
module Logical_mod
implicit Logical(Q)
private
public flip
interface flip
module procedure Qflip
end interface flip
contains
include 'flip.i90'
end module Logical_mod
module Int_mod
implicit integer(Q)
private
public flip
interface flip
module procedure Qflip
end interface flip
contains
include 'flip.i90'
end module Int_mod
module flip_mod
use real_mod
use Logical_mod
use Int_mod
end module flip_mod
program flipmeoff
use flip_mod
implicit none
real :: R(3,3) = reshape([ &
1, 2, 3, &
4, 5, 6, &
7, 8, 9],shape(R),order=[2,1])
Logical :: L(3,3) = reshape([ &
.TRUE., .TRUE., .FALSE., &
.FALSE., .TRUE., .FALSE., &
.FALSE., .FALSE., .TRUE.],shape(L),order=[2,1])
integer :: I(3,3) = reshape([ &
1, 2, 3, &
4, 5, 6, &
7, 8, 9],shape(I),order=[2,1])
write(*,'(3(f3.1:1x))') transpose(R)
write(*,'()')
write(*,'(3(f3.1:1x))') transpose(flip(R))
write(*,'()')
write(*,'(3(L1:1x))') transpose(L)
write(*,'()')
write(*,'(3(L1:1x))') transpose(flip(L))
write(*,'()')
write(*,'(3(i1:1x))') transpose(I)
write(*,'()')
write(*,'(3(i1:1x))') transpose(flip(I))
end program flipmeoff
And produce output:
1.0 2.0 3.0
4.0 5.0 6.0
7.0 8.0 9.0
7.0 8.0 9.0
4.0 5.0 6.0
1.0 2.0 3.0
T T F
F T F
F F T
F F T
F T F
T T F
1 2 3
4 5 6
7 8 9
7 8 9
4 5 6
1 2 3
It's unfortunate that Fortran doesn't allow you to rename intrinsic types like you can derived types. The consequence is that template files that can be used with intrinsic types have to use implicit typing.
The solution for this double integration is -0.083 but in the final compliation it appears -Infinity. It seems that the error is very simple, but I really can't find it.
I have been searching specially in the module section but I don't see why it appears like -Infinity. For example, if you change the two functions between them (x in f2 and x^2 in f1) the solution for the integration is 0.083 and the code gives it correct. Can annyone find the error? Thanks a lot.
module funciones
contains
function f(x,y)
implicit none
real*8:: x,y,f
f=2d0*x*y
end function
function f1(x)
real*8::x,f1
f1=x
end function
function f2(x)
real*8::x,f2
f2=x**2d0
end function
function g(x,c,d,h)
implicit none
integer::m,j
real*8::x,y,c,d,k,s,h,g
m=nint(((d-c)/h)+1d0)
k=(d-c)/dble(m)
s=0.
do j=1d0,m-1d0
y=c+dble(j)*k
s=s+f(x,y)
end do
g=k*(0.5d0*(f(x,c)+f(x,d))+s)
return
end function
subroutine trapecio(a,b,n,integral)
implicit none
integer::n,i
real*8::a,b,c,d,x,h,s,a1,a2,b1,b2,integral
h=(b-a)/dble(n)
s=0d0
do i=1d0,n-1d0
x=a+dble(i)*h
c=f1(x)
d=f2(x)
s=s+g(x,c,d,h)
end do
a1=f1(a)
a2=f2(a)
b1=f1(b)
b2=f2(b)
integral=h*(0.5d0*g(a,a1,a2,h)+0.5d0*g(b,b1,b2,h)+s)
end subroutine
end module
program main
use funciones
implicit none
integer::n,i
real*8::a,b,c,d,x,s,h,integral
print*, "introduzca los valores de a, b y n"
read(*,*) a, b, n
call trapecio (a,b,n,integral)
print*,integral
end program
The main program is simple, just calling the subroutine and using the module. It also prints the final result.
First of all, like mentioned in the comments: your problem is not clear. Which input parameters a, b and n do you use and which result do you expect?
Other than that: the code you posted used deprecated features and non-standard types and bad code style.
Some general hints:
real*8 is non-standard Fortran. Use real(real64) instead. real64 has to be imported by use :: iso_fotran_env, only: real64.
non-integer expressions (do i=1d0,n-1d0) in do-loops are a deleted feature in modern Fortran. Use integers instead.
code should be formatted with white spaces and indentations
print*, should be replaced with write(*,*)
code should always use English names
write implicit none in the beginning of the module, not for every function.
make the module/program interface clear by using the statements private, public, and only
if You want to convert to type real, use the function REAL instead of DBLE
I prefer the cleaner function definition using result
use intent keywords: intent(in) passes the variable as a const reference.
the variables c,d,x,s,h in the main program are unused. Compile with warnings to detect unused variables.
This is the code changed with the suggestions I made:
module funciones
use :: iso_fortran_env, only: real64
implicit none
private
public :: trapecio, r8
integer, parameter :: r8 = real64
contains
function f(x,y) result(value)
real(r8), intent(in) :: x,y
real(r8) :: value
value = 2._r8*x*y
end function
function f1(x) result(value)
real(r8), intent(in) :: x
real(r8) :: value
value = x
end function
function f2(x) result(value)
real(r8), intent(in) :: x
real(r8) :: value
value = x**2._r8
end function
function g(x,c,d,h) result(value)
real(r8), intent(in) :: x, c, d, h
real(r8) :: value
real(r8) :: y, k, s
integer :: m, j
m = NINT(((d-c)/h)+1._r8)
k = (d-c)/REAL(m, r8)
s = 0._r8
do j = 1, m-1
y = c + REAL(j,r8)*k
s = s + f(x,y)
end do
value = k*(0.5_r8*(f(x,c)+f(x,d))+s)
end function
subroutine trapecio(a, b, n, integral)
real(r8), intent(in) :: a, b
integer, intent(in) :: n
real(r8), intent(out) :: integral
integer :: i
real(r8) :: c, d, x, h, s, a1, a2, b1, b2
h = (b-a)/REAL(n,r8)
s = 0._r8
do i = 1, n-1
x = a + REAL(i,r8)*h
c = f1(x)
d = f2(x)
s = s + g(x,c,d,h)
end do
a1 = f1(a)
a2 = f2(a)
b1 = f1(b)
b2 = f2(b)
integral = h*(0.5_r8*g(a,a1,a2,h) + 0.5_r8*g(b,b1,b2,h) + s)
end subroutine
end module
program main
use funciones, only: trapecio, r8
implicit none
integer :: n,i
real(r8) :: a,b,integral
write(*,*) "introduzca los valores de a, b y n"
read(*,*) a, b, n
call trapecio (a,b,n,integral)
write(*,*) integral
end program
My problem is to pass the names of a series of functions contained in a module to a subroutine in a do loop.
I post part of my code. The modules are in two separate files compared to the main.
%%% FILE testKer_mod.f90
module kernel
implicit none
contains
! POLYNOMIAL
function poly(x, ts, ndim, a, param1, param2)
integer, intent (in) :: ndim
real*8, dimension(ndim), intent(in) :: x
real*8, dimension(ndim), intent(in) :: ts
real*8, intent(in) :: a, param1, param2
real*8 :: r
real*8 :: poly
r = (x(1:ndim) - ts(1:ndim))
poly = r**(.5*a)
end function poly
! GAUSSIAN
function gauss(x, ts, ndim, a, gamma, param2)
integer, intent (in) :: ndim
real*8, dimension(ndim), intent(in) :: x
real*8, dimension(ndim), intent(in) :: ts
real*8, intent(in) :: a, param2, gamma
real*8 :: r
real*8 :: gauss
r = (x(1:ndim) - ts(1:ndim))
gauss = exp(-(gamma*r)**a)
end function gauss
end module kernel
%%%
%%% FILE testSRBF_mod.f90
module srbf
implicit none
contains
subroutine weigth(nx, x, nts, ts, ndim, s, kernel, StocPar, param, coe, mat)
integer :: i,j,k,l,m,n
integer :: info
integer :: nx, nts, ndim
integer, dimension(nts) :: ipiv
real*8, dimension(nts) :: w
real*8, dimension(nts) :: s
real*8, dimension(2) :: param
real*8, dimension(nx,ndim) :: x
real*8, dimension(nts,ndim) :: ts
real*8, dimension(nx,nts) :: phi, mat
real*8, dimension(nts) :: coe
real*8 :: stocPar
interface
real*8 function kernel(x1, x2, n3, stov, p1, p2)
integer, intent (in) :: n3
real*8, dimension(n3), intent(in) :: x1
real*8, dimension(n3), intent(in) :: x2
real*8, intent(in) :: stov, p1, p2
end function kernel
end interface
do i = 1, nx
do j = 1, nts
phi(i,j) = kernel(x(i,1:ndim), ts(j,1:ndim), ndim, stocPar, param(1), param(2))
end do
end do
w = s
mat = phi
call DGESV(nts,1,mat,nts,ipiv,w,nts,info)
coe = w
end subroutine weigth
end module srbf
%%%
%%% MAIN PROGRAM test.f90
program MKRBF
use kernel
use srbf
implicit none
!real*8 :: SelKer
integer :: i,j,k
integer, parameter :: n = 3
integer, parameter :: nKer = 2
real*8, dimension(2,2) :: ParBound, auxpar
real*8, dimension(2) :: Bound
real*8, dimension(n) :: Var, func
real*8, dimension(n,nKer) :: coe
real*8, dimension(n,n) :: mat
!external SelKer
interface
real*8 function SelKer(ind)
integer, intent (in) :: ind
end function SelKer
end interface
Bound(1) = 0
Bound(2) = 5
ParBound(1,1) = 1
ParBound(1,2) = 5
ParBound(2,1) = 1
ParBound(2,2) = 5
auxpar(1,1) = 0
auxpar(1,2) = 0
auxpar(2,1) = 1
auxpar(2,2) = 1
var(:) = (/ 0., 2.5, 5. /)
do i = 1, n
func(i) = cos(3*Var(i)) * exp(-.25*Var(i));
end do
do i = 1, nKer
call weigth(n,Var,n,Var,1,func,SelKer(i),2.0D0,auxpar,coe,mat)
end do
end program MKRBF
function SelKer(indx)
integer, intent(in) :: indx
real*8 :: SelKer
select case (indx)
case (1)
SelKer = poly
case (2)
SelKer = gauss
end select
return
end function SelKer
%%%
I tried both with interface and with external but the program gives me the same error:
gfortran testKer_mod.f90 testSRBF_mod.f90 test.f90 -llapack -o test
test.f90:46:38:
call weigth(n,Var,n,Var,1,func,SelKer(i),2.0D0,auxpar,coe,mat)
1
Error: Expected a procedure for argument 'kernel' at (1)
How can I fix it?
Looking at the interface block in the main program
interface
real*8 function SelKer(ind)
integer, intent (in) :: ind
end function SelKer
end interface
SelKer is a function with real*8 result.1 SelKer(i) is such a function result. Crucially, SelKer(i) isn't a function with real*8 result, but such a real*8 value. weigth is expecting the argument for kernel to be a function (which is a procedure). This is the error message.
Coming to how the external function SelKer is implemented: we see such things as
SelKer = poly
In the function poly isn't the function poly in the module kernel but a local (default) real scalar variable (with undefined value). Note the lack of implicit none in the function.
Instead, you want to be looking to be using procedure pointers. This is a broad topic, so I'll just give an indication of the approach.
Move SelKer to be a procedure in the module kernel (removing the corresponding interface block from the main program).
Declare the function result SelKer to have type procedure(poly).
Use pointer assignment for the result, like SelKer => gauss.
There are other, perhaps better ways, to structure such a program. In particular, many would advise against using procedure pointer function results.
1 real*8 isn't standard Fortran.
This question already has answers here:
Why Segmentation fault is happening in this openmp code?
(2 answers)
Closed 6 years ago.
I have a very simple code.
program test_example
use iso_c_binding, only: c_double, c_int
implicit none
integer, parameter :: nelems = 500000
integer, parameter :: Np = 16, Nvar = 4, Nflux = 16
type mesh2d
real(c_double) :: u(Np, nelems)
real(c_double) :: uflux(Nflux, nelems)
real(c_double) :: ucommon(Nflux, nelems)
end type mesh2d
type(mesh2d) :: mesh
integer(c_int) :: i, j, k
!$OMP PARALLEL DO
do j = 1, nelems
do k = 1, Np
mesh%u(k, j) = j+k
end do
end do
!$END PARALLEL DO
end program test_example
I compile it using
gfortran -g temp.F90 -o main.exe -fopenmp
And it gives me segmentation fault. The same code runs fine if instead of using a derived type I simply used an array.
Is this a bug or am I doing something wrong.
I ran into your segfault conundrum on my laptop, but your code ran without a hitch on my powerful desktop machine. Your nelems = 500000 requires heap access. Following #Vladimir F suggestion I obtained the following:
This file was compiled by GCC version 5.4.0 20160609 using the options -cpp -imultiarch x86_64-linux-gnu -D_REENTRANT -mtune=generic -march=x86-64 -g -fopenmp
from
module type_Mesh2D
use iso_c_binding, only: &
wp => c_double, &
ip => c_int
! Explicit typing only
implicit none
! Everything is private unless stated otherwise
private
public :: wp, ip
public :: nelems, Np, Nvar, Nflux
public :: Mesh2D
integer (ip), parameter :: nelems = 500000
integer (ip), parameter :: Np = 16, Nvar = 4, Nflux = 16
type, public :: Mesh2D
real (wp), dimension (:,:), allocatable :: u, uflux, ucommon
end type Mesh2D
interface Mesh2D
module procedure allocate_arrays
module procedure default_allocate_arrays
end interface Mesh2D
contains
pure function allocate_arrays(n, m, k) result (return_value)
! Dummy arguments
integer (ip), intent (in) :: n, m, k
type (Mesh2D) :: return_value
allocate( return_value%u(n, m) )
allocate( return_value%uflux(k, m) )
allocate( return_value%ucommon(k, m) )
end function allocate_arrays
pure function default_allocate_arrays() result (return_value)
! Dummy arguments
type (Mesh2D) :: return_value
return_value = allocate_arrays(Np, nelems, Nflux)
end function default_allocate_arrays
end module type_Mesh2D
program test_example
use iso_fortran_env, only: &
compiler_version, compiler_options
use type_Mesh2D
! Explicit typing only
implicit none
type (Mesh2D) :: mesh
integer (ip) :: i, j, k
! Allocate memory
mesh = Mesh2D()
!$OMP PARALLEL DO
do j = 1, nelems
do k = 1, Np
mesh%u(k, j) = j + k
end do
end do
!$END PARALLEL DO
print '(4A)', &
'This file was compiled by ', compiler_version(), &
' using the options ', compiler_options()
end program test_example
I have seen this question being asked many times, but didn't find an answer that could resolve my issue. I want to be able to send a linked list, in Fortran, to another process through MPI. I have done something similar where the derived data type in the linked list was as follows
type a
{
integer :: varA
type(a), pointer :: next=>null()
real :: varB
}
The way I did this was to create an MPI datatype which contained all the varA values together, and receive it as an array of integers. Then do the same for varB.
What I am trying to do now is to create the linked list, and then pack all the varA and varB values together to form the MPI datatype. I give below the code that does this.
PROGRAM TEST
USE MPI
IMPLICIT NONE
TYPE a
INTEGER:: b
REAL :: e
TYPE(a), POINTER :: nextPacketInList => NULL()
END TYPE
TYPE PacketComm
INTEGER :: numPacketsToComm
TYPE(a), POINTER :: PacketListHeadPtr => NULL()
TYPE(a), POINTER :: PacketListTailPtr => NULL()
END TYPE PacketComm
TYPE(PacketComm), DIMENSION(:), ALLOCATABLE :: PacketCommArray
INTEGER :: packPacketDataType !New data type
INTEGER :: ierr, size, rank, dest, ind
integer :: b
real :: e
CALL MPI_INIT(ierr)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD, size, ierr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr)
IF(.NOT. ALLOCATED(PacketCommArray)) THEN
ALLOCATE(PacketCommArray(0:size-1), STAT=ierr)
DO ind=0, size-1
PacketCommArray(ind)%numPacketsToComm = 0
END DO
ENDIF
b = 2
e = 4
dest = 1
CALL addPacketToList(b, e, dest)
b = 3
e = 5
dest = 1
CALL addPacketToList(b, e, dest)
dest = 1
CALL packPacketList(dest)
IF(rank == 0) THEN
dest = 1
CALL sendPacketList(dest)
ELSE
CALL recvPacketList()
ENDIF
CALL MPI_FINALIZE(ierr)
CONTAINS
SUBROUTINE addPacketToList(b, e, rank)
IMPLICIT NONE
INTEGER :: b, rank, ierr
REAL :: e
TYPE(a), POINTER :: head
IF(.NOT. ASSOCIATED(PacketCommArray(rank)%PacketListHeadPtr)) THEN
ALLOCATE(PacketCommArray(rank)%PacketListHeadPtr, STAT=ierr)
PacketCommArray(rank)%PacketListHeadPtr%b = b
PacketCommArray(rank)%PacketListHeadPtr%e = e
PacketCommArray(rank)%PacketListHeadPtr%nextPacketInList => NULL()
PacketCommArray(rank)%PacketListTailPtr => PacketCommArray(rank)%PacketListHeadPtr
PacketCommArray(rank)%numPacketsToComm = PacketCommArray(rank)%numPacketsToComm+1
ELSE
ALLOCATE(PacketCommArray(rank)%PacketListTailPtr%nextPacketInList, STAT=ierr)
PacketCommArray(rank)%PacketListTailPtr => PacketCommArray(rank)%PacketListTailPtr%nextPacketInList
PacketCommArray(rank)%PacketListTailPtr%b = b
PacketCommArray(rank)%PacketListTailPtr%e = e
PacketCommArray(rank)%PacketListTailPtr%nextPacketInList => NULL()
PacketCommArray(rank)%numPacketsToComm = PacketCommArray(rank)%numPacketsToComm+1
ENDIF
END SUBROUTINE addPacketToList
SUBROUTINE packPacketList(rank)
IMPLICIT NONE
INTEGER :: rank
INTEGER :: numListNodes
INTEGER(kind=MPI_ADDRESS_KIND), DIMENSION(:), ALLOCATABLE :: listNodeAddr
INTEGER(kind=MPI_ADDRESS_KIND), DIMENSION(:), ALLOCATABLE :: listNodeDispl
INTEGER, DIMENSION(:), ALLOCATABLE :: listNodeTypes
INTEGER, DIMENSION(:), ALLOCATABLE :: listNodeCount
TYPE(a), POINTER :: head
INTEGER :: numNode
head => PacketCommArray(rank)%PacketListHeadPtr
numListNodes = PacketCommArray(rank)%numPacketsToComm
PRINT *, ' Number of nodes to allocate for rank ', rank , ' is ', numListNodes
ALLOCATE(listNodeTypes(2*numListNodes), stat=ierr)
ALLOCATE(listNodeCount(2*numListNodes), stat=ierr)
DO numNode=1, 2*numListNodes, 2
listNodeTypes(numNode) = MPI_INTEGER
listNodeTypes(numNode+1) = MPI_REAL
END DO
DO numNode=1, 2*numListNodes, 2
listNodeCount(numNode) = 1
listNodeCount(numNode+1) = 1
END DO
ALLOCATE(listNodeAddr(2*numListNodes), stat=ierr)
ALLOCATE(listNodeDispl(2*numListNodes), stat=ierr)
numNode = 1
DO WHILE(ASSOCIATED(head))
CALL MPI_GET_ADDRESS(head%b, listNodeAddr(numNode), ierr)
CALL MPI_GET_ADDRESS(head%e, listNodeAddr(numNode+1), ierr)
numNode = numNode + 2
head => head%nextPacketInList
END DO
DO numNode=1, UBOUND(listNodeAddr,1)
listNodeDispl(numNode) = listNodeAddr(numNode) - listNodeAddr(1)
END DO
CALL MPI_TYPE_CREATE_STRUCT(UBOUND(listNodeAddr,1), listNodeCount, listNodeDispl, listNodeTypes, packPacketDataType, ierr)
CALL MPI_TYPE_COMMIT(packPacketDataType, ierr)
END SUBROUTINE packPacketList
SUBROUTINE sendPacketList(rank)
IMPLICIT NONE
INTEGER :: rank, ierr, numNodes
TYPE(a), POINTER :: head
head => PacketCommArray(rank)%PacketListHeadPtr
numNodes = PacketCommArray(rank)%numPacketsToComm
CALL MPI_SSEND(head%b, 1, packPacketDataType, rank, 0, MPI_COMM_WORLD, ierr)
END SUBROUTINE sendPacketList
SUBROUTINE recvPacketList
IMPLICIT NONE
TYPE(a), POINTER :: head
TYPE(a), DIMENSION(:), ALLOCATABLE :: RecvPacketCommArray
INTEGER, DIMENSION(:), ALLOCATABLE :: recvB
INTEGER :: numNodes, ierr, numNode
INTEGER, DIMENSION(MPI_STATUS_SIZE):: status
head => PacketCommArray(rank)%PacketListHeadPtr
numNodes = PacketCommArray(rank)%numPacketsToComm
ALLOCATE(RecvPacketCommArray(numNodes), stat=ierr)
ALLOCATE(recvB(numNodes), stat=ierr)
CALL MPI_RECV(RecvPacketCommArray, 1, packPacketDataType, 0, 0, MPI_COMM_WORLD, status, ierr)
DO numNode=1, numNodes
PRINT *, ' value in b', RecvPacketCommArray(numNode)%b
PRINT *, ' value in e', RecvPacketCommArray(numNode)%e
END DO
END SUBROUTINE recvPacketList
END PROGRAM TEST
So basically I create a linked list with two nodes containing the following data
Node 1
b = 2, e = 4
Node 2
b = 3, e = 5
When I run this code on two cores, the results I get on core 1 are
value in b 2
value in e 4.000000
value in b 0
value in e 0.0000000E+00
So my code seems to send the data in the first node of the linked list correctly, but not the second one. Please could someone let me know if what I am trying to do is feasible, and what is wrong with the code. I know I can send the values of b in all nodes together and then the values of e together. But my derived data type will probably contain more variables (including arrays) and I want to be able to send all the data in one go instead of using multiple sends.
Thanks
It's not easy for me to read that code, but it seems like you are expecting the receiving buffer to get contiguous data, which is not the case. The strange type you construct by computing address offsets is not going to match the receiving buffer. To illustrate this, I though I might present this simple example (it's quickly written, don't take it as a good code example):
program example
use mpi
integer :: nprocs, myrank
integer :: buf(4)
integer :: n_elements
integer :: len_element(2)
integer(MPI_ADDRESS_KIND) :: disp_element(2)
integer :: type_element(2)
integer :: newtype
integer :: istat(MPI_STATUS_SIZE)
integer :: ierr
call mpi_init(ierr)
call mpi_comm_size(mpi_comm_world, nprocs, ierr)
call mpi_comm_rank(mpi_comm_world, myrank, ierr)
! simple example illustrating mpi_type_create_struct
! take an integer array buf(4):
! on rank 0: [ 7, 2, 6, 4 ]
! on rank 1: [ 1, 1, 1, 1 ]
! and we create a struct to send only elements 1 and 3
! so that on rank 1 we'll get [7, 1, 6, 1]
if (myrank == 0) then
buf = [7, 2, 6, 4]
else
buf = 1
end if
n_elements = 2
len_element = 1
disp_element(1) = 0
disp_element(2) = 8
type_element = MPI_INTEGER
call mpi_type_create_struct(n_elements, len_element, disp_element, type_element, newtype, ierr)
call mpi_type_commit(newtype, ierr)
write(6,'(1x,a,i2,1x,a,4i2)') 'SEND| rank ', myrank, 'buf = ', buf
if (myrank == 0) then
call mpi_send (buf, 1, newtype, 1, 13, MPI_COMM_WORLD, ierr)
else
call mpi_recv (buf, 1, newtype, 0, 13, MPI_COMM_WORLD, istat, ierr)
!the below call does not scatter the received integers, try to see the difference
!call mpi_recv (buf, 2, MPI_INTEGER, 0, 13, MPI_COMM_WORLD, istat, ierr)
end if
write(6,'(1x,a,i2,1x,a,4i2)') 'RECV| rank ', myrank, 'buf = ', buf
end program
I hope this clearly shows that the receiving buffer will have to accommodate any offsets in the constructed type, and does not receive any contiguous data.
EDIT: updated the code to illustrate a different receive type that does not scatter the data.