From 7604fa5fd4ffc476cee3b62d9ee9fb001f7c4c8b Mon Sep 17 00:00:00 2001 From: Katherine Rasmussen Date: Tue, 23 Jun 2026 18:24:58 -0700 Subject: [PATCH 1/2] Add more multi image intrinsic function calls to the integration test. --- app/native-multi-image.F90 | 50 +++++++++++++++++++++++++++++++++++++- 1 file changed, 49 insertions(+), 1 deletion(-) diff --git a/app/native-multi-image.F90 b/app/native-multi-image.F90 index d5c028d9..b6a56165 100644 --- a/app/native-multi-image.F90 +++ b/app/native-multi-image.F90 @@ -58,7 +58,7 @@ program native_multi_image #endif #ifndef HAVE_COARRAY -#define HAVE_COARRAY 0 +#define HAVE_COARRAY 1 #endif #ifndef HAVE_MAIN_COARRAY #define HAVE_MAIN_COARRAY HAVE_COARRAY @@ -67,6 +67,23 @@ program native_multi_image #define HAVE_ALLOC_COARRAY HAVE_COARRAY #endif +! coarray query intrinsics +#ifndef HAVE_COARRAY_QUERY +#define HAVE_COARRAY_QUERY HAVE_COARRAY +#endif +#ifndef HAVE_COBOUND +#define HAVE_COBOUND HAVE_COARRAY_QUERY +#endif +#ifndef HAVE_COSHAPE +#define HAVE_COSHAPE HAVE_COARRAY_QUERY +#endif +#ifndef HAVE_IMAGE_INDEX +#define HAVE_IMAGE_INDEX HAVE_COARRAY_QUERY +#endif +#ifndef HAVE_THIS_IMAGE_COARRAY +#define HAVE_THIS_IMAGE_COARRAY HAVE_COARRAY_QUERY +#endif + ! Helper macros #define CHECK_TYPE_COMPLIANCE(subject_type, subject, is_team, min_size) \ BLOCK ; \ @@ -190,6 +207,37 @@ program native_multi_image write(*,'(A,I3)') "After END TEAM statement, TEAM_NUMBER() is ", TEAM_NUMBER() # endif +# if HAVE_MAIN_COARRAY +# if HAVE_COBOUND + call status("Testing LCOBOUND/UCOBOUND...") + write(*,'(A,3I3)') "lcobound(sca_int_3) = ", LCOBOUND(sca_int_3) + write(*,'(A,3I3)') "ucobound(sca_int_3) = ", UCOBOUND(sca_int_3) + write(*,'(A,I3)') "lcobound(sca_int_3, dim=2) = ", LCOBOUND(sca_int_3, dim=2) + write(*,'(A,I3)') "ucobound(sca_int_3, dim=2) = ", UCOBOUND(sca_int_3, dim=2) + write(*,'(A,I3)') "lcobound(sca_int_3, dim=2, kind=8) = ", LCOBOUND(sca_int_3, dim=2, kind=8) + write(*,'(A,I3)') "ucobound(sca_int_3, dim=2, kind=8) = ", UCOBOUND(sca_int_3, dim=2, kind=8) +# endif +# if HAVE_COSHAPE + call status("Testing COSHAPE...") + write(*,'(A,3I3)') "coshape(sca_int_3) = ", COSHAPE(sca_int_3) + write(*,'(A,3I3)') "coshape(sca_int_3, kind=8) = ", COSHAPE(sca_int_3, kind=8) +# endif +# if HAVE_IMAGE_INDEX + call status("Testing IMAGE_INDEX...") + write(*,'(A,I3)') "image_index(sca_int_1, [1]) = ", IMAGE_INDEX(sca_int_1, [1]) +# if HAVE_TEAM + write(*,'(A,I3)') "image_index(sca_int_1, [1], get_team()) = ", IMAGE_INDEX(sca_int_1, [1], GET_TEAM()) + write(*,'(A,I3)') "image_index(sca_int_1, [1], team_number=-1) = ", IMAGE_INDEX(sca_int_1, [1], TEAM_NUMBER=-1) +# endif +# endif +# if HAVE_THIS_IMAGE_COARRAY + call status("Testing THIS_IMAGE(coarray)...") + write(*,'(A,I3)') "this_image(sca_int_1) = ", THIS_IMAGE(sca_int_1) + write(*,'(A,3I3)') "this_image(sca_int_3) = ", THIS_IMAGE(sca_int_3) + write(*,'(A,I3)') "this_image(sca_int_3, dim=2) = ", THIS_IMAGE(sca_int_3, dim=2) +# endif +# endif + # if HAVE_EVENT_TYPE CHECK_TYPE_COMPLIANCE(EVENT_TYPE, default_event, .false., 64) # endif From fa39daa6046c0656712c031074a22167c9134c02 Mon Sep 17 00:00:00 2001 From: Katherine Rasmussen Date: Thu, 25 Jun 2026 17:03:31 -0700 Subject: [PATCH 2/2] Update native-multi-image.F90 with more intrinsic function calls --- app/native-multi-image.F90 | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/app/native-multi-image.F90 b/app/native-multi-image.F90 index b6a56165..667751fb 100644 --- a/app/native-multi-image.F90 +++ b/app/native-multi-image.F90 @@ -210,6 +210,8 @@ program native_multi_image # if HAVE_MAIN_COARRAY # if HAVE_COBOUND call status("Testing LCOBOUND/UCOBOUND...") + write(*,'(A,2I3)') "lcobound(sca_int_2) = ", LCOBOUND(sca_int_2) + write(*,'(A,2I3)') "ucobound(sca_int_2) = ", UCOBOUND(sca_int_2) write(*,'(A,3I3)') "lcobound(sca_int_3) = ", LCOBOUND(sca_int_3) write(*,'(A,3I3)') "ucobound(sca_int_3) = ", UCOBOUND(sca_int_3) write(*,'(A,I3)') "lcobound(sca_int_3, dim=2) = ", LCOBOUND(sca_int_3, dim=2) @@ -225,14 +227,19 @@ program native_multi_image # if HAVE_IMAGE_INDEX call status("Testing IMAGE_INDEX...") write(*,'(A,I3)') "image_index(sca_int_1, [1]) = ", IMAGE_INDEX(sca_int_1, [1]) + write(*,'(A,I3)') "image_index(sca_int_2, [1,1]) = ", IMAGE_INDEX(sca_int_2, [1,1]) + write(*,'(A,I3)') "image_index(sca_int_3, [1,1,1]) = ", IMAGE_INDEX(sca_int_3, [1,1,1]) # if HAVE_TEAM - write(*,'(A,I3)') "image_index(sca_int_1, [1], get_team()) = ", IMAGE_INDEX(sca_int_1, [1], GET_TEAM()) +! write(*,'(A,I3)') "image_index(sca_int_1, [1], get_team()) = ", IMAGE_INDEX(sca_int_1, [1], GET_TEAM()) write(*,'(A,I3)') "image_index(sca_int_1, [1], team_number=-1) = ", IMAGE_INDEX(sca_int_1, [1], TEAM_NUMBER=-1) +! write(*,'(A,I3)') "image_index(sca_int_3, [1,1,1], get_team()) = ", IMAGE_INDEX(sca_int_3, [1,1,1], GET_TEAM()) + write(*,'(A,I3)') "image_index(sca_int_3, [1,1,1], team_number=-1) = ", IMAGE_INDEX(sca_int_3, [1,1,1], TEAM_NUMBER=-1) # endif # endif # if HAVE_THIS_IMAGE_COARRAY call status("Testing THIS_IMAGE(coarray)...") write(*,'(A,I3)') "this_image(sca_int_1) = ", THIS_IMAGE(sca_int_1) + write(*,'(A,2I3)') "this_image(sca_int_2) = ", THIS_IMAGE(sca_int_2) write(*,'(A,3I3)') "this_image(sca_int_3) = ", THIS_IMAGE(sca_int_3) write(*,'(A,I3)') "this_image(sca_int_3, dim=2) = ", THIS_IMAGE(sca_int_3, dim=2) # endif