Reputation: 1
I am just trying to write in a collective way in MPI Fortran from a CFD code. In each process, data are divided in blocks, with a general number of cells, and a structure var(b)
is created which hosts the two variables r
and p
of the block b
. Then a double MPI structure derived type is created to collect all data in a process, the first type collecting all variables in a block, and the second one all the structures in a block. So, each process has to write one of this double derived datatype, where the offset is evaluated all the data amount in the previous processes (0 for rank 0, all data in the rank 0 for rank 1, and so one). The code is the following
module var_mod
type vt
sequence
double precision,dimension(:,:,:),allocatable :: r,p
end type vt
type(vt),target,dimension(:),allocatable :: var
end module var_mod
PROGRAM main
USE MPI_F08
USE var_mod
IMPLICIT NONE
! FILES
INTEGER,PARAMETER :: NB = 4
!----------------------------------------------------------------
INTEGER :: b,i,j,k,me,np
TYPE(MPI_File) :: mpifh
INTEGER(KIND=MPI_OFFSET_KIND) :: mpidisp,sum_dim
integer,dimension(:),allocatable :: ni,nj,nk,mpiblock,mpistride
integer :: cont,mpierr
INTEGER,dimension(nb) :: Blocks
INTEGER(KIND=MPI_ADDRESS_KIND),dimension(:),allocatable :: Offsets,Pos
INTEGER(KIND=MPI_COUNT_KIND) :: lb, ext8
TYPE(MPI_Datatype),dimension(:),allocatable :: Elem_Type,Types
TYPE(MPI_Datatype) :: All_Type,mpiparflowtype
TYPE(MPI_Status) :: status
CHARACTER(LEN=MPI_MAX_ERROR_STRING) :: string
INTEGER :: resultlen
!----------------------------------------------------------------
call mpi_init
call mpi_comm_size(mpi_comm_world,np)
call mpi_comm_rank(mpi_comm_world,me)
allocate (ni(nb))
allocate (nj(nb))
allocate (nk(nb))
allocate (var(nb))
do b = 1,NB
ni(b) = b/3+1
nj(b) = b
nk(b) = b/5+1
allocate (var(b)%r(ni(b),nj(b),nk(b)))
allocate (var(b)%p(ni(b),nj(b),nk(b)))
END DO
!
! Initialize the data
!
do b = 1,nb
DO k = 1,nk(b)
DO j = 1,nj(b)
DO i = 1,ni(b)
var(b)%r(i,j,k) = 10000*me+1000*b+i*100+j*10+k
var(b)%p(i,j,k) = -var(b)%r(i,j,k)
END DO
END DO
END DO
end do
! (1) Create a separate structure datatype for each record
allocate (Offsets(2),Pos(2),Types(2),Elem_Type(nb))
DO b = 1,nb
CALL MPI_GET_ADDRESS(var(b)%r,POS(1))
CALL MPI_GET_ADDRESS(var(b)%p,POS(2))
Offsets = POS-POS(1)
Types = MPI_REAL8
Blocks = ni(b)*nj(b)*nk(b)
CALL MPI_TYPE_CREATE_STRUCT(2,Blocks,Offsets,Types,Elem_Type(b),mpierr)
END DO
deallocate (Offsets,Pos,Types)
! Create a structure of structures that describes the whole array
allocate (Offsets(nb),Pos(nb))
Blocks = 1
DO b = 1,nb
CALL MPI_GET_ADDRESS(var(b)%r,POS(b))
END DO
Offsets = POS-POS(1)
CALL MPI_TYPE_CREATE_STRUCT(nb,Blocks,Offsets,Elem_Type,All_Type)
CALL MPI_TYPE_COMMIT(All_Type,mpierr)
! Free the intermediate datatypes
DO b = 1,nb
CALL MPI_TYPE_FREE(Elem_Type(b))
END DO
deallocate(Offsets,Pos,Elem_Type)
! Set index
cont = 1
allocate(mpiblock(cont))
allocate(mpistride(cont))
mpiblock=1
mpistride=0
call MPI_TYPE_INDEXED(cont,mpiblock,mpistride,All_Type,mpiparflowtype)
call MPI_TYPE_COMMIT(mpiparflowtype)
deallocate(mpiblock,mpistride)
! Position where to write
CALL MPI_Type_get_extent(MPI_REAL8, lb, ext8)
mpidisp = 0
do b = 1,nb
mpidisp = mpidisp + (ni(b)*nj(b)*nk(b)) ! number of cell in the block b
end do
mpidisp = mpidisp*2*ext8*me !multiply for number of variables and byte of each variable and shif to the process rank
! Open file
call MPI_FILE_OPEN(MPI_COMM_WORLD,'MPIDATA',IOR(MPI_MODE_CREATE,MPI_MODE_WRONLY),MPI_INFO_NULL,mpifh)
! setting file view
call MPI_FILE_SET_VIEW(mpifh,mpidisp,All_Type,mpiparflowtype,'native',MPI_INFO_NULL,mpierr)
write(*,*) me,'error on file set view:',mpierr
call MPI_Error_string(mpierr, string, resultlen)
write(*,*) 'string:',trim(string),resultlen
! MPI Write file
call MPI_FILE_WRITE_ALL(mpifh,var(1)%r,1,All_Type,status)
! Close file
call MPI_FILE_CLOSE(mpifh)
! deallocations and free
CALL MPI_TYPE_FREE(All_Type)
CALL MPI_TYPE_FREE(mpiparflowtype)
do b = 1,nb
deallocate (var(b)%r,var(b)%p)
END DO
deallocate (var)
deallocate (ni,nj,nk)
! end
call mpi_finalize
END PROGRAM main
When the code is launched, for instance, on two processes (both Intel and gnu compilers no problem in compilation phase), the run concludes but an error MPI_TYPE_ERR in MPI_FILE_SET_VIEW is issued and the data file contains only rank 0 data.
I would expect a file with data from all ranks, but I can not understand what the problem is.
Upvotes: 0
Views: 59