diff --git a/example/hello.f90 b/example/hello.f90 index 34728f4bd..573ddba99 100644 --- a/example/hello.f90 +++ b/example/hello.f90 @@ -1,11 +1,11 @@ program hello_world - use caffeine_m, only : caf_caffeinate, this_image => caf_this_image, num_images => caf_num_images, caf_stop + use prif, only : prif_init, this_image => prif_this_image, num_images => prif_num_images, prif_stop implicit none - if (caf_caffeinate() /= 0) error stop "caffeinate returned a non-zero exit code" + if (prif_init() /= 0) error stop "caffeinate returned a non-zero exit code" print *, "Hello from image", this_image(), "of", num_images() - call caf_stop(stop_code=0) ! normal termination + call prif_stop(stop_code=0) ! normal termination end program diff --git a/example/support-test/error_stop_character_code.f90 b/example/support-test/error_stop_character_code.f90 index 7ccc8768d..c100b5914 100644 --- a/example/support-test/error_stop_character_code.f90 +++ b/example/support-test/error_stop_character_code.f90 @@ -1,10 +1,10 @@ program error_stop_character_code - use caffeine_m, only : caf_caffeinate, caf_error_stop + use prif, only : prif_init, prif_error_stop implicit none - if (caf_caffeinate() /= 0) error stop "caffeinate returned a non-zero exit_code" + if (prif_init() /= 0) error stop "caffeinate returned a non-zero exit_code" - call caf_error_stop("Oh snap!") + call prif_error_stop("Oh snap!") stop 0 ! ../../test/caf_error_stop_test.f90 will report a test failure if this line runs end program diff --git a/example/support-test/error_stop_integer_code.f90 b/example/support-test/error_stop_integer_code.f90 index 4a4beb801..01d5ebd51 100644 --- a/example/support-test/error_stop_integer_code.f90 +++ b/example/support-test/error_stop_integer_code.f90 @@ -1,10 +1,10 @@ program error_stop_integer_code - use caffeine_m, only : caf_caffeinate, caf_error_stop + use prif, only : prif_init, prif_error_stop implicit none - if (caf_caffeinate() /= 0) error stop "caffeinate returned a non-zero exit_code" + if (prif_init() /= 0) error stop "caffeinate returned a non-zero exit_code" - call caf_error_stop(1) + call prif_error_stop(1) stop 0 ! caffeine/test/caf_error_stop_test.f90 reports a failure if this line runs -end program +end program diff --git a/example/support-test/stop_with_integer_code.f90 b/example/support-test/stop_with_integer_code.f90 index 5a12c84eb..9b87c4949 100644 --- a/example/support-test/stop_with_integer_code.f90 +++ b/example/support-test/stop_with_integer_code.f90 @@ -1,10 +1,10 @@ program stop_with_no_code - use caffeine_m, only : caf_caffeinate, caf_stop + use prif, only : prif_init, prif_stop implicit none - if (caf_caffeinate() /= 0) error stop "caffeinate returned a non-zero exit_code" + if (prif_init() /= 0) error stop "caffeinate returned a non-zero exit_code" - call caf_stop(1) + call prif_stop(1) stop 2 ! caffeine/test/zzz_finalization_test.f90 reports a failure if this line runs end program diff --git a/example/support-test/stop_with_no_code.f90 b/example/support-test/stop_with_no_code.f90 index 000e8faf2..718a406bb 100644 --- a/example/support-test/stop_with_no_code.f90 +++ b/example/support-test/stop_with_no_code.f90 @@ -1,10 +1,10 @@ program stop_with_no_code - use caffeine_m, only : caf_caffeinate, caf_stop + use prif, only : prif_init, prif_stop implicit none - if (caf_caffeinate() /= 0) error stop "caffeinate returned a non-zero exit_code" + if (prif_init() /= 0) error stop "caffeinate returned a non-zero exit_code" - call caf_stop + call prif_stop stop 1 ! caffeine/test/zzz_finalization_test.f90 reports a failure if this line runs end program diff --git a/src/caffeine/assert/assert_s.f90 b/src/caffeine/assert/assert_s.f90 index 0f19cc7c7..c1e410fca 100644 --- a/src/caffeine/assert/assert_s.f90 +++ b/src/caffeine/assert/assert_s.f90 @@ -11,8 +11,8 @@ module procedure assert use caffeine_characterizable_m, only : characterizable_t - use program_termination_m, only: caf_error_stop - use image_enumeration_m, only: this_image => caf_this_image + use program_termination_m, only: prif_error_stop + use image_enumeration_m, only: this_image => prif_this_image character(len=:), allocatable :: header, trailer @@ -52,7 +52,7 @@ end if represent_diagnostics_as_string - call caf_error_stop(header // ' with diagnostic data "' // trailer // '"') + call prif_error_stop(header // ' with diagnostic data "' // trailer // '"') end if check_assertion @@ -77,7 +77,7 @@ pure function string(numeric) result(number_as_string) type is(real) write(untrimmed_string, *) numeric class default - call caf_error_stop("Internal error in subroutine 'assert': unsupported type in function 'string'.") + call prif_error_stop("Internal error in subroutine 'assert': unsupported type in function 'string'.") end select number_as_string = trim(adjustl(untrimmed_string)) diff --git a/src/caffeine/assert/intrinsic_array_s.F90 b/src/caffeine/assert/intrinsic_array_s.F90 index fb7ad8da4..059b2c553 100644 --- a/src/caffeine/assert/intrinsic_array_s.F90 +++ b/src/caffeine/assert/intrinsic_array_s.F90 @@ -1,5 +1,5 @@ submodule(caffeine_intrinsic_array_m) caffeine_intrinsic_array_s - use program_termination_m, only: caf_error_stop + use program_termination_m, only: prif_error_stop implicit none contains @@ -22,7 +22,7 @@ type is(double precision) intrinsic_array%double_precision_1D = array class default - call caf_error_stop("intrinsic_array_t construct: unsupported rank-2 type") + call prif_error_stop("intrinsic_array_t construct: unsupported rank-2 type") end select #ifndef NAGFOR rank(2) @@ -38,7 +38,7 @@ type is(double precision) intrinsic_array%double_precision_2D = array class default - call caf_error_stop("intrinsic_array_t construct: unsupported rank-2 type") + call prif_error_stop("intrinsic_array_t construct: unsupported rank-2 type") end select rank(3) @@ -54,11 +54,11 @@ type is(double precision) intrinsic_array%double_precision_3D = array class default - call caf_error_stop("intrinsic_array_t construct: unsupported rank-3 type") + call prif_error_stop("intrinsic_array_t construct: unsupported rank-3 type") end select rank default - call caf_error_stop("intrinsic_array_t construct: unsupported rank") + call prif_error_stop("intrinsic_array_t construct: unsupported rank") end select #endif @@ -74,7 +74,7 @@ allocated(self%logical_2D), allocated(self%real_2D), & allocated(self%complex_3D), allocated(self%complex_double_3D), allocated(self%integer_3D), & allocated(self%logical_3D), allocated(self%real_3D) & - ])) call caf_error_stop("intrinsic_array_t as_character: ambiguous component allocation status.") + ])) call prif_error_stop("intrinsic_array_t as_character: ambiguous component allocation status.") if (allocated(self%complex_1D)) then character_self = repeat(" ", ncopies = single_number_width*size(self%complex_1D)) diff --git a/src/caffeine/caffeinate_decaffeinate_m.f90 b/src/caffeine/caffeinate_decaffeinate_m.f90 deleted file mode 100644 index 996194896..000000000 --- a/src/caffeine/caffeinate_decaffeinate_m.f90 +++ /dev/null @@ -1,26 +0,0 @@ -! Copyright (c), The Regents of the University of California -! Terms of use are as specified in LICENSE.txt -module caffeinate_decaffeinate_m - use team_type_m, only: team_type - implicit none - - private - public :: caf_caffeinate, caf_decaffeinate, default_team - - type(team_type), target :: default_team - - interface - - module function caf_caffeinate() result(exit_code) - implicit none - integer exit_code - end function - - module subroutine caf_decaffeinate(exit_code) - implicit none - integer, intent(in) :: exit_code - end subroutine - - end interface - -end module caffeinate_decaffeinate_m diff --git a/src/caffeine/caffeine.c b/src/caffeine/caffeine.c index ac8b45dcc..582e0dc66 100644 --- a/src/caffeine/caffeine.c +++ b/src/caffeine/caffeine.c @@ -21,7 +21,7 @@ static gex_Rank_t rank, size; const int double_Complex_workaround =4100; #endif -void caf_c_caffeinate(int argc, char *argv[]) +void caf_caffeinate(int argc, char *argv[]) { GASNET_SAFE(gex_Client_Init(&myclient, &myep, &myteam, "caffeine", &argc, &argv, 0)); @@ -42,28 +42,28 @@ void caf_c_caffeinate(int argc, char *argv[]) GASNET_SAFE(gex_Segment_Attach(&mysegment, myteam, segsz)); } -void caf_c_decaffeinate(int exit_code) +void caf_decaffeinate(int exit_code) { gasnet_exit(exit_code); } -int caf_c_this_image() +int caf_this_image() { return gex_TM_QueryRank(myteam) + 1; } -int caf_c_num_images() +int caf_num_images() { return gex_TM_QuerySize(myteam); } -void caf_c_sync_all() +void caf_sync_all() { gasnet_barrier_notify(0,GASNET_BARRIERFLAG_ANONYMOUS); gasnet_barrier_wait(0,GASNET_BARRIERFLAG_ANONYMOUS); } -void caf_c_co_reduce( +void caf_co_reduce( CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg, int num_elements, gex_Coll_ReduceFn_t* user_op, void* client_data ) { @@ -85,7 +85,7 @@ void caf_c_co_reduce( if (stat != NULL) *stat = 0; } -void caf_c_co_broadcast(CFI_cdesc_t * a_desc, int source_image, int* stat, int num_elements) +void caf_co_broadcast(CFI_cdesc_t * a_desc, int source_image, int* stat, int num_elements) { char* c_loc_a = (char*) a_desc->base_addr; size_t c_sizeof_a = a_desc->elem_len; @@ -117,7 +117,7 @@ void set_stat_errmsg_or_abort(int* stat, char* errmsg, const int return_stat, co } } -void caf_c_co_max(CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg, size_t num_elements) +void caf_co_max(CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg, size_t num_elements) { gex_DT_t a_type; @@ -147,7 +147,7 @@ void caf_c_co_max(CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg if (stat != NULL) *stat = 0; } -void caf_c_co_min(CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg, size_t num_elements) +void caf_co_min(CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg, size_t num_elements) { gex_DT_t a_type; @@ -177,7 +177,7 @@ void caf_c_co_min(CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg if (stat != NULL) *stat = 0; } -void caf_c_co_sum(CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg, size_t num_elements) +void caf_co_sum(CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg, size_t num_elements) { gex_DT_t a_type; @@ -209,18 +209,18 @@ void caf_c_co_sum(CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg if (stat != NULL) *stat = 0; } -bool caf_c_same_cfi_type(CFI_cdesc_t* a_desc, CFI_cdesc_t* b_desc) +bool caf_same_cfi_type(CFI_cdesc_t* a_desc, CFI_cdesc_t* b_desc) { if (a_desc->type == b_desc->type) return true; return false; } -size_t caf_c_elem_len(CFI_cdesc_t* a_desc) +size_t caf_elem_len(CFI_cdesc_t* a_desc) { return a_desc->elem_len; } -bool caf_c_numeric_type(CFI_cdesc_t* a_desc) +bool caf_numeric_type(CFI_cdesc_t* a_desc) { switch (a_desc->type) { @@ -235,12 +235,12 @@ bool caf_c_numeric_type(CFI_cdesc_t* a_desc) } #ifdef __GNUC__ -bool caf_c_is_f_string(CFI_cdesc_t* a_desc){ +bool caf_is_f_string(CFI_cdesc_t* a_desc){ if ( (a_desc->type - 5) % 256 == 0) return true; return false; } #else // The code below is untested but believed to conform with the Fortran 2018 standard. -bool caf_c_is_f_string(CFI_cdesc_t* a_desc){ +bool caf_is_f_string(CFI_cdesc_t* a_desc){ if (a_desc->type == CFI_type_char) return true; return false; } diff --git a/src/caffeine/caffeine.h b/src/caffeine/caffeine.h index f9b46bab3..35caa2660 100644 --- a/src/caffeine/caffeine.h +++ b/src/caffeine/caffeine.h @@ -16,48 +16,48 @@ enum { // Program launch and finalization -void caf_c_caffeinate(int argc, char *argv[]); -void caf_c_decaffeinate(int exit_code); +void caf_caffeinate(int argc, char *argv[]); +void caf_decaffeinate(int exit_code); // Image enumeration -int caf_c_this_image(); -int caf_c_num_images(); +int caf_this_image(); +int caf_num_images(); // Synchronization -void caf_c_sync_all(); +void caf_sync_all(); // _______ Collective Subroutines _______ -void caf_c_co_reduce( +void caf_co_reduce( CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg, int num_elements, gex_Coll_ReduceFn_t* user_op, void* client_data ); -void caf_c_co_broadcast( +void caf_co_broadcast( CFI_cdesc_t * a_desc, int source_image, int* stat, int num_elements ); -void caf_c_co_sum( +void caf_co_sum( CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg, size_t num_elements ); -void caf_c_co_min( +void caf_co_min( CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg, size_t num_elements ); -void caf_c_co_max( +void caf_co_max( CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg, size_t num_elements ); // ____________ Utilities ____________ -bool caf_c_same_cfi_type(CFI_cdesc_t* a_desc, CFI_cdesc_t* b_desc); +bool caf_same_cfi_type(CFI_cdesc_t* a_desc, CFI_cdesc_t* b_desc); -bool caf_c_numeric_type(CFI_cdesc_t* a_desc); +bool caf_numeric_type(CFI_cdesc_t* a_desc); -bool caf_c_is_f_string(CFI_cdesc_t* a_desc); +bool caf_is_f_string(CFI_cdesc_t* a_desc); -size_t caf_c_elem_len(CFI_cdesc_t* a_desc); +size_t caf_elem_len(CFI_cdesc_t* a_desc); #endif // CAFFEINE_H diff --git a/src/caffeine/caffeine_h_m.f90 b/src/caffeine/caffeine_h_m.f90 index 9225e39e8..3ab2b7771 100644 --- a/src/caffeine/caffeine_h_m.f90 +++ b/src/caffeine/caffeine_h_m.f90 @@ -6,17 +6,17 @@ module caffeine_h_m implicit none private - public :: caf_c_caffeinate, caf_c_decaffeinate - public :: caf_c_num_images, caf_c_this_image - public :: caf_c_sync_all - public :: caf_c_co_broadcast, caf_c_co_sum, caf_c_co_min, caf_c_co_max, caf_c_co_reduce - public :: caf_c_same_cfi_type, caf_c_elem_len, caf_c_numeric_type, caf_c_is_f_string + public :: caf_caffeinate, caf_decaffeinate + public :: caf_num_images, caf_this_image + public :: caf_sync_all + public :: caf_co_broadcast, caf_co_sum, caf_co_min, caf_co_max, caf_co_reduce + public :: caf_same_cfi_type, caf_elem_len, caf_numeric_type, caf_is_f_string interface ! ________ Program initiation and finalization ___________ - subroutine caf_c_caffeinate(argc, argv) bind(C) + subroutine caf_caffeinate(argc, argv) bind(C) !! void c_caffeinate(int argc, char *argv[]); import c_int, c_ptr implicit none @@ -24,7 +24,7 @@ subroutine caf_c_caffeinate(argc, argv) bind(C) type(c_ptr) argv(*) end subroutine - subroutine caf_c_decaffeinate(exit_code) bind(C) + subroutine caf_decaffeinate(exit_code) bind(C) !! void c_decaffeinate(); import c_int implicit none @@ -33,31 +33,31 @@ subroutine caf_c_decaffeinate(exit_code) bind(C) ! _________________ Image enumeration ____________________ - pure function caf_c_this_image() bind(C) - !! int caf_c_this_image(); + pure function caf_this_image() bind(C) + !! int caf_this_image(); import c_int implicit none - integer(c_int) caf_c_this_image + integer(c_int) caf_this_image end function - pure function caf_c_num_images() bind(C) - !! int caf_c_num_images(); + pure function caf_num_images() bind(C) + !! int caf_num_images(); import c_int implicit none - integer(c_int) caf_c_num_images + integer(c_int) caf_num_images end function ! __________________ Synchronization _____________________ - subroutine caf_c_sync_all() bind(C) - !! void caf_c_sync_all(); + subroutine caf_sync_all() bind(C) + !! void caf_sync_all(); import c_int implicit none end subroutine ! ______________ Collective Subroutines __________________ - subroutine caf_c_co_broadcast(a, source_image, stat, Nelem) bind(C) + subroutine caf_co_broadcast(a, source_image, stat, Nelem) bind(C) !! void c_co_broadcast(CFI_cdesc_t * a_desc, int source_image, int* stat, int num_elements); import c_int, c_ptr implicit none @@ -66,8 +66,8 @@ subroutine caf_c_co_broadcast(a, source_image, stat, Nelem) bind(C) integer(c_int), value :: source_image, Nelem end subroutine - subroutine caf_c_co_reduce(a, result_image, c_loc_stat, c_loc_errmsg, num_elements, Coll_ReduceSub, client_data ) bind(C) - !! void caf_c_co_reduce(CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg, int num_elements, gex_Coll_ReduceFn_t* user_op, void* client_data) + subroutine caf_co_reduce(a, result_image, c_loc_stat, c_loc_errmsg, num_elements, Coll_ReduceSub, client_data ) bind(C) + !! void caf_co_reduce(CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg, int num_elements, gex_Coll_ReduceFn_t* user_op, void* client_data) import c_int, c_ptr, c_size_t, c_funptr implicit none type(*) a(..) @@ -77,7 +77,7 @@ subroutine caf_c_co_reduce(a, result_image, c_loc_stat, c_loc_errmsg, num_elemen integer(c_size_t), value :: num_elements end subroutine - subroutine caf_c_co_sum(a, result_image, c_loc_stat, c_loc_errmsg, num_elements) bind(C) + subroutine caf_co_sum(a, result_image, c_loc_stat, c_loc_errmsg, num_elements) bind(C) !! void c_co_sum(CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg, size_t num_elements); import c_int, c_ptr, c_size_t implicit none @@ -87,7 +87,7 @@ subroutine caf_c_co_sum(a, result_image, c_loc_stat, c_loc_errmsg, num_elements) integer(c_size_t), value :: num_elements end subroutine - subroutine caf_c_co_min(a, result_image, c_loc_stat, c_loc_errmsg, num_elements) bind(C) + subroutine caf_co_min(a, result_image, c_loc_stat, c_loc_errmsg, num_elements) bind(C) !! void c_co_min(CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg, size_t num_elements); import c_int, c_ptr, c_size_t implicit none @@ -97,7 +97,7 @@ subroutine caf_c_co_min(a, result_image, c_loc_stat, c_loc_errmsg, num_elements) integer(c_size_t), value :: num_elements end subroutine - subroutine caf_c_co_max(a, result_image, c_loc_stat, c_loc_errmsg, num_elements) bind(C) + subroutine caf_co_max(a, result_image, c_loc_stat, c_loc_errmsg, num_elements) bind(C) !! void c_co_max(CFI_cdesc_t* a_desc, int result_image, int* stat, char* errmsg, size_t num_elements); import c_int, c_ptr, c_size_t implicit none @@ -107,26 +107,26 @@ subroutine caf_c_co_max(a, result_image, c_loc_stat, c_loc_errmsg, num_elements) integer(c_size_t), value :: num_elements end subroutine - logical(c_bool) pure function caf_c_same_cfi_type(a, b) bind(C) - !! bool caf_c_same_cfi_type(CFI_cdesc_t* a_desc, CFI_cdesc_t* a_desc); + logical(c_bool) pure function caf_same_cfi_type(a, b) bind(C) + !! bool caf_same_cfi_type(CFI_cdesc_t* a_desc, CFI_cdesc_t* a_desc); import c_bool type(*), intent(in) :: a(..), b(..) end function - logical(c_bool) pure function caf_c_numeric_type(a) bind(C) - !! bool caf_c_numeric_type(CFI_cdesc_t* a_desc); + logical(c_bool) pure function caf_numeric_type(a) bind(C) + !! bool caf_numeric_type(CFI_cdesc_t* a_desc); import c_bool type(*), intent(in) :: a(..) end function - logical(c_bool) pure function caf_c_is_f_string(a) bind(C) - !! bool caf_c_is_f_string(CFI_cdesc_t* a_desc); + logical(c_bool) pure function caf_is_f_string(a) bind(C) + !! bool caf_is_f_string(CFI_cdesc_t* a_desc); import c_bool type(*), intent(in) :: a(..) end function - pure function caf_c_elem_len(a) result(a_elem_len) bind(C) - !! size_t caf_c_elem_len(CFI_cdesc_t* a_desc); + pure function caf_elem_len(a) result(a_elem_len) bind(C) + !! size_t caf_elem_len(CFI_cdesc_t* a_desc); import c_size_t type(*), intent(in) :: a(..) integer(c_size_t), target :: a_elem_len diff --git a/src/caffeine/collective_subroutines/co_broadcast_s.f90 b/src/caffeine/collective_subroutines/co_broadcast_s.f90 index 9f0c8357f..2f55d09f8 100644 --- a/src/caffeine/collective_subroutines/co_broadcast_s.f90 +++ b/src/caffeine/collective_subroutines/co_broadcast_s.f90 @@ -1,18 +1,18 @@ submodule(collective_subroutines_m) co_broadcast_s use iso_c_binding, only : c_ptr use utilities_m, only : get_c_ptr - use caffeine_h_m, only : caf_c_co_broadcast + use caffeine_h_m, only : caf_co_broadcast implicit none contains - module procedure caf_co_broadcast + module procedure prif_co_broadcast type(c_ptr) stat_ptr stat_ptr = get_c_ptr(stat) - call caf_c_co_broadcast(a, source_image, stat_ptr, product(shape(a))) - ! With a compliant Fortran 2018 compiler, pass in c_sizeof(a) as the final argument + call caf_co_broadcast(a, source_image, stat_ptr, product(shape(a))) + ! With a compliant Fortran 2018 compiler, pass in c_sizeof(a) as the final argument ! and eliminate the calculation of num_elements*sizeof(a) in caffeine.c. end procedure diff --git a/src/caffeine/collective_subroutines/co_max_s.f90 b/src/caffeine/collective_subroutines/co_max_s.f90 index bfe7f3fa0..514b15603 100644 --- a/src/caffeine/collective_subroutines/co_max_s.f90 +++ b/src/caffeine/collective_subroutines/co_max_s.f90 @@ -3,33 +3,33 @@ submodule(collective_subroutines_m) co_max_s use iso_c_binding, only : c_ptr, c_size_t, c_null_char, c_f_pointer, c_funloc, c_null_ptr use utilities_m, only : get_c_ptr, get_c_ptr_character, optional_value - use caffeine_h_m, only : caf_c_co_max, caf_c_same_cfi_type, caf_c_numeric_type, caf_c_is_f_string + use caffeine_h_m, only : caf_co_max, caf_same_cfi_type, caf_numeric_type, caf_is_f_string use caffeine_assert_m, only : assert - use program_termination_m, only: caf_error_stop + use program_termination_m, only: prif_error_stop implicit none contains - module procedure caf_co_max + module procedure prif_co_max type(c_ptr) :: stat_c_ptr = c_null_ptr, errmsg_c_ptr = c_null_ptr character(len=:), allocatable :: c_string character(len=:), pointer :: errmsg_f_ptr - if (caf_c_numeric_type(a)) then + if (caf_numeric_type(a)) then stat_c_ptr = get_c_ptr(stat) c_string = errmsg // c_null_char errmsg_c_ptr = get_c_ptr_character(c_string) - call caf_c_co_max(a, optional_value(result_image), stat_c_ptr, errmsg_c_ptr, int(product(shape(a)), c_size_t)) + call caf_co_max(a, optional_value(result_image), stat_c_ptr, errmsg_c_ptr, int(product(shape(a)), c_size_t)) call c_f_pointer(errmsg_c_ptr, errmsg_f_ptr) ! no need to do this for stat was passed by reference errmsg = errmsg_f_ptr ! copy the output back & truncate the null terminator - else if (caf_c_is_f_string(a)) then - call caf_co_reduce(a, c_funloc(reverse_alphabetize), optional_value(result_image), stat, errmsg) + else if (caf_is_f_string(a)) then + call prif_co_reduce(a, c_funloc(reverse_alphabetize), optional_value(result_image), stat, errmsg) else - call caf_error_stop("caf_co_max: unsupported type") + call prif_error_stop("caf_co_max: unsupported type") end if contains diff --git a/src/caffeine/collective_subroutines/co_min_s.f90 b/src/caffeine/collective_subroutines/co_min_s.f90 index d14158b49..c6f2062eb 100644 --- a/src/caffeine/collective_subroutines/co_min_s.f90 +++ b/src/caffeine/collective_subroutines/co_min_s.f90 @@ -3,33 +3,33 @@ submodule(collective_subroutines_m) co_min_s use iso_c_binding, only : c_ptr, c_size_t, c_null_char, c_f_pointer, c_funloc, c_null_ptr use utilities_m, only : get_c_ptr, get_c_ptr_character, optional_value - use caffeine_h_m, only : caf_c_co_min, caf_c_same_cfi_type, caf_c_numeric_type, caf_c_is_f_string + use caffeine_h_m, only : caf_co_min, caf_same_cfi_type, caf_numeric_type, caf_is_f_string use caffeine_assert_m, only : assert - use program_termination_m, only: caf_error_stop + use program_termination_m, only: prif_error_stop implicit none contains - module procedure caf_co_min + module procedure prif_co_min type(c_ptr) :: stat_c_ptr = c_null_ptr, errmsg_c_ptr = c_null_ptr character(len=:), allocatable :: c_string character(len=:), pointer :: errmsg_f_ptr - if (caf_c_numeric_type(a)) then + if (caf_numeric_type(a)) then stat_c_ptr = get_c_ptr(stat) c_string = errmsg // c_null_char errmsg_c_ptr = get_c_ptr_character(c_string) - call caf_c_co_min(a, optional_value(result_image), stat_c_ptr, errmsg_c_ptr, int(product(shape(a)), c_size_t)) + call caf_co_min(a, optional_value(result_image), stat_c_ptr, errmsg_c_ptr, int(product(shape(a)), c_size_t)) call c_f_pointer(errmsg_c_ptr, errmsg_f_ptr) ! no need to do this for stat was passed by reference errmsg = errmsg_f_ptr ! copy the output back & truncate the null terminator - else if (caf_c_is_f_string(a)) then - call caf_co_reduce(a, c_funloc(alphabetize), optional_value(result_image), stat, errmsg) + else if (caf_is_f_string(a)) then + call prif_co_reduce(a, c_funloc(alphabetize), optional_value(result_image), stat, errmsg) else - call caf_error_stop("caf_co_min: unsupported type") + call prif_error_stop("prif_co_min: unsupported type") end if contains @@ -37,7 +37,7 @@ pure function alphabetize(lhs, rhs) result(first_alphabetically) character(len=*), intent(in) :: lhs, rhs character(len=:), allocatable :: first_alphabetically - call assert(len(lhs)==len(rhs), "caf_co_min: LHS/RHS length match", lhs//" , "//rhs) + call assert(len(lhs)==len(rhs), "prif_co_min: LHS/RHS length match", lhs//" , "//rhs) first_alphabetically = min(lhs,rhs) end function diff --git a/src/caffeine/collective_subroutines/co_reduce_s.f90 b/src/caffeine/collective_subroutines/co_reduce_s.f90 index 32fad1fc9..ac1d25cba 100644 --- a/src/caffeine/collective_subroutines/co_reduce_s.f90 +++ b/src/caffeine/collective_subroutines/co_reduce_s.f90 @@ -6,15 +6,15 @@ use caffeine_assert_m, only : assert use caffeine_intrinsic_array_m, only : intrinsic_array_t use utilities_m, only : get_c_ptr, get_c_ptr_character, optional_value - use caffeine_h_m, only : caf_c_co_reduce, caf_c_same_cfi_type, caf_c_elem_len, caf_c_is_f_string - use program_termination_m, only: caf_error_stop + use caffeine_h_m, only : caf_co_reduce, caf_same_cfi_type, caf_elem_len, caf_is_f_string + use program_termination_m, only: prif_error_stop implicit none character(kind=c_char,len=5), parameter :: dummy = " " contains - module procedure caf_co_reduce + module procedure prif_co_reduce type(c_ptr) :: stat_ptr = c_null_ptr, errmsg_ptr = c_null_ptr @@ -32,44 +32,44 @@ stat_ptr = get_c_ptr(stat) errmsg_ptr = get_c_ptr_character(errmsg) - if (caf_c_same_cfi_type(a, 0)) then + if (caf_same_cfi_type(a, 0)) then call c_f_procpointer(operation, int32_op) - call caf_c_co_reduce(a, optional_value(result_image), stat_ptr, errmsg_ptr, & + call caf_co_reduce(a, optional_value(result_image), stat_ptr, errmsg_ptr, & int(product(shape(a)), c_size_t), c_funloc(Coll_ReduceSub_c_int32_t), c_null_ptr) - else if (caf_c_same_cfi_type(a, 0_c_int64_t)) then + else if (caf_same_cfi_type(a, 0_c_int64_t)) then call c_f_procpointer(operation, int64_op) - call caf_c_co_reduce(a, optional_value(result_image), stat_ptr, errmsg_ptr, & + call caf_co_reduce(a, optional_value(result_image), stat_ptr, errmsg_ptr, & int(product(shape(a)), c_size_t), c_funloc(Coll_ReduceSub_c_int64_t), c_null_ptr) - else if (caf_c_same_cfi_type(a, 1._c_double)) then + else if (caf_same_cfi_type(a, 1._c_double)) then call c_f_procpointer(operation, double_op) - call caf_c_co_reduce(a, optional_value(result_image), stat_ptr, errmsg_ptr, & + call caf_co_reduce(a, optional_value(result_image), stat_ptr, errmsg_ptr, & int(product(shape(a)), c_size_t), c_funloc(Coll_ReduceSub_c_double), c_null_ptr) - else if (caf_c_same_cfi_type(a, 1._c_float)) then + else if (caf_same_cfi_type(a, 1._c_float)) then call c_f_procpointer(operation, float_op) - call caf_c_co_reduce(a, optional_value(result_image), stat_ptr, errmsg_ptr, & + call caf_co_reduce(a, optional_value(result_image), stat_ptr, errmsg_ptr, & int(product(shape(a)), c_size_t), c_funloc(Coll_ReduceSub_c_float), c_null_ptr) - else if (caf_c_same_cfi_type(a, .true._c_bool)) then + else if (caf_same_cfi_type(a, .true._c_bool)) then call c_f_procpointer(operation, bool_op) - call caf_c_co_reduce(a, optional_value(result_image), stat_ptr, errmsg_ptr, & + call caf_co_reduce(a, optional_value(result_image), stat_ptr, errmsg_ptr, & int(product(shape(a)), c_size_t), c_funloc(Coll_ReduceSub_c_bool), c_null_ptr) - else if (caf_c_is_f_string(a)) then + else if (caf_is_f_string(a)) then block integer(c_size_t), target :: len_a - len_a = caf_c_elem_len(a) + len_a = caf_elem_len(a) call c_f_procpointer(operation, char_op) - call caf_c_co_reduce(a, optional_value(result_image), stat_ptr, errmsg_ptr, & + call caf_co_reduce(a, optional_value(result_image), stat_ptr, errmsg_ptr, & int(product(shape(a)), c_size_t), c_funloc(Coll_ReduceSub_c_char), c_loc(len_a)) end block - else if (caf_c_same_cfi_type(a, (0._c_float, 0._c_float))) then + else if (caf_same_cfi_type(a, (0._c_float, 0._c_float))) then call c_f_procpointer(operation, float_complex_op) - call caf_c_co_reduce(a, optional_value(result_image), stat_ptr, errmsg_ptr, & + call caf_co_reduce(a, optional_value(result_image), stat_ptr, errmsg_ptr, & int(product(shape(a)), c_size_t), c_funloc(Coll_ReduceSub_c_float_complex), c_null_ptr) - else if (caf_c_same_cfi_type(a, (0._c_double, 0._c_double))) then + else if (caf_same_cfi_type(a, (0._c_double, 0._c_double))) then call c_f_procpointer(operation, double_complex_op) - call caf_c_co_reduce(a, optional_value(result_image), stat_ptr, errmsg_ptr, & + call caf_co_reduce(a, optional_value(result_image), stat_ptr, errmsg_ptr, & int(product(shape(a)), c_size_t), c_funloc(Coll_ReduceSub_c_double_complex), c_null_ptr) else - call caf_error_stop("caf_co_reduce: unsupported type") + call prif_error_stop("caf_co_reduce: unsupported type") end if contains diff --git a/src/caffeine/collective_subroutines/co_sum_s.f90 b/src/caffeine/collective_subroutines/co_sum_s.f90 index 5815a1b94..e606b8a83 100644 --- a/src/caffeine/collective_subroutines/co_sum_s.f90 +++ b/src/caffeine/collective_subroutines/co_sum_s.f90 @@ -3,12 +3,12 @@ submodule(collective_subroutines_m) co_sum_s use iso_c_binding, only : c_ptr, c_size_t, c_null_char, c_f_pointer use utilities_m, only : get_c_ptr, get_c_ptr_character, optional_value - use caffeine_h_m, only : caf_c_co_sum + use caffeine_h_m, only : caf_co_sum implicit none contains - module procedure caf_co_sum + module procedure prif_co_sum type(c_ptr) stat_c_ptr, errmsg_c_ptr character(len=:), allocatable :: c_string character(len=:), pointer :: errmsg_f_ptr @@ -17,7 +17,7 @@ c_string = errmsg // c_null_char errmsg_c_ptr = get_c_ptr_character(c_string) - call caf_c_co_sum(a, optional_value(result_image), stat_c_ptr, errmsg_c_ptr, int(product(shape(a)), c_size_t)) + call caf_co_sum(a, optional_value(result_image), stat_c_ptr, errmsg_c_ptr, int(product(shape(a)), c_size_t)) call c_f_pointer(errmsg_c_ptr, errmsg_f_ptr) errmsg = errmsg_f_ptr end procedure diff --git a/src/caffeine/collective_subroutines_m.f90 b/src/caffeine/collective_subroutines_m.f90 index d6a5a8129..2b58d3ba1 100644 --- a/src/caffeine/collective_subroutines_m.f90 +++ b/src/caffeine/collective_subroutines_m.f90 @@ -5,11 +5,11 @@ module collective_subroutines_m implicit none private - public :: caf_co_sum - public :: caf_co_max - public :: caf_co_min - public :: caf_co_reduce - public :: caf_co_broadcast + public :: prif_co_sum + public :: prif_co_max + public :: prif_co_min + public :: prif_co_reduce + public :: prif_co_broadcast public :: c_int32_t_operation public :: c_int64_t_operation @@ -82,7 +82,7 @@ pure function c_double_complex_operation(lhs, rhs) result(lhs_op_rhs) interface - module subroutine caf_co_sum(a, result_image, stat, errmsg) + module subroutine prif_co_sum(a, result_image, stat, errmsg) implicit none type(*), intent(inout), contiguous, target :: a(..) integer, intent(in), target, optional :: result_image @@ -90,7 +90,7 @@ module subroutine caf_co_sum(a, result_image, stat, errmsg) character(len=*), intent(inout), target, optional :: errmsg end subroutine - module subroutine caf_co_max(a, result_image, stat, errmsg) + module subroutine prif_co_max(a, result_image, stat, errmsg) implicit none type(*), intent(inout), contiguous, target :: a(..) integer, intent(in), optional, target :: result_image @@ -98,7 +98,7 @@ module subroutine caf_co_max(a, result_image, stat, errmsg) character(len=*), intent(inout), optional, target :: errmsg end subroutine - module subroutine caf_co_min(a, result_image, stat, errmsg) + module subroutine prif_co_min(a, result_image, stat, errmsg) implicit none type(*), intent(inout), contiguous, target :: a(..) integer, intent(in), optional, target :: result_image @@ -106,7 +106,7 @@ module subroutine caf_co_min(a, result_image, stat, errmsg) character(len=*), intent(inout), optional, target :: errmsg end subroutine - module subroutine caf_co_reduce(a, operation, result_image, stat, errmsg) + module subroutine prif_co_reduce(a, operation, result_image, stat, errmsg) implicit none type(*), intent(inout), contiguous, target :: a(..) type(c_funptr), value :: operation @@ -115,7 +115,7 @@ module subroutine caf_co_reduce(a, operation, result_image, stat, errmsg) character(len=*), intent(inout), optional, target :: errmsg end subroutine - module subroutine caf_co_broadcast(a, source_image, stat, errmsg) + module subroutine prif_co_broadcast(a, source_image, stat, errmsg) implicit none type(*), intent(inout), contiguous, target :: a(..) integer, optional, intent(in) :: source_image diff --git a/src/caffeine/image_enumeration_m.f90 b/src/caffeine/image_enumeration_m.f90 index f5f412d90..f384a6b51 100644 --- a/src/caffeine/image_enumeration_m.f90 +++ b/src/caffeine/image_enumeration_m.f90 @@ -1,18 +1,18 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module image_enumeration_m - use team_type_m, only : team_type + use team_type_m, only : prif_team_type implicit none private - public :: caf_num_images - public :: caf_this_image + public :: prif_num_images + public :: prif_this_image - interface caf_num_images + interface prif_num_images module function num_images_team(team) result(image_count) implicit none - type(team_type), intent(in), optional :: team + type(prif_team_type), intent(in), optional :: team integer image_count end function @@ -24,17 +24,17 @@ module function num_images_team_number(team_number) result(image_count) end interface - interface caf_this_image + interface prif_this_image pure module function this_image_team(team) result(image_number) implicit none - type(team_type), intent(in), optional :: team + type(prif_team_type), intent(in), optional :: team integer image_number end function module function this_image_coarray_team(coarray, team) result(image_number) implicit none - type(team_type), intent(in), optional :: team + type(prif_team_type), intent(in), optional :: team class(*), intent(in) :: coarray(..) integer image_number end function @@ -43,7 +43,7 @@ module function this_image_coarray_dim_team(coarray, dim, team) result(image_num implicit none class(*), intent(in) :: coarray(..) integer, intent(in) :: dim - type(team_type), intent(in), optional :: team + type(prif_team_type), intent(in), optional :: team integer image_number end function diff --git a/src/caffeine/image_enumeration_s.f90 b/src/caffeine/image_enumeration_s.f90 index b729837d1..67344b28b 100644 --- a/src/caffeine/image_enumeration_s.f90 +++ b/src/caffeine/image_enumeration_s.f90 @@ -1,20 +1,20 @@ ! 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 - use caffeine_h_m, only : caf_c_num_images, caf_c_this_image + use caffeine_h_m, only : caf_num_images, caf_this_image implicit none - + contains module procedure num_images_team - image_count = caf_c_num_images() + image_count = caf_num_images() end procedure module procedure num_images_team_number end procedure module procedure this_image_team - image_number = caf_c_this_image() + image_number = caf_this_image() end procedure module procedure this_image_coarray_team diff --git a/src/caffeine/normal_termination_s.f90 b/src/caffeine/normal_termination_s.f90 index c544713e3..514a92cc8 100644 --- a/src/caffeine/normal_termination_s.f90 +++ b/src/caffeine/normal_termination_s.f90 @@ -3,34 +3,34 @@ submodule(normal_termination_m) normal_termination_s use iso_fortran_env, only : output_unit use iso_c_binding, only : c_int - use caffeine_h_m, only : caf_c_decaffeinate + use caffeine_h_m, only : caf_decaffeinate implicit none contains - module procedure caf_stop_integer - + module procedure prif_stop_integer + sync all - + write(output_unit, *) "caf_stop: stop code '", stop_code, "'" - flush output_unit + flush output_unit - if (.not. present(stop_code)) call caf_c_decaffeinate(exit_code=0_c_int) ! does not return - call caf_c_decaffeinate(stop_code) + if (.not. present(stop_code)) call caf_decaffeinate(exit_code=0_c_int) ! does not return + call caf_decaffeinate(stop_code) - end procedure + end procedure - module procedure caf_stop_character + module procedure prif_stop_character sync all write(output_unit, *) "caf_stop: stop code '" // stop_code // "'" flush output_unit - call caf_c_decaffeinate(exit_code=0_c_int) - - end procedure + call caf_decaffeinate(exit_code=0_c_int) + + end procedure end submodule normal_termination_s diff --git a/src/caffeine/program_startup_m.f90 b/src/caffeine/program_startup_m.f90 new file mode 100644 index 000000000..b1010c7e7 --- /dev/null +++ b/src/caffeine/program_startup_m.f90 @@ -0,0 +1,21 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +module program_startup_m + use team_type_m, only: prif_team_type + implicit none + + private + public :: prif_init, default_team + + type(prif_team_type), target :: default_team + + interface + + module function prif_init() result(exit_code) + implicit none + integer exit_code + end function + + end interface + +end module program_startup_m diff --git a/src/caffeine/caffeinate_decaffeinate_s.F90 b/src/caffeine/program_startup_s.F90 similarity index 64% rename from src/caffeine/caffeinate_decaffeinate_s.F90 rename to src/caffeine/program_startup_s.F90 index ceb9b53e7..69db1d3e6 100644 --- a/src/caffeine/caffeinate_decaffeinate_s.F90 +++ b/src/caffeine/program_startup_s.F90 @@ -1,28 +1,28 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt -submodule(caffeinate_decaffeinate_m) caffeinate_decaffeinate_s +submodule(program_startup_m) program_startup_s use iso_c_binding, only : c_int, c_loc, c_char, c_null_char - use synchronization_m, only : caf_sync_all - use caffeine_h_m, only : caf_c_caffeinate, caf_c_decaffeinate - use program_termination_m, only: caf_error_stop + use synchronization_m, only : prif_sync_all + use caffeine_h_m, only : caf_caffeinate, caf_decaffeinate + use program_termination_m, only: prif_error_stop implicit none contains - module procedure caf_caffeinate + module procedure prif_init integer i integer, parameter :: max_arg_len = 1024 associate(argc => int(command_argument_count(),c_int)) associate(argv => [(c_loc(c_interop_arg(i)), i=0,argc)]) - call caf_c_caffeinate(argc, argv) + call caf_caffeinate(argc, argv) end associate end associate ! TODO: establish non-allocatable coarrays - call caf_sync_all + call prif_sync_all exit_code = 0 @@ -39,14 +39,10 @@ function c_interop_arg(argnum) result(arg) arg => targ #endif call get_command_argument(argnum, arg, arglen) - if (arglen+1>max_arg_len) call caf_error_stop("maximum argument length exceeded") + if (arglen+1>max_arg_len) call prif_error_stop("maximum argument length exceeded") arg(arglen+1:arglen+1) = c_null_char end function end procedure - module procedure caf_decaffeinate - call caf_c_decaffeinate(exit_code) - end procedure - -end submodule caffeinate_decaffeinate_s +end submodule program_startup_s diff --git a/src/caffeine/program_termination_m.f90 b/src/caffeine/program_termination_m.f90 index 5f2fb5d7a..a623eb791 100644 --- a/src/caffeine/program_termination_m.f90 +++ b/src/caffeine/program_termination_m.f90 @@ -3,31 +3,31 @@ module program_termination_m implicit none private - public :: caf_stop - public :: caf_error_stop + public :: prif_stop + public :: prif_error_stop - interface caf_stop + interface prif_stop - module subroutine caf_stop_integer(stop_code) + module subroutine prif_stop_integer(stop_code) !! synchronize, stop the executing image, and provide the stop_code, or 0 if not present, as the process exit status integer, intent(in), optional :: stop_code end subroutine - module subroutine caf_stop_character(stop_code) + module subroutine prif_stop_character(stop_code) !! synchronize, stop the executing image, and provide the stop_code as the process exit status character(len=*), intent(in) :: stop_code end subroutine end interface - interface caf_error_stop + interface prif_error_stop - pure module subroutine caf_error_stop_integer(stop_code) + pure module subroutine prif_error_stop_integer(stop_code) !! stop all images and provide the stop_code, or 0 if not present, as the process exit status integer, intent(in), optional :: stop_code end subroutine - pure module subroutine caf_error_stop_character(stop_code) + pure module subroutine prif_error_stop_character(stop_code) !! stop all images and provide the stop_code as the process exit status character(len=*), intent(in) :: stop_code end subroutine diff --git a/src/caffeine/program_termination_s.f90 b/src/caffeine/program_termination_s.f90 index 156dd8011..e015c7694 100644 --- a/src/caffeine/program_termination_s.f90 +++ b/src/caffeine/program_termination_s.f90 @@ -3,12 +3,12 @@ submodule(program_termination_m) program_termination_s use iso_fortran_env, only : output_unit, error_unit use iso_c_binding, only : c_char, c_int - use caffeine_h_m, only : caf_c_decaffeinate + use caffeine_h_m, only : caf_decaffeinate implicit none contains - module procedure caf_stop_integer + module procedure prif_stop_integer sync all @@ -16,25 +16,25 @@ write(output_unit, *) stop_code flush output_unit - if (.not. present(stop_code)) call caf_c_decaffeinate(exit_code=0_c_int) ! does not return - call caf_c_decaffeinate(stop_code) + if (.not. present(stop_code)) call caf_decaffeinate(exit_code=0_c_int) ! does not return + call caf_decaffeinate(stop_code) end procedure - module procedure caf_stop_character + module procedure prif_stop_character sync all write(output_unit, *) "caf_stop: stop code '" // stop_code // "'" flush output_unit - call caf_c_decaffeinate(exit_code=0_c_int) ! does not return + call caf_decaffeinate(exit_code=0_c_int) ! does not return end procedure - module procedure caf_error_stop_character + module procedure prif_error_stop_character interface pure subroutine caf_error_stop_character_c(stop_code, length) bind(C, name = "caf_error_stop_character_c") use, intrinsic :: iso_c_binding, only: c_char, c_int @@ -55,11 +55,11 @@ subroutine inner_caf_error_stop_character(stop_code, length) bind(C, name = "inn write(error_unit, *) c_f_string(stop_code, length) flush error_unit - call caf_error_stop_integer(error_occured) + call prif_error_stop_integer(error_occured) end subroutine - module procedure caf_error_stop_integer + module procedure prif_error_stop_integer interface pure subroutine caf_error_stop_integer_c(stop_code) bind(C, name = "caf_error_stop_integer_c") use, intrinsic :: iso_c_binding, only: c_int @@ -77,7 +77,7 @@ subroutine inner_caf_error_stop_integer(stop_code) bind(C, name = "inner_caf_err if (.not. present(stop_code)) then - call caf_c_decaffeinate(exit_code=1) + call caf_decaffeinate(exit_code=1) else if (stop_code==0) then @@ -88,7 +88,7 @@ subroutine inner_caf_error_stop_integer(stop_code) bind(C, name = "inner_caf_err exit_code = stop_code end if - call caf_c_decaffeinate(exit_code) ! does not return + call caf_decaffeinate(exit_code) ! does not return end subroutine diff --git a/src/caffeine/synchronization_m.f90 b/src/caffeine/synchronization_m.f90 index 0055f428a..b66b40455 100644 --- a/src/caffeine/synchronization_m.f90 +++ b/src/caffeine/synchronization_m.f90 @@ -3,11 +3,11 @@ module synchronization_m implicit none private - public :: caf_sync_all + public :: prif_sync_all interface - module subroutine caf_sync_all() + module subroutine prif_sync_all() end subroutine end interface diff --git a/src/caffeine/synchronization_s.f90 b/src/caffeine/synchronization_s.f90 index fd3e03927..7092e982c 100644 --- a/src/caffeine/synchronization_s.f90 +++ b/src/caffeine/synchronization_s.f90 @@ -1,14 +1,14 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt submodule(synchronization_m) sychronization_s - use caffeine_h_m, only : caf_c_sync_all + use caffeine_h_m, only : caf_sync_all implicit none contains - module procedure caf_sync_all + module procedure prif_sync_all - call caf_c_sync_all + call caf_sync_all end procedure diff --git a/src/caffeine/team_type_m.f90 b/src/caffeine/team_type_m.f90 index 50b14cf45..fbbe8735c 100644 --- a/src/caffeine/team_type_m.f90 +++ b/src/caffeine/team_type_m.f90 @@ -1,34 +1,36 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module team_type_m + use iso_c_binding, only: c_ptr + implicit none private - public :: team_type, caf_form_team, current_team, caf_end_team, caf_change_team + public :: prif_team_type, prif_form_team, current_team, prif_end_team, prif_change_team - type team_type + type :: prif_team_type + type(c_ptr) :: team_ptr end type - type(team_type), pointer :: current_team => null() + type(prif_team_type), pointer :: current_team => null() interface - module subroutine caf_form_team (num, team, new_index, stat, errmsg) + module subroutine prif_form_team (num, team, new_index, stat, errmsg) integer, intent(in) :: num - type(team_type), intent(out) :: team + type(prif_team_type), intent(out) :: team integer, intent(in), optional :: new_index integer, intent(out), optional :: stat character(len=*), intent(inout), optional :: errmsg end subroutine - module subroutine caf_change_team(team) - type(team_type), target, intent(in) :: team + module subroutine prif_change_team(team) + type(prif_team_type), target, intent(in) :: team end subroutine - module subroutine caf_end_team() + module subroutine prif_end_team() end subroutine end interface end module team_type_m - diff --git a/src/caffeine/team_type_s.f90 b/src/caffeine/team_type_s.f90 index 4155f9c33..d0d39e0c2 100644 --- a/src/caffeine/team_type_s.f90 +++ b/src/caffeine/team_type_s.f90 @@ -5,13 +5,13 @@ contains - module procedure caf_change_team + module procedure prif_change_team end procedure - module procedure caf_end_team + module procedure prif_end_team end procedure - module procedure caf_form_team + module procedure prif_form_team end procedure end submodule diff --git a/src/caffeine_m.f90 b/src/caffeine_m.f90 deleted file mode 100644 index e1a9010f4..000000000 --- a/src/caffeine_m.f90 +++ /dev/null @@ -1,11 +0,0 @@ -! Copyright (c), The Regents of the University of California -! Terms of use are as specified in LICENSE.txt -module caffeine_m - use program_termination_m, only : caf_stop, caf_error_stop - use image_enumeration_m, only : caf_this_image, caf_num_images - use collective_subroutines_m, only : caf_co_sum, caf_co_max, caf_co_min, caf_co_reduce, caf_co_broadcast - use caffeinate_decaffeinate_m, only : caf_caffeinate, caf_decaffeinate - use team_type_m, only: caf_form_team, caf_change_team, caf_end_team, team_type - use synchronization_m, only : caf_sync_all - implicit none -end module caffeine_m diff --git a/src/prif.f90 b/src/prif.f90 new file mode 100644 index 000000000..aa3a689d0 --- /dev/null +++ b/src/prif.f90 @@ -0,0 +1,11 @@ +! Copyright (c), The Regents of the University of California +! 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 image_enumeration_m, only : prif_this_image, prif_num_images + 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 + implicit none +end module prif diff --git a/test/a00_caffeinate_test.f90 b/test/a00_caffeinate_test.f90 index fddac0737..a63a5156f 100644 --- a/test/a00_caffeinate_test.f90 +++ b/test/a00_caffeinate_test.f90 @@ -1,5 +1,5 @@ module a00_caffeinate_test - use caffeinate_decaffeinate_m, only : caf_caffeinate + use program_startup_m, only : prif_init use veggies, only: test_item_t, describe, result_t, it, assert_that implicit none @@ -22,7 +22,7 @@ function check_caffeination() result(result_) integer, parameter :: successful_initiation = 0 - result_ = assert_that(caf_caffeinate() == successful_initiation) + result_ = assert_that(prif_init() == successful_initiation) end function end module a00_caffeinate_test diff --git a/test/caf_co_broadcast_test.f90 b/test/caf_co_broadcast_test.f90 index aee0179ed..1ef942446 100644 --- a/test/caf_co_broadcast_test.f90 +++ b/test/caf_co_broadcast_test.f90 @@ -1,10 +1,10 @@ module caf_co_broadcast_test - use caffeine_m, only : caf_co_broadcast, caf_num_images, caf_this_image + use prif, only : prif_co_broadcast, prif_num_images, prif_this_image use veggies, only : result_t, test_item_t, describe, it, assert_equals, assert_that implicit none private - public :: test_caf_co_broadcast + public :: test_prif_co_broadcast type object_t integer i @@ -19,11 +19,11 @@ module caf_co_broadcast_test contains - function test_caf_co_broadcast() result(tests) + function test_prif_co_broadcast() result(tests) type(test_item_t) tests tests = describe( & - "The caf_co_broadcast subroutine", & + "The prif_co_broadcast subroutine", & [ it("broadcasts a default integer scalar with no optional arguments present", broadcast_default_integer_scalar) & ,it("broadcasts a derived type scalar with no allocatable components", broadcast_derived_type) & ]) @@ -44,8 +44,8 @@ function broadcast_default_integer_scalar() result(result_) integer iPhone integer, parameter :: source_value = 7779311, junk = -99 - iPhone = merge(source_value, junk, caf_this_image()==1) - call caf_co_broadcast(iPhone, source_image=1) + iPhone = merge(source_value, junk, prif_this_image()==1) + call prif_co_broadcast(iPhone, source_image=1) result_ = assert_equals(source_value, iPhone) end function @@ -54,11 +54,11 @@ function broadcast_derived_type() result(result_) type(object_t) object - associate(me => caf_this_image(), ni => caf_num_images()) + associate(me => prif_this_image(), ni => prif_num_images()) object = object_t(me, .false., "gooey", me*(1.,0.)) - call caf_co_broadcast(object, source_image=ni) + call prif_co_broadcast(object, source_image=ni) associate(expected_object => object_t(ni, .false., "gooey", ni*(1.,0.))) result_ = assert_that(expected_object == object, "co_broadcast derived type") diff --git a/test/caf_co_max_test.f90 b/test/caf_co_max_test.f90 index 125aa14e2..1091b66c3 100644 --- a/test/caf_co_max_test.f90 +++ b/test/caf_co_max_test.f90 @@ -1,18 +1,18 @@ module caf_co_max_test - use caffeine_m, only : caf_co_max, caf_num_images + use prif, only : prif_co_max, prif_num_images use veggies, only: result_t, test_item_t, assert_equals, describe, it, assert_that, assert_equals - use image_enumeration_m, only : caf_this_image, caf_num_images + use image_enumeration_m, only : prif_this_image, prif_num_images implicit none private - public :: test_caf_co_max + public :: test_prif_co_max contains - function test_caf_co_max() result(tests) + function test_prif_co_max() result(tests) type(test_item_t) tests tests = describe( & - "The caf_co_max subroutine computes the maximum", & + "The prif_co_max subroutine computes the maximum", & [ it("default integer scalar with stat argument present", max_default_integer_scalars) & ,it("integer(c_int64_t) scalar with no optional arguments present", max_c_int64_scalars) & ,it("default integer 1D array elements with no optional arguments present", max_default_integer_1D_array) & @@ -30,8 +30,8 @@ function max_default_integer_scalars() result(result_) integer i, status_ status_ = -1 - i = -caf_this_image() - call caf_co_max(i, stat=status_) + i = -prif_this_image() + call prif_co_max(i, stat=status_) result_ = assert_equals(-1, i) .and. assert_equals(0, status_) end function @@ -40,9 +40,9 @@ function max_c_int64_scalars() result(result_) type(result_t) result_ integer(c_int64_t) i - i = caf_this_image() - call caf_co_max(i) - result_ = assert_equals(caf_num_images(), int(i)) + i = prif_this_image() + call prif_co_max(i) + result_ = assert_equals(prif_num_images(), int(i)) end function function max_default_integer_1D_array() result(result_) @@ -50,10 +50,10 @@ function max_default_integer_1D_array() result(result_) integer i integer, allocatable :: array(:) - associate(sequence_ => caf_this_image()*[(i, i=1, caf_num_images())]) + associate(sequence_ => prif_this_image()*[(i, i=1, prif_num_images())]) array = sequence_ - call caf_co_max(array) - associate(max_sequence => caf_num_images()*[(i, i=1, caf_num_images())]) + call prif_co_max(array) + associate(max_sequence => prif_num_images()*[(i, i=1, prif_num_images())]) result_ = assert_that(all(max_sequence == array)) end associate end associate @@ -64,9 +64,9 @@ function max_default_integer_7D_array() result(result_) integer array(2,1,1, 1,1,1, 2), status_ status_ = -1 - array = 3 + caf_this_image() - call caf_co_max(array, stat=status_) - result_ = assert_that(all(array == 3+caf_num_images())) .and. assert_equals(0, status_) + array = 3 + prif_this_image() + call prif_co_max(array, stat=status_) + result_ = assert_that(all(array == 3+prif_num_images())) .and. assert_equals(0, status_) end function function max_default_real_scalars() result(result_) @@ -76,8 +76,8 @@ function max_default_real_scalars() result(result_) integer status_ status_ = -1 - scalar = -pi*caf_this_image() - call caf_co_max(scalar, stat=status_) + scalar = -pi*prif_this_image() + call prif_co_max(scalar, stat=status_) result_ = assert_equals(-dble(pi), dble(scalar) ) .and. assert_equals(0, status_) end function @@ -86,8 +86,8 @@ function max_double_precision_2D_array() result(result_) double precision, allocatable :: array(:,:) double precision, parameter :: tent(*,*) = dble(reshape(-[0,1,2,3,2,1], [3,2])) - array = tent*dble(caf_this_image()) - call caf_co_max(array) + array = tent*dble(prif_this_image()) + call prif_co_max(array) result_ = assert_that(all(array==tent)) end function @@ -104,7 +104,7 @@ function max_elements_in_3D_string_arrays() result(result_) end associate co_max_scramlet = scramlet - call caf_co_max(co_max_scramlet, result_image=1) + call prif_co_max(co_max_scramlet, result_image=1) block integer j, delta_j @@ -112,7 +112,7 @@ function max_elements_in_3D_string_arrays() result(result_) do j=1, size(script) expected_script(j) = script(j) - do delta_j = 1, max(caf_num_images()-1, size(script)) + do delta_j = 1, max(prif_num_images()-1, size(script)) associate(periodic_index => 1 + mod(j+delta_j-1, size(script))) expected_script(j) = max(expected_script(j), script(periodic_index)) end associate @@ -130,14 +130,14 @@ function reverse_alphabetize_default_character_scalars() result(result_) character(len=*), parameter :: words(*) = [character(len=len("loddy")):: "loddy","doddy","we","like","to","party"] character(len=:), allocatable :: my_word - associate(me => caf_this_image()) + associate(me => prif_this_image()) associate(periodic_index => 1 + mod(me-1,size(words))) my_word = words(periodic_index) - call caf_co_max(my_word) + call prif_co_max(my_word) end associate end associate - associate(expected_word => maxval(words(1:min(caf_num_images(), size(words))))) + associate(expected_word => maxval(words(1:min(prif_num_images(), size(words))))) result_ = assert_equals(expected_word, my_word) end associate end function diff --git a/test/caf_co_min_test.f90 b/test/caf_co_min_test.f90 index cae4826ae..39816d7e7 100644 --- a/test/caf_co_min_test.f90 +++ b/test/caf_co_min_test.f90 @@ -1,18 +1,18 @@ module caf_co_min_test - use caffeine_m, only : caf_co_min, caf_num_images + 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 : caf_this_image, caf_num_images + use image_enumeration_m, only : prif_this_image, prif_num_images implicit none private - public :: test_caf_co_min + public :: test_prif_co_min contains - function test_caf_co_min() result(tests) + function test_prif_co_min() result(tests) type(test_item_t) tests tests = describe( & - "The caf_co_min subroutine computes the minimum", & + "The prif_co_min subroutine computes the minimum", & [ it("default integer scalar with stat argument present", min_default_integer_scalars) & ,it("integer(c_int64_t) scalar with no optional arguments present", min_c_int64_scalars) & ,it("default integer 1D array elements with no optional arguments present", min_default_integer_1D_array) & @@ -30,9 +30,9 @@ function min_default_integer_scalars() result(result_) integer i, status_ status_ = -1 - i = -caf_this_image() - call caf_co_min(i, stat=status_) - result_ = assert_equals(-caf_num_images(), i) .and. assert_equals(0, status_) + i = -prif_this_image() + call prif_co_min(i, stat=status_) + result_ = assert_equals(-prif_num_images(), i) .and. assert_equals(0, status_) end function function min_c_int64_scalars() result(result_) @@ -40,8 +40,8 @@ function min_c_int64_scalars() result(result_) type(result_t) result_ integer(c_int64_t) i - i = caf_this_image() - call caf_co_min(i) + i = prif_this_image() + call prif_co_min(i) result_ = assert_equals(1, int(i)) end function @@ -50,10 +50,10 @@ function min_default_integer_1D_array() result(result_) integer i integer, allocatable :: array(:) - associate(sequence_ => caf_this_image()*[(i, i=1, caf_num_images())]) + associate(sequence_ => prif_this_image()*[(i, i=1, prif_num_images())]) array = sequence_ - call caf_co_min(array) - associate(min_sequence => [(i, i=1, caf_num_images())]) + call prif_co_min(array) + associate(min_sequence => [(i, i=1, prif_num_images())]) result_ = assert_that(all(min_sequence == array)) end associate end associate @@ -64,9 +64,9 @@ function min_default_integer_7D_array() result(result_) integer array(2,1,1, 1,1,1, 2), status_ status_ = -1 - array = 3 - caf_this_image() - call caf_co_min(array, stat=status_) - result_ = assert_that(all(array == 3 - caf_num_images())) .and. assert_equals(0, status_) + array = 3 - prif_this_image() + call prif_co_min(array, stat=status_) + result_ = assert_that(all(array == 3 - prif_num_images())) .and. assert_equals(0, status_) end function function min_default_real_scalars() result(result_) @@ -76,9 +76,9 @@ function min_default_real_scalars() result(result_) integer status_ status_ = -1 - scalar = -pi*caf_this_image() - call caf_co_min(scalar, stat=status_) - result_ = assert_equals(-dble(pi*caf_num_images()), dble(scalar) ) .and. assert_equals(0, status_) + scalar = -pi*prif_this_image() + call prif_co_min(scalar, stat=status_) + result_ = assert_equals(-dble(pi*prif_num_images()), dble(scalar) ) .and. assert_equals(0, status_) end function function min_double_precision_2D_array() result(result_) @@ -86,9 +86,9 @@ function min_double_precision_2D_array() result(result_) double precision, allocatable :: array(:,:) double precision, parameter :: tent(*,*) = dble(reshape(-[0,1,2,3,2,1], [3,2])) - array = tent*dble(caf_this_image()) - call caf_co_min(array) - result_ = assert_that(all(array==tent*caf_num_images())) + array = tent*dble(prif_this_image()) + call prif_co_min(array) + result_ = assert_that(all(array==tent*prif_num_images())) end function function min_elements_in_2D_string_arrays() result(result_) @@ -105,7 +105,7 @@ function min_elements_in_2D_string_arrays() result(result_) end associate co_min_scramlet = scramlet - call caf_co_min(co_min_scramlet, result_image=1) + call prif_co_min(co_min_scramlet, result_image=1) block integer j, delta_j @@ -113,7 +113,7 @@ function min_elements_in_2D_string_arrays() result(result_) do j=1, size(script) expected_script(j) = script(j) - do delta_j = 1, min(caf_num_images()-1, size(script)) + do delta_j = 1, min(prif_num_images()-1, size(script)) associate(periodic_index => 1 + mod(j+delta_j-1, size(script))) expected_script(j) = min(expected_script(j), script(periodic_index)) end associate @@ -131,14 +131,14 @@ function alphabetically_1st_scalar_string() result(result_) character(len=*), parameter :: words(*) = [character(len=len("to party!")):: "Loddy","doddy","we","like","to party!"] character(len=:), allocatable :: my_word - associate(me => caf_this_image()) + associate(me => prif_this_image()) associate(periodic_index => 1 + mod(me-1,size(words))) my_word = words(periodic_index) - call caf_co_min(my_word) + call prif_co_min(my_word) end associate end associate - associate(expected_word => minval(words(1:min(caf_num_images(), size(words))))) + associate(expected_word => minval(words(1:min(prif_num_images(), size(words))))) result_ = assert_equals(expected_word, my_word) end associate end function diff --git a/test/caf_co_reduce_test.f90 b/test/caf_co_reduce_test.f90 index 929280f5d..ea637ded5 100644 --- a/test/caf_co_reduce_test.f90 +++ b/test/caf_co_reduce_test.f90 @@ -1,5 +1,5 @@ module caf_co_reduce_test - use caffeine_m, only : caf_co_reduce, caf_num_images, caf_this_image + use prif, only : prif_co_reduce, prif_num_images, prif_this_image use veggies, only : result_t, test_item_t, assert_equals, describe, it, assert_that, assert_equals use collective_subroutines_m, only : & c_int32_t_operation, c_int64_t_operation, c_float_operation, c_double_operation, c_char_operation, c_bool_operation & @@ -9,15 +9,15 @@ module caf_co_reduce_test implicit none private - public :: test_caf_co_reduce + public :: test_prif_co_reduce contains - function test_caf_co_reduce() result(tests) + function test_prif_co_reduce() result(tests) type(test_item_t) tests tests = describe( & - "The caf_co_reduce subroutine", & + "The prif_co_reduce subroutine", & [ it("finds the alphabetically first length-5 string with result_image present", alphabetically_1st_size1_string_array) & ,it("sums default integer scalars with no optional arguments present", sum_default_integer_scalars) & ,it("sums integer(c_int64_t) scalars with no optional arguments present", sum_c_int64_t_scalars) & @@ -38,14 +38,14 @@ function alphabetically_1st_size1_string_array() result(result_) alphabetize_operation => alphabetize - associate(me => caf_this_image()) + associate(me => prif_this_image()) associate(periodic_index => 1 + mod(me-1,size(names))) my_name = [names(periodic_index)] - call caf_co_reduce(my_name, c_funloc(alphabetize_operation)) + call prif_co_reduce(my_name, c_funloc(alphabetize_operation)) end associate end associate - associate(expected_name => minval(names(1:min(caf_num_images(), size(names))))) + associate(expected_name => minval(names(1:min(prif_num_images(), size(names))))) result_ = assert_that(all(expected_name == my_name)) end associate @@ -69,8 +69,8 @@ function sum_integer_array_elements() result(result_) add_operation => add_integers array = input_array - call caf_co_reduce(array, c_funloc(add_operation)) - result_ = assert_that(all(caf_num_images()*input_array==array)) + call prif_co_reduce(array, c_funloc(add_operation)) + result_ = assert_that(all(prif_num_images()*input_array==array)) contains @@ -91,8 +91,8 @@ function sum_complex_c_double_scalars() result(result_) add_operation => add_complex z = z_input - call caf_co_reduce(z, c_funloc(add_operation), stat=status_) - result_ = assert_equals(real(caf_num_images()*z_input, c_double), real(z, c_double)) .and. assert_equals(0, status_) + call prif_co_reduce(z, c_funloc(add_operation), stat=status_) + result_ = assert_equals(real(prif_num_images()*z_input, c_double), real(z, c_double)) .and. assert_equals(0, status_) contains @@ -113,8 +113,8 @@ function sum_default_complex_scalars() result(result_) add_operation => add_complex z = z_input - call caf_co_reduce(z, c_funloc(add_operation), stat=status_) - result_ = assert_equals(dble(caf_num_images()*z_input), dble(z)) .and. assert_equals(0, status_) + call prif_co_reduce(z, c_funloc(add_operation), stat=status_) + result_ = assert_equals(dble(prif_num_images()*z_input), dble(z)) .and. assert_equals(0, status_) contains @@ -133,8 +133,8 @@ function sum_default_integer_scalars() result(result_) add_operation => add i = 1 - call caf_co_reduce(i, c_funloc(add_operation)) - result_ = assert_equals(caf_num_images(), i) + call prif_co_reduce(i, c_funloc(add_operation)) + result_ = assert_equals(prif_num_images(), i) contains @@ -153,8 +153,8 @@ function sum_c_int64_t_scalars() result(result_) add_operation => add i = 1_c_int64_t - call caf_co_reduce(i, c_funloc(add_operation)) - result_ = assert_that(int(caf_num_images(), c_int64_t)==i) + call prif_co_reduce(i, c_funloc(add_operation)) + result_ = assert_that(int(prif_num_images(), c_int64_t)==i) contains @@ -175,17 +175,17 @@ function reports_on_consensus() result(result_) boolean_operation => logical_and - one_false = merge(c_false, c_true, caf_this_image()==1) - call caf_co_reduce(one_false, c_funloc(boolean_operation)) + one_false = merge(c_false, c_true, prif_this_image()==1) + call prif_co_reduce(one_false, c_funloc(boolean_operation)) - one_true = merge(c_true, c_false, caf_this_image()==1) - call caf_co_reduce(one_true, c_funloc(boolean_operation)) + one_true = merge(c_true, c_false, prif_this_image()==1) + call prif_co_reduce(one_true, c_funloc(boolean_operation)) all_true = c_true - call caf_co_reduce(all_true, c_funloc(boolean_operation)) + call prif_co_reduce(all_true, c_funloc(boolean_operation)) ans1 = one_false .eqv. c_false - ans2 = one_true .eqv. merge(c_true,c_false,caf_num_images()==1) + ans2 = one_true .eqv. merge(c_true,c_false,prif_num_images()==1) ans3 = all_true .eqv. c_true result_ = assert_that(ans1) .and. & assert_that(ans2) .and. & @@ -209,10 +209,10 @@ function multiply_c_double_scalars() result(result_) error_message = "unused" multiply_operation => multiply_doubles - associate(me => caf_this_image()) + associate(me => prif_this_image()) p = real(me,c_double) - call caf_co_reduce(p, c_funloc(multiply_operation), result_image=1, stat=status_, errmsg=error_message) - associate(expected_result => merge( product([(real(j,c_double), j = 1, caf_num_images())]), real(me,c_double), me==1 )) + call prif_co_reduce(p, c_funloc(multiply_operation), result_image=1, stat=status_, errmsg=error_message) + associate(expected_result => merge( product([(real(j,c_double), j = 1, prif_num_images())]), real(me,c_double), me==1 )) result_ = & assert_equals(expected_result, real(p,c_double)) .and. & assert_equals(0, status_) .and. & @@ -239,10 +239,10 @@ function multiply_default_real_scalars() result(result_) error_message = "unused" multiply_operation => multiply - associate(me => caf_this_image()) + associate(me => prif_this_image()) p = real(me) - call caf_co_reduce(p, c_funloc(multiply_operation), result_image=1, stat=status_, errmsg=error_message) - associate(expected_result => merge( product([(dble(j), j = 1, caf_num_images())]), dble(me), me==1 )) + call prif_co_reduce(p, c_funloc(multiply_operation), result_image=1, stat=status_, errmsg=error_message) + associate(expected_result => merge( product([(dble(j), j = 1, prif_num_images())]), dble(me), me==1 )) result_ = & assert_equals(expected_result, dble(p)) .and. & assert_equals(0, status_) .and. & diff --git a/test/caf_co_sum_test.f90 b/test/caf_co_sum_test.f90 index 0181c2496..e14895ea6 100644 --- a/test/caf_co_sum_test.f90 +++ b/test/caf_co_sum_test.f90 @@ -1,17 +1,17 @@ module caf_co_sum_test - use caffeine_m, only : caf_co_sum, caf_num_images, caf_this_image + use prif, only : prif_co_sum, prif_num_images, prif_this_image use veggies, only: result_t, test_item_t, assert_equals, describe, it, assert_that, assert_equals, succeed implicit none private - public :: test_caf_co_sum + public :: test_prif_co_sum contains - function test_caf_co_sum() result(tests) + function test_prif_co_sum() result(tests) type(test_item_t) tests tests = describe( & - "The caf_co_sum subroutine", & + "The prif_co_sum subroutine", & [ it("sums default integer scalars with no optional arguments present", sum_default_integer_scalars) & ,it("sums default integer scalars with all arguments present", sum_integers_all_arguments) & ,it("sums integer(c_int64_t) scalars with stat argument present", sum_c_int64_scalars) & @@ -29,8 +29,8 @@ function sum_default_integer_scalars() result(result_) integer i i = 1 - call caf_co_sum(i) - result_ = assert_equals(caf_num_images(), i) + call prif_co_sum(i) + result_ = assert_equals(prif_num_images(), i) end function function sum_integers_all_arguments() result(result_) @@ -44,8 +44,8 @@ function sum_integers_all_arguments() result(result_) status_ = -1 error_message = whitespace - associate(expected_i => merge(caf_num_images()*i, i, caf_this_image()==result_image_)) - call caf_co_sum(i, result_image_, status_, error_message) + associate(expected_i => merge(prif_num_images()*i, i, prif_this_image()==result_image_)) + call prif_co_sum(i, result_image_, status_, error_message) result_ = assert_equals(expected_i, i) .and. assert_equals(0, status_) .and. assert_equals(whitespace, error_message) end associate end function @@ -58,9 +58,9 @@ function sum_c_int64_scalars() result(result_) status_ = -1 i = 2_c_int64_t - call caf_co_sum(i, stat=status_) + call prif_co_sum(i, stat=status_) i_default_kind = i - result_ = assert_equals(2*caf_num_images(), int(i)) .and. assert_equals(0, status_) + result_ = assert_equals(2*prif_num_images(), int(i)) .and. assert_equals(0, status_) end function function sum_default_integer_1D_array() result(result_) @@ -68,10 +68,10 @@ function sum_default_integer_1D_array() result(result_) integer i integer, allocatable :: array(:) - associate(images => caf_num_images()) + associate(images => prif_num_images()) associate(sequence_ => [(i,i=1,images)]) array = sequence_ - call caf_co_sum(array) + call prif_co_sum(array) result_ = assert_that(all(array==images*sequence_)) end associate end associate @@ -84,8 +84,8 @@ function sum_default_integer_15D_array() result(result_) status_ = -1 array = 3 - call caf_co_sum(array, stat=status_) - result_ = assert_that(all(3*caf_num_images() == array)) .and. assert_equals(0, status_) + call prif_co_sum(array, stat=status_) + result_ = assert_that(all(3*prif_num_images() == array)) .and. assert_equals(0, status_) end function function sum_default_real_scalars() result(result_) @@ -96,8 +96,8 @@ function sum_default_real_scalars() result(result_) result_image_ = 1 scalar = e - call caf_co_sum(scalar, result_image=result_image_) - associate(expected_result => merge(caf_num_images()*e, e, caf_this_image()==result_image_)) + call prif_co_sum(scalar, result_image=result_image_) + associate(expected_result => merge(prif_num_images()*e, e, prif_this_image()==result_image_)) result_ = assert_equals(dble(expected_result), dble(scalar)) end associate end function @@ -108,8 +108,8 @@ function sum_double_precision_2D_array() result(result_) double precision, parameter :: input(*,*) = reshape(-[6,5,4,3,2,1], [3,2]) array = input - call caf_co_sum(array) - result_ = assert_equals(product(caf_num_images()*input), product(array)) + call prif_co_sum(array) + result_ = assert_equals(product(prif_num_images()*input), product(array)) end function function sum_default_complex_scalars() result(result_) @@ -121,8 +121,8 @@ function sum_default_complex_scalars() result(result_) status_ = -1 z = i - call caf_co_sum(z, stat=status_) - result_ = assert_equals(dble(abs(i*caf_num_images())), dble(abs(z)) ) .and. assert_equals(0, status_) + call prif_co_sum(z, stat=status_) + result_ = assert_equals(dble(abs(i*prif_num_images())), dble(abs(z)) ) .and. assert_equals(0, status_) end function function sum_dble_complex_1D_arrays() result(result_) @@ -132,8 +132,8 @@ function sum_dble_complex_1D_arrays() result(result_) complex(dp), parameter :: input(*) = [(1.D0,1.0D0)] array = [(1.D0,1.D0)] - call caf_co_sum(array) - result_ = assert_that(all([input*caf_num_images()] == array)) + call prif_co_sum(array) + result_ = assert_that(all([input*prif_num_images()] == array)) end function end module caf_co_sum_test diff --git a/test/caf_error_stop_test.f90 b/test/caf_error_stop_test.f90 index 2cc1038c1..4a503e5f4 100644 --- a/test/caf_error_stop_test.f90 +++ b/test/caf_error_stop_test.f90 @@ -3,14 +3,14 @@ module caf_error_stop_test implicit none private - public :: test_caf_this_image + public :: test_prif_this_image contains - function test_caf_this_image() result(tests) + function test_prif_this_image() result(tests) type(test_item_t) :: tests tests = describe( & - "A program that executes the caf_error_stop function", & + "A program that executes the prif_error_stop function", & [ it("exits with a non-zero exitstat when stop code is an integer", check_integer_stop_code) & ,it("exits with a non-zero exitstat when stop code is an character", check_character_stop_code) & ]) diff --git a/test/caf_num_images_test.f90 b/test/caf_num_images_test.f90 index 4b312ad18..1f1808cb0 100644 --- a/test/caf_num_images_test.f90 +++ b/test/caf_num_images_test.f90 @@ -1,25 +1,25 @@ module caf_num_images_test - use caffeine_m, only : caf_num_images + use prif, only : prif_num_images use veggies, only: result_t, test_item_t, assert_that, describe, it implicit none private - public :: test_caf_num_images + public :: test_prif_num_images contains - function test_caf_num_images() result(tests) + function test_prif_num_images() result(tests) type(test_item_t) :: tests tests = & describe( & - "The caf_num_images function result", & + "The prif_num_images function result", & [ it("is a valid number of images when invoked with no arguments", check_num_images_valid) & ]) end function function check_num_images_valid() result(result_) type(result_t) :: result_ - result_ = assert_that(caf_num_images()>0, "positive number of images") + result_ = assert_that(prif_num_images()>0, "positive number of images") end function end module caf_num_images_test diff --git a/test/caf_stop_test.f90 b/test/caf_stop_test.f90 index 048405fb9..94edd094f 100644 --- a/test/caf_stop_test.f90 +++ b/test/caf_stop_test.f90 @@ -3,14 +3,14 @@ module caf_stop_test implicit none private - public :: test_caf_this_image + public :: test_prif_this_image contains - function test_caf_this_image() result(tests) + function test_prif_this_image() result(tests) type(test_item_t) :: tests tests = describe( & - "A program that executes the caf_stop function", & + "A program that executes the prif_stop function", & [ it("exits with a zero exitstat when the program omits the stop code", exit_with_no_stop_code) & ,it("prints an integer stop code and exits with exitstat equal to the stop code", exit_with_integer_stop_code) & ,it("prints a character stop code and exits with a non-zero existat", exit_with_character_stop_code) & diff --git a/test/caf_this_image_test.f90 b/test/caf_this_image_test.f90 index 15b449076..020f2c0a0 100644 --- a/test/caf_this_image_test.f90 +++ b/test/caf_this_image_test.f90 @@ -1,19 +1,19 @@ module caf_this_image_test - use caffeine_m, only : caf_this_image, caf_num_images, caf_co_sum + use prif, only : prif_this_image, prif_num_images, prif_co_sum use veggies, only: result_t, test_item_t, assert_that, describe, it, succeed implicit none private - public :: test_caf_this_image + public :: test_prif_this_image contains - function test_caf_this_image() result(tests) + function test_prif_this_image() result(tests) type(test_item_t) :: tests integer, parameter :: initiation_success = 0 tests = describe( & - "The caf_this_image function result", & + "The prif_this_image function result", & [ it("is the proper member of the set {1,2,...,num_images()} when invoked as this_image()", check_this_image_set) & ]) end function @@ -23,9 +23,9 @@ function check_this_image_set() result(result_) integer, allocatable :: image_numbers(:) integer i - associate(me => caf_this_image(), ni => caf_num_images()) + associate(me => prif_this_image(), ni => prif_num_images()) image_numbers = [(merge(0, me, me/=i), i = 1, ni)] - call caf_co_sum(image_numbers) + call prif_co_sum(image_numbers) result_ = assert_that(all(image_numbers == [(i, i = 1, ni)]) .and. size(image_numbers)>0, "correct image set") end associate end function diff --git a/test/main.f90 b/test/main.f90 index 4114d6c40..2cd6a79d7 100644 --- a/test/main.f90 +++ b/test/main.f90 @@ -9,32 +9,32 @@ function run() result(passed) a00_caffeinate_caffeinate => & test_caffeinate use caf_co_broadcast_test, only: & - caf_co_broadcast_caf_co_broadcast => & - test_caf_co_broadcast + prif_co_broadcast_prif_co_broadcast => & + test_prif_co_broadcast use caf_co_max_test, only: & - caf_co_max_caf_co_max => & - test_caf_co_max + prif_co_max_prif_co_max => & + test_prif_co_max use caf_co_min_test, only: & - caf_co_min_caf_co_min => & - test_caf_co_min + prif_co_min_prif_co_min => & + test_prif_co_min use caf_co_reduce_test, only: & - caf_co_reduce_caf_co_reduce => & - test_caf_co_reduce + prif_co_reduce_prif_co_reduce => & + test_prif_co_reduce use caf_co_sum_test, only: & - caf_co_sum_caf_co_sum => & - test_caf_co_sum + prif_co_sum_prif_co_sum => & + test_prif_co_sum use caf_error_stop_test, only: & - caf_error_stop_caf_this_image => & - test_caf_this_image + prif_error_stop_prif_this_image => & + test_prif_this_image use caf_num_images_test, only: & - caf_num_images_caf_num_images => & - test_caf_num_images + prif_num_images_prif_num_images => & + test_prif_num_images use caf_stop_test, only: & - caf_stop_caf_this_image => & - test_caf_this_image + prif_stop_prif_this_image => & + test_prif_this_image use caf_this_image_test, only: & - caf_this_image_caf_this_image => & - test_caf_this_image + prif_this_image_prif_this_image => & + test_prif_this_image use veggies, only: test_item_t, test_that, run_tests @@ -45,15 +45,15 @@ function run() result(passed) type(test_item_t) :: individual_tests(10) individual_tests(1) = a00_caffeinate_caffeinate() - individual_tests(2) = caf_co_broadcast_caf_co_broadcast() - individual_tests(3) = caf_co_max_caf_co_max() - individual_tests(4) = caf_co_min_caf_co_min() - individual_tests(5) = caf_co_reduce_caf_co_reduce() - individual_tests(6) = caf_co_sum_caf_co_sum() - individual_tests(7) = caf_error_stop_caf_this_image() - individual_tests(8) = caf_num_images_caf_num_images() - individual_tests(9) = caf_stop_caf_this_image() - individual_tests(10) = caf_this_image_caf_this_image() + individual_tests(2) = prif_co_broadcast_prif_co_broadcast() + individual_tests(3) = prif_co_max_prif_co_max() + individual_tests(4) = prif_co_min_prif_co_min() + individual_tests(5) = prif_co_reduce_prif_co_reduce() + individual_tests(6) = prif_co_sum_prif_co_sum() + individual_tests(7) = prif_error_stop_prif_this_image() + individual_tests(8) = prif_num_images_prif_num_images() + individual_tests(9) = prif_stop_prif_this_image() + individual_tests(10) = prif_this_image_prif_this_image() tests = test_that(individual_tests)