feat: create co_min implementation

Author: everythingfunctional

src/caffeine/collective_subroutines/co_max_s.f90

@@ -10,4 +10,8 @@
     call unimplemented("prif_co_max")
   end procedure
 
+  module procedure prif_co_max_character
+    call unimplemented("prif_co_max_character")
+  end procedure
+
 end submodule co_max_s

src/caffeine/collective_subroutines/co_min_s.f90

@@ -1,13 +1,60 @@
 ! Copyright (c), The Regents of the University of California
 ! Terms of use are as specified in LICENSE.txt
 submodule(prif:prif_private_s) co_min_s
-
+  use iso_c_binding, only: c_loc, c_f_pointer
   implicit none
 
 contains
 
   module procedure prif_co_min
-    call unimplemented("prif_co_min")
+    call contiguous_co_min(a, result_image, stat, errmsg, errmsg_alloc)
+  end procedure
+
+  subroutine contiguous_co_min(a, result_image, stat, errmsg, errmsg_alloc)
+    implicit none
+    type(*), intent(inout), target, contiguous :: a(..)
+    integer(c_int), intent(in), optional :: result_image
+    integer(c_int), intent(out), optional :: stat
+    character(len=*), intent(inout), optional :: errmsg
+    character(len=:), intent(inout), allocatable, optional :: errmsg_alloc
+
+    if (present(stat)) stat=0
+
+    call caf_co_min( &
+          a, &
+          optional_value(result_image), &
+          int(product(shape(a)), c_size_t), &
+          current_team%info%gex_team)
+  end subroutine
+
+  module procedure prif_co_min_character
+    call unimplemented("prif_co_min_character")
+    ! integer(c_size_t), target :: char_len
+    ! procedure(prif_operation_wrapper_interface), pointer :: op
+
+    ! char_len = len(a)
+    ! op => char_min_wrapper
+    ! call prif_co_reduce(a, op, c_loc(char_len), result_image, stat, errmsg, errmsg_alloc)
   end procedure
 
+  ! subroutine char_min_wrapper(arg1, arg2_and_out, count, cdata) bind(C)
+  !   type(c_ptr), intent(in), value :: arg1, arg2_and_out
+  !   integer(c_size_t), intent(in), value :: count
+  !   type(c_ptr), intent(in), value :: cdata
+
+  !   integer(c_size_t), pointer :: char_len
+  !   integer(c_size_t) :: i
+
+  !   if (count == 0) return
+  !   call c_f_pointer(cdata, char_len)
+  !   block
+  !     character(len=char_len,kind=c_char), pointer :: lhs(:), rhs_and_result(:)
+  !     call c_f_pointer(arg1, lhs, [count])
+  !     call c_f_pointer(arg2_and_out, rhs_and_result, [count])
+  !     do i = 1, count
+  !       if (lhs(i) <= rhs_and_result(i)) rhs_and_result(i) = lhs(i)
+  !     end do
+  !   end block
+  ! end subroutine
+
 end submodule co_min_s

src/prif.F90

@@ -29,6 +29,7 @@ module prif
   public :: prif_failed_images, prif_stopped_images, prif_image_status
   public :: prif_local_data_pointer, prif_set_context_data, prif_get_context_data, prif_size_bytes
   public :: prif_co_sum, prif_co_max, prif_co_min, prif_co_reduce, prif_co_broadcast
+  public :: prif_co_min_character, prif_co_max_character
   public :: prif_operation_wrapper_interface
   public :: prif_form_team, prif_change_team, prif_end_team, prif_get_team, prif_team_number
   public :: prif_sync_all, prif_sync_images, prif_sync_team, prif_sync_memory

test/caf_co_min_test.f90

@@ -1,5 +1,6 @@
 module caf_co_min_test
-    use prif, only : prif_co_min, prif_this_image_no_coarray, prif_num_images
+    use iso_c_binding, only: c_int32_t, c_int64_t, c_float, c_double
+    use prif, only : prif_co_min, prif_co_min_character, prif_this_image_no_coarray, prif_num_images
     use veggies, only: result_t, test_item_t, assert_equals, describe, it, succeed
 
     implicit none
@@ -22,27 +23,91 @@ function test_prif_co_min() result(tests)
 
     function check_32_bit_integer() result(result_)
         type(result_t) :: result_
-        result_ = succeed("temporarily")
+
+        integer(c_int32_t), parameter :: values(*) = [1, 19, 5, 13, 11, 7, 17, 3]
+        integer :: me, ni, i
+        integer(c_int32_t) :: my_val, expected
+
+        call prif_this_image_no_coarray(this_image=me)
+        call prif_num_images(ni)
+
+        my_val = values(mod(me-1, size(values))+1)
+        call prif_co_min(my_val)
+
+        expected = minval([(values(mod(i-1,size(values))+1), i = 1, ni)])
+        result_ = assert_equals(expected, my_val)
     end function
 
     function check_64_bit_integer() result(result_)
         type(result_t) :: result_
-        result_ = succeed("temporarily")
+
+        integer(c_int64_t), parameter :: values(*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2, 4])
+        integer :: me, ni, i
+        integer(c_int64_t), dimension(size(values,1)) :: my_val, expected
+
+        call prif_this_image_no_coarray(this_image=me)
+        call prif_num_images(ni)
+
+        my_val = values(:, mod(me-1, size(values,2))+1)
+        call prif_co_min(my_val)
+
+        expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2)
+        result_ = assert_equals(int(expected), int(my_val))
     end function
 
     function check_32_bit_real() result(result_)
         type(result_t) :: result_
-        result_ = succeed("temporarily")
+
+        real(c_float), parameter :: values(*,*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2,2,2])
+        integer :: me, ni, i
+        real(c_float), dimension(size(values,1), size(values,2)) :: my_val, expected
+
+        call prif_this_image_no_coarray(this_image=me)
+        call prif_num_images(ni)
+
+        my_val = values(:, :, mod(me-1, size(values,3))+1)
+        call prif_co_min(my_val)
+
+        expected = minval(reshape([(values(:,:,mod(i-1,size(values,3))+1), i = 1, ni)], [size(values,1), size(values,2), ni]), dim=3)
+        result_ = assert_equals(real(expected,kind=c_double), real(my_val,kind=c_double))
     end function
 
     function check_64_bit_real() result(result_)
         type(result_t) :: result_
-        result_ = succeed("temporarily")
+
+        real(c_double), parameter :: values(*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2, 4])
+        integer :: me, ni, i
+        real(c_double), dimension(size(values,1)) :: my_val, expected
+
+        call prif_this_image_no_coarray(this_image=me)
+        call prif_num_images(ni)
+
+        my_val = values(:, mod(me-1, size(values,2))+1)
+        call prif_co_min(my_val)
+
+        expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2)
+        result_ = assert_equals(expected, my_val)
     end function
 
     function check_character() result(result_)
-        type(result_t) :: result_
-        result_ = succeed("temporarily")
+        type(result_t) result_
+        result_ = succeed("skip for now")
+        ! character(len=*), parameter :: values(*) = &
+        !     [ "To be   ","or not  " &
+        !     , "to      ","be.     " &
+        !     , "that    ","is      " &
+        !     , "the     ","question"]
+        ! integer :: me, ni, i
+        ! character(len=len(values)) :: my_val, expected
+
+        ! call prif_this_image_no_coarray(this_image=me)
+        ! call prif_num_images(ni)
+
+        ! my_val = values(mod(me-1, size(values))+1)
+        ! call prif_co_min_character(my_val)
+
+        ! expected = minval([(values(mod(i-1,size(values))+1), i = 1, ni)])
+        ! result_ = assert_equals(expected, my_val)
     end function
 
 end module caf_co_min_test