diff --git a/src/caffeine/alias_m.f90 b/src/caffeine/alias_m.f90 new file mode 100644 index 00000000..299fdabe --- /dev/null +++ b/src/caffeine/alias_m.f90 @@ -0,0 +1,28 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +module alias_m + use iso_c_binding, only: c_intmax_t + use allocation_m, only: prif_coarray_handle + + implicit none + private + public :: prif_alias_create, prif_alias_destroy + + interface + + module subroutine prif_alias_create(source_handle, alias_co_lbounds, alias_co_ubounds, alias_handle) + implicit none + type(prif_coarray_handle), intent(in) :: source_handle + integer(c_intmax_t), intent(in) :: alias_co_lbounds(:) + integer(c_intmax_t), intent(in) :: alias_co_ubounds(:) + type(prif_coarray_handle), intent(out) :: alias_handle + end subroutine + + module subroutine prif_alias_destroy(alias_handle) + implicit none + type(prif_coarray_handle), intent(in) :: alias_handle + end subroutine + + end interface + +end module alias_m diff --git a/src/caffeine/alias_s.f90 b/src/caffeine/alias_s.f90 new file mode 100644 index 00000000..b9c7934a --- /dev/null +++ b/src/caffeine/alias_s.f90 @@ -0,0 +1,15 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +submodule(alias_m) alias_s + + implicit none + +contains + + module procedure prif_alias_create + end procedure + + module procedure prif_alias_destroy + end procedure + +end submodule alias_s diff --git a/src/caffeine/allocation_m.f90 b/src/caffeine/allocation_m.f90 index ade54604..62084f3d 100644 --- a/src/caffeine/allocation_m.f90 +++ b/src/caffeine/allocation_m.f90 @@ -4,7 +4,7 @@ module allocation_m use iso_c_binding, only: c_ptr, c_int, c_intmax_t, c_size_t, c_funptr implicit none private - public :: prif_allocate + public :: prif_allocate, prif_allocate_non_symmetric, prif_deallocate, prif_deallocate_non_symmetric type, public :: prif_coarray_handle @@ -28,6 +28,31 @@ module subroutine prif_allocate( & character(len=:), intent(inout), allocatable, optional :: errmsg_alloc end subroutine + module subroutine prif_allocate_non_symmetric(size_in_bytes, allocated_memory, stat, errmsg, errmsg_alloc) + implicit none + integer(kind=c_size_t) :: size_in_bytes + type(c_ptr), intent(out) :: allocated_memory + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + + module subroutine prif_deallocate(coarray_handles, stat, errmsg, errmsg_alloc) + implicit none + type(prif_coarray_handle), intent(in) :: coarray_handles(:) + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + + module subroutine prif_deallocate_non_symmetric(mem, stat, errmsg, errmsg_alloc) + implicit none + type(c_ptr), intent(in) :: mem + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + end interface end module allocation_m diff --git a/src/caffeine/allocation_s.f90 b/src/caffeine/allocation_s.f90 index c68d22d3..abbd77e3 100644 --- a/src/caffeine/allocation_s.f90 +++ b/src/caffeine/allocation_s.f90 @@ -13,4 +13,13 @@ product(ubounds-lbounds+1)*element_length, size(ucobounds), lcobounds, ucobounds, final_func, coarray_handle%ptr) end procedure + module procedure prif_allocate_non_symmetric + end procedure + + module procedure prif_deallocate + end procedure + + module procedure prif_deallocate_non_symmetric + end procedure + end submodule allocation_s diff --git a/src/caffeine/assert/assert_m.F90 b/src/caffeine/assert/assert_m.F90 index 37ba0012..efd36200 100644 --- a/src/caffeine/assert/assert_m.F90 +++ b/src/caffeine/assert/assert_m.F90 @@ -31,7 +31,7 @@ module caffeine_assert_m interface - pure module subroutine assert(assertion, description, diagnostic_data) + module subroutine assert(assertion, description, diagnostic_data) !! If assertion is .false., error-terminate with a character stop code that contains diagnostic_data if present implicit none logical, intent(in) :: assertion diff --git a/src/caffeine/assert/assert_s.f90 b/src/caffeine/assert/assert_s.f90 index 056c4b10..f947b927 100644 --- a/src/caffeine/assert/assert_s.f90 +++ b/src/caffeine/assert/assert_s.f90 @@ -13,7 +13,7 @@ module procedure assert use caffeine_characterizable_m, only : characterizable_t use program_termination_m, only: prif_error_stop - use image_enumeration_m, only: this_image => prif_this_image + use image_queries_m, only: this_image => prif_this_image character(len=:), allocatable :: header, trailer integer :: me diff --git a/src/caffeine/atomic_m.f90 b/src/caffeine/atomic_m.f90 new file mode 100644 index 00000000..03dabf14 --- /dev/null +++ b/src/caffeine/atomic_m.f90 @@ -0,0 +1,151 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +module atomic_m + use iso_c_binding, only: c_intptr_t, c_int + use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind + + implicit none + private + public :: prif_atomic_add, prif_atomic_and, prif_atomic_or, prif_atomic_xor, prif_atomic_cas, prif_atomic_fetch_add + public :: prif_atomic_fetch_and, prif_atomic_fetch_or, prif_atomic_fetch_xor, prif_atomic_define, prif_atomic_ref + + interface prif_atomic_cas + module procedure prif_atomic_cas_int + module procedure prif_atomic_cas_logical + end interface + + interface prif_atomic_define + module procedure prif_atomic_define_int + module procedure prif_atomic_define_logical + end interface + + interface prif_atomic_ref + module procedure prif_atomic_ref_int + module procedure prif_atomic_ref_logical + end interface + + interface + + module subroutine prif_atomic_add(atom_remote_ptr, image_num, value, stat) + implicit none + integer(c_intptr_t), intent(in) :: atom_remote_ptr + integer(c_int), intent(in) :: image_num + integer(atomic_int_kind), intent(in) :: value + integer(c_int), intent(out), optional :: stat + end subroutine + + module subroutine prif_atomic_and(atom_remote_ptr, image_num, value, stat) + implicit none + integer(c_intptr_t), intent(in) :: atom_remote_ptr + integer(c_int), intent(in) :: image_num + integer(atomic_int_kind), intent(in) :: value + integer(c_int), intent(out), optional :: stat + end subroutine + + module subroutine prif_atomic_or(atom_remote_ptr, image_num, value, stat) + implicit none + integer(c_intptr_t), intent(in) :: atom_remote_ptr + integer(c_int), intent(in) :: image_num + integer(atomic_int_kind), intent(in) :: value + integer(c_int), intent(out), optional :: stat + end subroutine + + module subroutine prif_atomic_xor(atom_remote_ptr, image_num, value, stat) + implicit none + integer(c_intptr_t), intent(in) :: atom_remote_ptr + integer(c_int), intent(in) :: image_num + integer(atomic_int_kind), intent(in) :: value + integer(c_int), intent(out), optional :: stat + end subroutine + + module subroutine prif_atomic_cas_int(atom_remote_ptr, image_num, old, compare, new, stat) + implicit none + integer(c_intptr_t), intent(in) :: atom_remote_ptr + integer(c_int), intent(in) :: image_num + integer(atomic_int_kind), intent(out) :: old + integer(atomic_int_kind), intent(in) :: compare + integer(atomic_int_kind), intent(in) :: new + integer(c_int), intent(out), optional :: stat + end subroutine + + module subroutine prif_atomic_cas_logical(atom_remote_ptr, image_num, old, compare, new, stat) + implicit none + integer(c_intptr_t), intent(in) :: atom_remote_ptr + integer(c_int), intent(in) :: image_num + logical(atomic_logical_kind), intent(out) :: old + logical(atomic_logical_kind), intent(in) :: compare + logical(atomic_logical_kind), intent(in) :: new + integer(c_int), intent(out), optional :: stat + end subroutine + + module subroutine prif_atomic_fetch_add(atom_remote_ptr, image_num, value, old, stat) + implicit none + integer(c_intptr_t), intent(in) :: atom_remote_ptr + integer(c_int), intent(in) :: image_num + integer(atomic_int_kind), intent(in) :: value + integer(atomic_int_kind), intent(out) :: old + integer(c_int), intent(out), optional :: stat + end subroutine + + module subroutine prif_atomic_fetch_and(atom_remote_ptr, image_num, value, old, stat) + implicit none + integer(c_intptr_t), intent(in) :: atom_remote_ptr + integer(c_int), intent(in) :: image_num + integer(atomic_int_kind), intent(in) :: value + integer(atomic_int_kind), intent(out) :: old + integer(c_int), intent(out), optional :: stat + end subroutine + + module subroutine prif_atomic_fetch_or(atom_remote_ptr, image_num, value, old, stat) + implicit none + integer(c_intptr_t), intent(in) :: atom_remote_ptr + integer(c_int), intent(in) :: image_num + integer(atomic_int_kind), intent(in) :: value + integer(atomic_int_kind), intent(out) :: old + integer(c_int), intent(out), optional :: stat + end subroutine + + module subroutine prif_atomic_fetch_xor(atom_remote_ptr, image_num, value, old, stat) + implicit none + integer(c_intptr_t), intent(in) :: atom_remote_ptr + integer(c_int), intent(in) :: image_num + integer(atomic_int_kind), intent(in) :: value + integer(atomic_int_kind), intent(out) :: old + integer(c_int), intent(out), optional :: stat + end subroutine + + module subroutine prif_atomic_define_int(atom_remote_ptr, image_num, value, stat) + implicit none + integer(c_intptr_t), intent(in) :: atom_remote_ptr + integer(c_int), intent(in) :: image_num + integer(atomic_int_kind), intent(in) :: value + integer(c_int), intent(out), optional :: stat + end subroutine + + module subroutine prif_atomic_define_logical(atom_remote_ptr, image_num, value, stat) + implicit none + integer(c_intptr_t), intent(in) :: atom_remote_ptr + integer(c_int), intent(in) :: image_num + logical(atomic_logical_kind), intent(in) :: value + integer(c_int), intent(out), optional :: stat + end subroutine + + module subroutine prif_atomic_ref_int(value, atom_remote_ptr, image_num, stat) + implicit none + integer(atomic_int_kind), intent(out) :: value + integer(c_intptr_t), intent(in) :: atom_remote_ptr + integer(c_int), intent(in) :: image_num + integer(c_int), intent(out), optional :: stat + end subroutine + + module subroutine prif_atomic_ref_logical(value, atom_remote_ptr, image_num, stat) + implicit none + logical(atomic_logical_kind), intent(out) :: value + integer(c_intptr_t), intent(in) :: atom_remote_ptr + integer(c_int), intent(in) :: image_num + integer(c_int), intent(out), optional :: stat + end subroutine + + end interface + +end module atomic_m diff --git a/src/caffeine/atomic_s.f90 b/src/caffeine/atomic_s.f90 new file mode 100644 index 00000000..6582a808 --- /dev/null +++ b/src/caffeine/atomic_s.f90 @@ -0,0 +1,51 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +submodule(atomic_m) atomic_s + + implicit none + +contains + + module procedure prif_atomic_add + end procedure + + module procedure prif_atomic_and + end procedure + + module procedure prif_atomic_or + end procedure + + module procedure prif_atomic_xor + end procedure + + module procedure prif_atomic_cas_int + end procedure + + module procedure prif_atomic_cas_logical + end procedure + + module procedure prif_atomic_fetch_add + end procedure + + module procedure prif_atomic_fetch_and + end procedure + + module procedure prif_atomic_fetch_or + end procedure + + module procedure prif_atomic_fetch_xor + end procedure + + module procedure prif_atomic_define_int + end procedure + + module procedure prif_atomic_define_logical + end procedure + + module procedure prif_atomic_ref_int + end procedure + + module procedure prif_atomic_ref_logical + end procedure + +end submodule atomic_s diff --git a/src/caffeine/caffeine_h_m.f90 b/src/caffeine/caffeine_h_m.f90 index fb3177b7..526a85d5 100644 --- a/src/caffeine/caffeine_h_m.f90 +++ b/src/caffeine/caffeine_h_m.f90 @@ -34,7 +34,7 @@ subroutine caf_decaffeinate(exit_code) bind(C) ! _________________ Image enumeration ____________________ - pure function caf_this_image() bind(C) + function caf_this_image() bind(C) !! int caf_this_image(); import c_int implicit none diff --git a/src/caffeine/coarray_access_m.f90 b/src/caffeine/coarray_access_m.f90 new file mode 100644 index 00000000..bb074092 --- /dev/null +++ b/src/caffeine/coarray_access_m.f90 @@ -0,0 +1,116 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +module coarray_access_m + use iso_c_binding, only: c_intptr_t, c_int, c_intmax_t, c_size_t, c_ptr, c_ptrdiff_t + use allocation_m, only: prif_coarray_handle + use teams_m, only: prif_team_type + + implicit none + private + public :: prif_put, prif_put_strided, prif_put_raw, prif_put_raw_strided, prif_get, prif_get_raw, prif_get_raw_strided + + interface + + module subroutine prif_put( & + coarray_handle, coindices, value, element_size, first_element_addr, team, team_number, stat, errmsg, errmsg_alloc) + implicit none + type(prif_coarray_handle), intent(in) :: coarray_handle + integer(c_intmax_t), intent(in) :: coindices(:) + type(*), dimension(..), intent(in), contiguous :: value + integer(c_size_t), intent(in) :: element_size + type(c_ptr), intent(in) :: first_element_addr + type(prif_team_type), optional, intent(in) :: team + integer(c_intmax_t), optional, intent(in) :: team_number + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + + module subroutine prif_put_strided( & + coarray_handle, coindices, value, element_size, first_element_addr, extent, stride, & + team, team_number, stat, errmsg, errmsg_alloc) + implicit none + type(prif_coarray_handle), intent(in) :: coarray_handle + integer(c_intmax_t), intent(in) :: coindices(:) + type(*), dimension(..), intent(in) :: value + integer(c_size_t), intent(in) :: element_size + type(c_ptr), intent(in) :: first_element_addr + integer(c_size_t) :: extent(:) + integer(c_ptrdiff_t) :: stride(:) + type(prif_team_type), optional, intent(in) :: team + integer(c_intmax_t), optional, intent(in) :: team_number + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + + module subroutine prif_put_raw(image_num, local_buffer, remote_ptr, size, stat, errmsg, errmsg_alloc) + implicit none + integer(c_int), intent(in) :: image_num + type(c_ptr), intent(in) :: local_buffer + integer(c_intptr_t), intent(in) :: remote_ptr + integer(c_size_t), intent(in) :: size + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + + module subroutine prif_put_raw_strided( & + image_num, local_buffer, remote_ptr, element_size, extent, remote_ptr_stride, & + local_buffer_stride, stat, errmsg, errmsg_alloc) + implicit none + integer(c_int), intent(in) :: image_num + type(c_ptr), intent(in) :: local_buffer + integer(c_intptr_t), intent(in) :: remote_ptr + integer(c_size_t), intent(in) :: element_size + integer(c_size_t), intent(in) :: extent(:) + integer(c_ptrdiff_t), intent(in) :: remote_ptr_stride(:) + integer(c_ptrdiff_t), intent(in) :: local_buffer_stride(:) + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + + module subroutine prif_get(coarray_handle, coindices, mold, value, team, team_number, stat, errmsg, errmsg_alloc) + implicit none + type(prif_coarray_handle), intent(in) :: coarray_handle + integer(c_intmax_t), intent(in) :: coindices(:) + type(*), dimension(..), intent(in) :: mold + type(*), dimension(..), intent(inout) :: value + type(prif_team_type), optional, intent(in) :: team + integer(c_intmax_t), optional, intent(in) :: team_number + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + + module subroutine prif_get_raw(image_num, local_buffer, remote_ptr, size, stat, errmsg, errmsg_alloc) + implicit none + integer(c_int), intent(in) :: image_num + type(c_ptr), intent(in) :: local_buffer + integer(c_intptr_t), intent(in) :: remote_ptr + integer(c_size_t), intent(in) :: size + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + + module subroutine prif_get_raw_strided( & + image_num, local_buffer, remote_ptr, element_size, extent, remote_ptr_stride, local_buffer_stride, & + stat, errmsg, errmsg_alloc) + implicit none + integer(c_int), intent(in) :: image_num + type(c_ptr), intent(in) :: local_buffer + integer(c_intptr_t), intent(in) :: remote_ptr + integer(c_size_t), intent(in) :: element_size + integer(c_size_t), intent(in) :: extent(:) + integer(c_ptrdiff_t), intent(in) :: remote_ptr_stride(:) + integer(c_ptrdiff_t), intent(in) :: local_buffer_stride(:) + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + + end interface + +end module coarray_access_m diff --git a/src/caffeine/coarray_access_s.f90 b/src/caffeine/coarray_access_s.f90 new file mode 100644 index 00000000..3f0c3f46 --- /dev/null +++ b/src/caffeine/coarray_access_s.f90 @@ -0,0 +1,30 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +submodule(coarray_access_m) coarray_access_s + + implicit none + +contains + + module procedure prif_put + end procedure + + module procedure prif_put_strided + end procedure + + module procedure prif_put_raw + end procedure + + module procedure prif_put_raw_strided + end procedure + + module procedure prif_get + end procedure + + module procedure prif_get_raw + end procedure + + module procedure prif_get_raw_strided + end procedure + +end submodule coarray_access_s diff --git a/src/caffeine/coarray_queries_m.f90 b/src/caffeine/coarray_queries_m.f90 new file mode 100644 index 00000000..14f8d6c4 --- /dev/null +++ b/src/caffeine/coarray_queries_m.f90 @@ -0,0 +1,63 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +module coarray_queries_m + use iso_c_binding, only: c_int, c_intmax_t, c_size_t + use allocation_m, only: prif_coarray_handle + use teams_m, only: prif_team_type + + implicit none + private + public :: prif_lcobound, prif_ucobound, prif_coshape, prif_image_index + + interface prif_lcobound + module procedure prif_lcobound_with_dim + module procedure prif_lcobound_no_dim + end interface + + interface prif_ucobound + module procedure prif_ucobound_with_dim + module procedure prif_ucobound_no_dim + end interface + + interface + + module subroutine prif_lcobound_with_dim(coarray_handle, dim, lcobound) + type(prif_coarray_handle), intent(in) :: coarray_handle + integer(kind=c_int), intent(in) :: dim + integer(kind=c_intmax_t), intent(out) :: lcobound + end subroutine + + module subroutine prif_lcobound_no_dim(coarray_handle, lcobounds) + type(prif_coarray_handle), intent(in) :: coarray_handle + integer(kind=c_intmax_t), intent(out) :: lcobounds(:) + end subroutine + + module subroutine prif_ucobound_with_dim(coarray_handle, dim, ucobound) + type(prif_coarray_handle), intent(in) :: coarray_handle + integer(kind=c_int), intent(in) :: dim + integer(kind=c_intmax_t), intent(out) :: ucobound + end subroutine + + module subroutine prif_ucobound_no_dim(coarray_handle, ucobounds) + type(prif_coarray_handle), intent(in) :: coarray_handle + integer(kind=c_intmax_t), intent(out) :: ucobounds(:) + end subroutine + + module subroutine prif_coshape(coarray_handle, sizes) + implicit none + type(prif_coarray_handle), intent(in) :: coarray_handle + integer(c_size_t), intent(out) :: sizes(:) + end subroutine + + module subroutine prif_image_index(coarray_handle, sub, team, team_number, image_index) + implicit none + type(prif_coarray_handle), intent(in) :: coarray_handle + integer(c_intmax_t), intent(in) :: sub(:) + type(prif_team_type), intent(in), optional :: team + integer(c_int), intent(in), optional :: team_number + integer(c_int), intent(out) :: image_index + end subroutine + + end interface + +end module coarray_queries_m diff --git a/src/caffeine/coarray_queries_s.f90 b/src/caffeine/coarray_queries_s.f90 new file mode 100644 index 00000000..4d5ec4e2 --- /dev/null +++ b/src/caffeine/coarray_queries_s.f90 @@ -0,0 +1,27 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +submodule(coarray_queries_m) coarray_queries_s + + implicit none + +contains + + module procedure prif_lcobound_with_dim + end procedure + + module procedure prif_lcobound_no_dim + end procedure + + module procedure prif_ucobound_with_dim + end procedure + + module procedure prif_ucobound_no_dim + end procedure prif_ucobound_no_dim + + module procedure prif_coshape + end procedure + + module procedure prif_image_index + end procedure + +end submodule coarray_queries_s diff --git a/src/caffeine/collective_subroutines/co_max_s.f90 b/src/caffeine/collective_subroutines/co_max_s.f90 index b83b0bfa..d70217c6 100644 --- a/src/caffeine/collective_subroutines/co_max_s.f90 +++ b/src/caffeine/collective_subroutines/co_max_s.f90 @@ -34,7 +34,7 @@ contains - pure function reverse_alphabetize(lhs, rhs) result(last_alphabetically) + function reverse_alphabetize(lhs, rhs) result(last_alphabetically) character(len=*), intent(in) :: lhs, rhs character(len=:), allocatable :: last_alphabetically call assert(len(lhs)==len(rhs), "caf_co_max: LHS/RHS length match", lhs//" , "//rhs) diff --git a/src/caffeine/collective_subroutines/co_min_s.f90 b/src/caffeine/collective_subroutines/co_min_s.f90 index 527c9daa..3d505bea 100644 --- a/src/caffeine/collective_subroutines/co_min_s.f90 +++ b/src/caffeine/collective_subroutines/co_min_s.f90 @@ -34,7 +34,7 @@ contains - pure function alphabetize(lhs, rhs) result(first_alphabetically) + function alphabetize(lhs, rhs) result(first_alphabetically) character(len=*), intent(in) :: lhs, rhs character(len=:), allocatable :: first_alphabetically call assert(len(lhs)==len(rhs), "prif_co_min: LHS/RHS length match", lhs//" , "//rhs) diff --git a/src/caffeine/collective_subroutines/co_reduce_s.f90 b/src/caffeine/collective_subroutines/co_reduce_s.f90 index b2d4a377..d267731c 100644 --- a/src/caffeine/collective_subroutines/co_reduce_s.f90 +++ b/src/caffeine/collective_subroutines/co_reduce_s.f90 @@ -225,7 +225,7 @@ subroutine Coll_ReduceSub_c_char(arg1, arg2_and_out, count, cdata) bind(C) block integer(c_size_t) i - do concurrent(i=1:count) + do i=1, count rhs_and_result(i) = char_op(lhs(i), rhs_and_result(i)) end do end block diff --git a/src/caffeine/collective_subroutines_m.f90 b/src/caffeine/collective_subroutines_m.f90 index 3439a6cc..ce75172b 100644 --- a/src/caffeine/collective_subroutines_m.f90 +++ b/src/caffeine/collective_subroutines_m.f90 @@ -57,7 +57,7 @@ pure function c_bool_operation(lhs, rhs) result(lhs_op_rhs) logical(c_bool) lhs_op_rhs end function - pure function c_char_operation(lhs, rhs) result(lhs_op_rhs) + function c_char_operation(lhs, rhs) result(lhs_op_rhs) import c_char implicit none character(kind=c_char,len=*), intent(in) :: lhs, rhs diff --git a/src/caffeine/critical_m.f90 b/src/caffeine/critical_m.f90 new file mode 100644 index 00000000..8de857ac --- /dev/null +++ b/src/caffeine/critical_m.f90 @@ -0,0 +1,29 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +module critical_m + use allocation_m, only: prif_coarray_handle + use iso_c_binding, only: c_int + use locks_m, only: prif_critical_type => prif_lock_type + + implicit none + private + public :: prif_critical_type, prif_critical, prif_end_critical + + interface + + module subroutine prif_critical(critical_coarray, stat, errmsg, errmsg_alloc) + implicit none + type(prif_coarray_handle), intent(in) :: critical_coarray + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + + module subroutine prif_end_critical(critical_coarray) + implicit none + type(prif_coarray_handle), intent(in) :: critical_coarray + end subroutine + + end interface + +end module critical_m diff --git a/src/caffeine/critical_s.f90 b/src/caffeine/critical_s.f90 new file mode 100644 index 00000000..73ca6f31 --- /dev/null +++ b/src/caffeine/critical_s.f90 @@ -0,0 +1,15 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +submodule(critical_m) critical_s + + implicit none + +contains + + module procedure prif_critical + end procedure + + module procedure prif_end_critical + end procedure + +end submodule critical_s diff --git a/src/caffeine/events_m.f90 b/src/caffeine/events_m.f90 new file mode 100644 index 00000000..d53f6461 --- /dev/null +++ b/src/caffeine/events_m.f90 @@ -0,0 +1,39 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +module events_m + use iso_c_binding, only: c_intptr_t, c_int, c_intmax_t + + implicit none + private + public :: prif_event_post, prif_event_wait, prif_event_query + + interface + + module subroutine prif_event_post(image_num, event_var_ptr, stat, errmsg, errmsg_alloc) + implicit none + integer(c_int), intent(in) :: image_num + integer(c_intptr_t), intent(in) :: event_var_ptr + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + + module subroutine prif_event_wait(event_var_ptr, until_count, stat, errmsg, errmsg_alloc) + implicit none + integer(c_intptr_t), intent(in) :: event_var_ptr + integer(c_intmax_t), intent(in), optional :: until_count + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + + module subroutine prif_event_query(event_var_ptr, count, stat) + implicit none + integer(c_intptr_t), intent(in) :: event_var_ptr + integer(c_intmax_t), intent(out) :: count + integer(c_int), intent(out), optional :: stat + end subroutine + + end interface + +end module events_m diff --git a/src/caffeine/events_s.f90 b/src/caffeine/events_s.f90 new file mode 100644 index 00000000..9de37af1 --- /dev/null +++ b/src/caffeine/events_s.f90 @@ -0,0 +1,18 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +submodule(events_m) events_s + + implicit none + +contains + + module procedure prif_event_post + end procedure + + module procedure prif_event_wait + end procedure + + module procedure prif_event_query + end procedure + +end submodule events_s diff --git a/src/caffeine/image_enumeration_m.f90 b/src/caffeine/image_queries_m.f90 similarity index 57% rename from src/caffeine/image_enumeration_m.f90 rename to src/caffeine/image_queries_m.f90 index 339bcd7f..b7349937 100644 --- a/src/caffeine/image_enumeration_m.f90 +++ b/src/caffeine/image_queries_m.f90 @@ -1,14 +1,13 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt -module image_enumeration_m +module image_queries_m use iso_c_binding, only: c_int, c_intmax_t - use team_type_m, only : prif_team_type + use teams_m, only : prif_team_type use allocation_m, only: prif_coarray_handle implicit none private - public :: prif_num_images - public :: prif_this_image + public :: prif_num_images, prif_this_image, prif_failed_images, prif_stopped_images, prif_image_status interface @@ -17,13 +16,32 @@ module subroutine prif_num_images(team, team_number, image_count) type(prif_team_type), intent(in), optional :: team integer(c_intmax_t), intent(in), optional :: team_number integer(c_int), intent(out) :: image_count - end subroutine prif_num_images + end subroutine + + module subroutine prif_failed_images(team, failed_images) + implicit none + type(prif_team_type), intent(in), optional :: team + integer(c_int), allocatable, intent(out) :: failed_images(:) + end subroutine + + module subroutine prif_stopped_images(team, stopped_images) + implicit none + type(prif_team_type), intent(in), optional :: team + integer(c_int), allocatable, intent(out) :: stopped_images(:) + end subroutine + + module impure elemental subroutine prif_image_status(image, team, image_status) + implicit none + integer(c_int), intent(in) :: image + type(prif_team_type), intent(in), optional :: team + integer(c_int), intent(out) :: image_status + end subroutine end interface interface prif_this_image - pure module subroutine prif_this_image_no_coarray(team, image_index) + module subroutine prif_this_image_no_coarray(team, image_index) implicit none type(prif_team_type), intent(in), optional :: team integer(c_int), intent(out) :: image_index @@ -46,4 +64,4 @@ module subroutine prif_this_image_with_dim(coarray_handle, dim, team, cosubscrip end interface -end module image_enumeration_m +end module image_queries_m diff --git a/src/caffeine/image_enumeration_s.f90 b/src/caffeine/image_queries_s.f90 similarity index 71% rename from src/caffeine/image_enumeration_s.f90 rename to src/caffeine/image_queries_s.f90 index 2cd43085..1fe1287e 100644 --- a/src/caffeine/image_enumeration_s.f90 +++ b/src/caffeine/image_queries_s.f90 @@ -1,6 +1,6 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt -submodule(image_enumeration_m) image_enumeration_s +submodule(image_queries_m) image_queries_s use caffeine_h_m, only : caf_num_images, caf_this_image implicit none @@ -22,4 +22,13 @@ module procedure prif_this_image_with_dim end procedure -end submodule image_enumeration_s + module procedure prif_failed_images + end procedure + + module procedure prif_stopped_images + end procedure + + module procedure prif_image_status + end procedure + +end submodule image_queries_s diff --git a/src/caffeine/locks_m.f90 b/src/caffeine/locks_m.f90 new file mode 100644 index 00000000..bf21358b --- /dev/null +++ b/src/caffeine/locks_m.f90 @@ -0,0 +1,36 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +module locks_m + use iso_c_binding, only: c_intptr_t, c_int, c_bool + + implicit none + private + public :: prif_lock_type, prif_lock, prif_unlock + + type :: prif_lock_type + end type + + interface + + module subroutine prif_lock(image_num, lock_var_ptr, acquired_lock, stat, errmsg, errmsg_alloc) + implicit none + integer(c_int), intent(in) :: image_num + integer(c_intptr_t), intent(in) :: lock_var_ptr + logical(c_bool), intent(out), optional :: acquired_lock + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + + module subroutine prif_unlock(image_num, lock_var_ptr, stat, errmsg, errmsg_alloc) + implicit none + integer(c_int), intent(in) :: image_num + integer(c_intptr_t), intent(in) :: lock_var_ptr + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + + end interface + +end module locks_m diff --git a/src/caffeine/locks_s.f90 b/src/caffeine/locks_s.f90 new file mode 100644 index 00000000..8380dbc6 --- /dev/null +++ b/src/caffeine/locks_s.f90 @@ -0,0 +1,15 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +submodule(locks_m) locks_s + + implicit none + +contains + + module procedure prif_lock + end procedure + + module procedure prif_unlock + end procedure + +end submodule locks_s diff --git a/src/caffeine/prif_queries_m.f90 b/src/caffeine/prif_queries_m.f90 new file mode 100644 index 00000000..57ed9623 --- /dev/null +++ b/src/caffeine/prif_queries_m.f90 @@ -0,0 +1,43 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +module prif_queries_m + use iso_c_binding, only: c_ptr, c_intmax_t, c_intptr_t, c_size_t + use allocation_m, only: prif_coarray_handle + use teams_m, only: prif_team_type + + implicit none + private + public :: prif_set_context_data, prif_get_context_data, prif_base_pointer, prif_local_data_size + + interface + + module subroutine prif_set_context_data(coarray_handle, context_data) + implicit none + type(prif_coarray_handle), intent(in) :: coarray_handle + type(c_ptr), intent(in) :: context_data + end subroutine + + module subroutine prif_get_context_data(coarray_handle, context_data) + implicit none + type(prif_coarray_handle), intent(in) :: coarray_handle + type(c_ptr), intent(out) :: context_data + end subroutine + + module subroutine prif_base_pointer(coarray_handle, coindices, team, team_number, ptr) + implicit none + type(prif_coarray_handle), intent(in) :: coarray_handle + integer(c_intmax_t), intent(in) :: coindices(:) + type(prif_team_type), optional, intent(in) :: team + integer(c_intmax_t), optional, intent(in) :: team_number + integer(c_intptr_t), intent(out) :: ptr + end subroutine + + module subroutine prif_local_data_size(coarray_handle, data_size) + implicit none + type(prif_coarray_handle), intent(in) :: coarray_handle + integer(c_size_t), intent(out) :: data_size + end subroutine + + end interface + +end module prif_queries_m diff --git a/src/caffeine/prif_queries_s.f90 b/src/caffeine/prif_queries_s.f90 new file mode 100644 index 00000000..3294e416 --- /dev/null +++ b/src/caffeine/prif_queries_s.f90 @@ -0,0 +1,21 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +submodule(prif_queries_m) prif_queries_s + + implicit none + +contains + + module procedure prif_set_context_data + end procedure + + module procedure prif_get_context_data + end procedure + + module procedure prif_base_pointer + end procedure + + module procedure prif_local_data_size + end procedure + +end submodule prif_queries_s diff --git a/src/caffeine/program_startup_m.f90 b/src/caffeine/program_startup_m.f90 index 6991b5fb..98f3ead4 100644 --- a/src/caffeine/program_startup_m.f90 +++ b/src/caffeine/program_startup_m.f90 @@ -2,7 +2,7 @@ ! Terms of use are as specified in LICENSE.txt module program_startup_m use iso_c_binding, only : c_int - use team_type_m, only: prif_team_type + use teams_m, only: prif_team_type implicit none private diff --git a/src/caffeine/program_termination_m.f90 b/src/caffeine/program_termination_m.f90 index a0a2f90c..90dfe902 100644 --- a/src/caffeine/program_termination_m.f90 +++ b/src/caffeine/program_termination_m.f90 @@ -4,7 +4,7 @@ module program_termination_m use iso_c_binding, only: c_int, c_bool implicit none private - public :: prif_stop, prif_error_stop + public :: prif_stop, prif_error_stop, prif_fail_image interface @@ -21,6 +21,10 @@ module pure subroutine prif_error_stop(quiet, stop_code_int, stop_code_char) character(len=*), intent(in), optional :: stop_code_char end subroutine + module subroutine prif_fail_image() + implicit none + end subroutine + end interface end module program_termination_m diff --git a/src/caffeine/program_termination_s.f90 b/src/caffeine/program_termination_s.f90 index e571b695..b4b13453 100644 --- a/src/caffeine/program_termination_s.f90 +++ b/src/caffeine/program_termination_s.f90 @@ -151,4 +151,7 @@ pure function c_f_string(c_string, length) result(f_string) end do end function + module procedure prif_fail_image + end procedure + end submodule program_termination_s diff --git a/src/caffeine/synchronization_m.f90 b/src/caffeine/synchronization_m.f90 index 1612b6af..d7d1cab7 100644 --- a/src/caffeine/synchronization_m.f90 +++ b/src/caffeine/synchronization_m.f90 @@ -2,10 +2,11 @@ ! Terms of use are as specified in LICENSE.txt module synchronization_m use iso_c_binding, only: c_int + use teams_m, only: prif_team_type implicit none private - public :: prif_sync_all - + public :: prif_sync_all, prif_sync_images, prif_sync_team, prif_sync_memory + interface module subroutine prif_sync_all(stat, errmsg, errmsg_alloc) @@ -15,6 +16,29 @@ module subroutine prif_sync_all(stat, errmsg, errmsg_alloc) character(len=:), intent(inout), allocatable, optional :: errmsg_alloc end subroutine + module subroutine prif_sync_images(image_set, stat, errmsg, errmsg_alloc) + implicit none + integer(c_int), intent(in) :: image_set(:) + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + + module subroutine prif_sync_team(team, stat, errmsg, errmsg_alloc) + implicit none + type(prif_team_type), intent(in) :: team + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + + module subroutine prif_sync_memory(stat, errmsg, errmsg_alloc) + implicit none + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + end interface end module synchronization_m diff --git a/src/caffeine/synchronization_s.f90 b/src/caffeine/synchronization_s.f90 index b522d9c4..b9b77ae4 100644 --- a/src/caffeine/synchronization_s.f90 +++ b/src/caffeine/synchronization_s.f90 @@ -7,10 +7,17 @@ contains module procedure prif_sync_all - !TODO: handle optional args stat, errmsg, errmsg_alloc call caf_sync_all + end procedure + + module procedure prif_sync_images + end procedure + + module procedure prif_sync_team + end procedure - end procedure + module procedure prif_sync_memory + end procedure end submodule diff --git a/src/caffeine/team_type_m.f90 b/src/caffeine/teams_m.f90 similarity index 75% rename from src/caffeine/team_type_m.f90 rename to src/caffeine/teams_m.f90 index 7cfc2a42..3847b452 100644 --- a/src/caffeine/team_type_m.f90 +++ b/src/caffeine/teams_m.f90 @@ -1,12 +1,12 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt -module team_type_m +module teams_m use iso_c_binding, only: c_ptr, c_int, c_intmax_t implicit none private - public :: prif_team_type, prif_form_team, current_team, prif_end_team, prif_change_team + public :: prif_team_type, prif_form_team, current_team, prif_end_team, prif_change_team, prif_get_team, prif_team_number type :: prif_team_type type(c_ptr) :: team_ptr @@ -41,7 +41,19 @@ module subroutine prif_end_team(stat, errmsg, errmsg_alloc) character(len=:), intent(inout), allocatable, optional :: errmsg_alloc end subroutine + module subroutine prif_get_team(level, team) + implicit none + integer(c_int), intent(in), optional :: level + type(prif_team_type), intent(out) :: team + end subroutine + + module subroutine prif_team_number(team, team_number) + implicit none + type(prif_team_type), intent(in), optional :: team + integer(c_intmax_t), intent(out) :: team_number + end subroutine + end interface -end module team_type_m +end module teams_m diff --git a/src/caffeine/team_type_s.f90 b/src/caffeine/teams_s.f90 similarity index 69% rename from src/caffeine/team_type_s.f90 rename to src/caffeine/teams_s.f90 index d0d39e0c..01c049a7 100644 --- a/src/caffeine/team_type_s.f90 +++ b/src/caffeine/teams_s.f90 @@ -1,6 +1,6 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt -submodule(team_type_m) team_type_s +submodule(teams_m) teams_s implicit none contains @@ -14,4 +14,10 @@ module procedure prif_form_team end procedure + module procedure prif_get_team + end procedure + + module procedure prif_team_number + end procedure + end submodule diff --git a/src/prif.f90 b/src/prif.f90 index 3c1b66d3..726e0545 100644 --- a/src/prif.f90 +++ b/src/prif.f90 @@ -2,11 +2,23 @@ ! Terms of use are as specified in LICENSE.txt module prif use program_startup_m, only : prif_init - use program_termination_m, only : prif_stop, prif_error_stop - use allocation_m, only: prif_coarray_handle, prif_allocate - use image_enumeration_m, only : prif_this_image, prif_num_images + use program_termination_m, only : prif_stop, prif_error_stop, prif_fail_image + use allocation_m, only: & + prif_coarray_handle, prif_allocate, prif_allocate_non_symmetric, prif_deallocate, prif_deallocate_non_symmetric + use coarray_access_m, only: & + prif_put, prif_put_strided, prif_put_raw, prif_put_raw_strided, prif_get, prif_get_raw, prif_get_raw_strided + use alias_m, only: prif_alias_create, prif_alias_destroy + use coarray_queries_m, only: prif_lcobound, prif_ucobound, prif_coshape, prif_image_index + use image_queries_m, only : prif_this_image, prif_num_images, prif_failed_images, prif_stopped_images, prif_image_status + use prif_queries_m, only: prif_set_context_data, prif_get_context_data, prif_base_pointer, prif_local_data_size use collective_subroutines_m, only : prif_co_sum, prif_co_max, prif_co_min, prif_co_reduce, prif_co_broadcast - use team_type_m, only: prif_form_team, prif_change_team, prif_end_team, prif_team_type - use synchronization_m, only : prif_sync_all + use teams_m, only: prif_form_team, prif_change_team, prif_end_team, prif_team_type, prif_get_team, prif_team_number + use synchronization_m, only : prif_sync_all, prif_sync_images, prif_sync_team, prif_sync_memory + use locks_m, only: prif_lock_type, prif_lock, prif_unlock + use critical_m, only: prif_critical_type, prif_critical, prif_end_critical + use events_m, only: prif_event_post, prif_event_wait, prif_event_query + use atomic_m, only: & + prif_atomic_add, prif_atomic_and, prif_atomic_or, prif_atomic_xor, prif_atomic_cas, prif_atomic_fetch_add, & + prif_atomic_fetch_and, prif_atomic_fetch_or, prif_atomic_fetch_xor, prif_atomic_define, prif_atomic_ref implicit none end module prif diff --git a/test/caf_co_max_test.f90 b/test/caf_co_max_test.f90 index 586632d3..62cc1048 100644 --- a/test/caf_co_max_test.f90 +++ b/test/caf_co_max_test.f90 @@ -1,7 +1,7 @@ module caf_co_max_test use prif, only : prif_co_max use veggies, only: result_t, test_item_t, assert_equals, describe, it, assert_that, assert_equals - use image_enumeration_m, only : prif_this_image, prif_num_images + use image_queries_m, only : prif_this_image, prif_num_images implicit none private diff --git a/test/caf_co_min_test.f90 b/test/caf_co_min_test.f90 index c3627ae9..033d4b12 100644 --- a/test/caf_co_min_test.f90 +++ b/test/caf_co_min_test.f90 @@ -1,7 +1,7 @@ module caf_co_min_test use prif, only : prif_co_min, prif_num_images use veggies, only: result_t, test_item_t, assert_equals, describe, it, assert_that, assert_equals, succeed - use image_enumeration_m, only : prif_this_image, prif_num_images + use image_queries_m, only : prif_this_image, prif_num_images implicit none private diff --git a/test/caf_co_reduce_test.f90 b/test/caf_co_reduce_test.f90 index 61751206..4bb23ecb 100644 --- a/test/caf_co_reduce_test.f90 +++ b/test/caf_co_reduce_test.f90 @@ -52,7 +52,7 @@ function alphabetically_1st_size1_string_array() result(result_) contains - pure function alphabetize(lhs, rhs) result(first_alphabetically) + function alphabetize(lhs, rhs) result(first_alphabetically) character(len=*), intent(in) :: lhs, rhs character(len=:), allocatable :: first_alphabetically call assert(len(lhs)==len(rhs), "co_reduce_s alphabetize: LHS/RHS length match", lhs//" , "//rhs)