More Fortran functions

eschnett · Nov 27, 2023 · 3aa7677 · 3aa7677
1 parent b7b3186
commit 3aa7677
Show file tree

Hide file tree

Showing 2 changed files with 75 additions and 14 deletions.
diff --git a/mpiwrapper/mpiwrapper.F90 b/mpiwrapper/mpiwrapper.F90
@@ -51,6 +51,20 @@ end function mpi2abi_unreserved
 
   ! Translate (non-handle) integers
 
+  integer function abi2mpi_distrib(distrib)
+    integer, intent(in) :: distrib
+    select case (distrib)
+    case (MPIABI_DISTRIBUTE_BLOCK)
+       abi2mpi_distrib = MPI_DISTRIBUTE_BLOCK
+    case (MPIABI_DISTRIBUTE_CYCLIC)
+       abi2mpi_distrib = MPI_DISTRIBUTE_CYCLIC
+    case (MPIABI_DISTRIBUTE_NONE)
+       abi2mpi_distrib = MPI_DISTRIBUTE_NONE
+    case default
+       call assert(.false.)
+    end select
+  end function abi2mpi_distrib
+
   elemental integer function abi2mpi_errorcode(errorcode)
     integer, intent(in) :: errorcode
     ! Fast path
@@ -333,6 +347,30 @@ elemental integer function mpi2abi_errorcode(errorcode)
     end select
   end function mpi2abi_errorcode
 
+  integer function abi2mpi_order(order)
+    integer, intent(in) :: order
+    select case (order)
+    case (MPIABI_ORDER_C)
+       abi2mpi_order = MPI_ORDER_C
+    case (MPIABI_ORDER_Fortran)
+       abi2mpi_order = MPI_ORDER_Fortran
+    case default
+       call assert(.false.)
+    end select
+  end function abi2mpi_order
+
+  integer function mpi2abi_order(order)
+    integer, intent(in) :: order
+    select case (order)
+    case (MPI_ORDER_C)
+       mpi2abi_order = MPIABI_ORDER_C
+    case (MPI_ORDER_Fortran)
+       mpi2abi_order = MPIABI_ORDER_Fortran
+    case default
+       call assert(.false.)
+    end select
+  end function mpi2abi_order
+
   integer function abi2mpi_proc(proc)
     integer, intent(in) :: proc
     select case (proc)

diff --git a/mpiwrapper/mpiwrapper_functions.F90 b/mpiwrapper/mpiwrapper_functions.F90
@@ -1225,13 +1225,33 @@ subroutine MPIABI_Type_contiguous(count, oldtype, newtype, ierror)
   ierror = mpi2abi_errorcode(ierror)
 end subroutine MPIABI_Type_contiguous
 
-! subroutine MPIABI_Type_create_darray(size, rank, ndims, array_of_gsizes, array_of_distribs, array_of_dargs, array_of_psizes, order, oldtype, newtype, ierror)
-!   use mpiwrapper
-!   implicit none
-!   call MPI_Type_create_darray(size, rank, ndims, array_of_gsizes, array_of_distribs, array_of_dargs, array_of_psizes, order, oldtype, newtype, ierror)
-!   ierror = mpi2abi_errorcode(ierror)
-! end subroutine MPIABI_Type_create_darray
-! 
+subroutine MPIABI_Type_create_darray(size, rank, ndims, array_of_gsizes, array_of_distribs, array_of_dargs, array_of_psizes, &
+     order, oldtype, newtype, ierror)
+  use mpiwrapper
+  implicit none
+  integer, intent(in) :: size
+  integer, intent(in) :: rank
+  integer, intent(in) :: ndims
+  integer, intent(in) :: array_of_gsizes(ndims)
+  integer, intent(in) :: array_of_distribs(ndims)
+  integer, intent(in) :: array_of_dargs(ndims)
+  integer, intent(in) :: array_of_psizes(ndims)
+  integer, intent(in) :: order
+  integer, intent(in) :: oldtype
+  integer, intent(out) :: newtype
+  integer, intent(out) :: ierror
+  integer wrap_array_of_distribs(ndims)
+  integer wrap_newtype
+  integer n
+  do n = 1, ndims
+     wrap_array_of_distribs(n) = abi2mpi_distrib(array_of_distribs(n))
+  end do
+  call MPI_Type_create_darray(size, rank, ndims, array_of_gsizes, array_of_distribs, array_of_dargs, array_of_psizes, &
+       abi2mpi_order(order), abi2mpi_datatype(oldtype), wrap_newtype, ierror)
+  newtype = mpi2abi_datatype(newtype)
+  ierror = mpi2abi_errorcode(ierror)
+end subroutine MPIABI_Type_create_darray
+
 ! subroutine MPIABI_Type_create_darray_c(size, rank, ndims, array_of_gsizes, array_of_distribs, array_of_dargs, array_of_psizes, order, oldtype, newtype, ierror)
 !   use mpiwrapper
 !   implicit none
@@ -3951,13 +3971,16 @@ subroutine MPIABI_File_close(fh, ierror)
   ierror = mpi2abi_errorcode(ierror)
 end subroutine MPIABI_File_close
 
-! subroutine MPIABI_File_delete(filename, info, ierror)
-!   use mpiwrapper
-!   implicit none
-!   call MPI_File_delete(filename, info, ierror)
-!   ierror = mpi2abi_errorcode(ierror)
-! end subroutine MPIABI_File_delete
-! 
+subroutine MPIABI_File_delete(filename, info, ierror)
+  use mpiwrapper
+  implicit none
+  character(*), intent(in) :: filename
+  integer, intent(in) :: info
+  integer, intent(out) :: ierror
+  call MPI_File_delete(filename, abi2mpi_info(info), ierror)
+  ierror = mpi2abi_errorcode(ierror)
+end subroutine MPIABI_File_delete
+
 ! subroutine MPIABI_File_get_amode(fh, amode, ierror)
 !   use mpiwrapper
 !   implicit none