0

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.

artu72
  • 1
  • 2
  • 1
    Please show us the exact error output. – Vladimir F Героям слава Nov 08 '22 at 15:26
  • 1
    Do you ever commit `Elem_Type(b)`? – Victor Eijkhout Nov 08 '22 at 15:47
  • @VladimirFГероямслава : as I said, there is no stopping error in the code, but the MPI_FILE_SET_VIEW return with mpierr = MPI_ERR_TYPE code. – artu72 Nov 08 '22 at 15:59
  • @VictorEijkhout : that commit is not necessary since I do not use Elem_type(b) in operative MPI calls. However, even including it, the result remains the same. – artu72 Nov 08 '22 at 15:59
  • If I use ` MPI_ERROR_STRING` to turn the error code into something more understandable I get `MPI_ERR_TYPE: invalid datatype`. So it looks as though you are setting up your datatype incorrectly somehow. This is with gfortran 9.4 and openmpi 4.0.3 – Ian Bush Nov 09 '22 at 09:24
  • @IanBush : thank you, I suspect that my `All_Type` derived datatype is not suitable to be used in a collective data writing since it is not portable (see Section 2.4.3) of the MPI Forum manual, version 4. I have tested replacing in the code `All_Type` with a simple `MPI_INTEGER` datatype and it works flawlessly. – artu72 Nov 09 '22 at 14:36
  • 1
    I think it would be a good idea if OP wrote their comment up into an answer. Sure, it might be criticised for answering a question which can be resolved by reference to the documentation, but it's quite deep in there. And none of the local MPI experts spotted it. – High Performance Mark Nov 09 '22 at 16:47

0 Answers0