From bef452081ab157aac3e7125dd28e4ba60ffbc981 Mon Sep 17 00:00:00 2001 From: Frank Malatino Date: Thu, 27 Mar 2025 09:51:54 -0400 Subject: [PATCH 1/7] Changes to use single pointer for maskmap in define_domains --- c_fms/c_fms.F90 | 19 ++++++++++--------- c_fms/c_fms.h | 4 ++-- test_cfms/c_fms/c_mpp_domains_helper.h | 2 +- test_cfms/c_fms/test_define_domains.c | 12 +++++++----- 4 files changed, 20 insertions(+), 17 deletions(-) diff --git a/c_fms/c_fms.F90 b/c_fms/c_fms.F90 index ef37a03..3ce2011 100644 --- a/c_fms/c_fms.F90 +++ b/c_fms/c_fms.F90 @@ -254,7 +254,7 @@ subroutine cFMS_define_domains(global_indices, layout, domain_id, pelist, & integer, intent(in), optional :: xflags, yflags integer, intent(in), optional :: xhalo, yhalo integer, intent(in), optional :: xextent(layout(1)), yextent(layout(2)) - type(c_ptr), intent(in), optional :: maskmap + type(c_ptr), intent(in), value :: maskmap character(c_char), intent(in), optional :: name(NAME_LENGTH) logical(c_bool), intent(in), optional :: symmetry integer, intent(in), optional :: memory_size(2) @@ -268,7 +268,8 @@ subroutine cFMS_define_domains(global_indices, layout, domain_id, pelist, & character(len=NAME_LENGTH) :: name_f = "cdomain" integer :: global_indices_f(4) - logical(c_bool), pointer :: maskmap_f(:,:) => NULL() + logical(c_bool), allocatable :: maskmap_f(:,:) + logical(c_bool), pointer :: maskmap_fp(:,:) logical :: symmetry_f = .False. logical :: is_mosaic_f = .False. logical :: complete_f = .True. @@ -283,15 +284,15 @@ subroutine cFMS_define_domains(global_indices, layout, domain_id, pelist, & if(present(is_mosaic)) is_mosaic_f = logical(is_mosaic) if(present(complete)) complete_f = logical(complete) - nullify(maskmap_f) + nullify(maskmap_fp) - if(present(maskmap)) then - call c_f_pointer(maskmap, maskmap_f, (/layout(2), layout(1)/)) - maskmap_f = reshape(maskmap_f, shape=(/layout(1), layout(2)/)) + if(c_associated(maskmap)) then + allocate(maskmap_f(layout(1), layout(2))) + call c_f_pointer(maskmap, maskmap_fp, (/layout(2), layout(1)/)) + maskmap_f = reshape(maskmap_fp, shape=(/layout(1), layout(2)/)) else allocate(maskmap_f(layout(1), layout(2))) maskmap_f = .True. - dealloc_maskmap = .True. end if call cFMS_set_current_domain(domain_id) @@ -304,8 +305,8 @@ subroutine cFMS_define_domains(global_indices, layout, domain_id, pelist, & if(present(tile_id)) tile_id = tile_id - 1; if(present(tile_count)) tile_count = tile_count - 1; - if(dealloc_maskmap) deallocate(maskmap_f) - nullify(maskmap_f) + nullify(maskmap_fp) + deallocate(maskmap_f) end subroutine cFMS_define_domains diff --git a/c_fms/c_fms.h b/c_fms/c_fms.h index 731d352..5a86be2 100644 --- a/c_fms/c_fms.h +++ b/c_fms/c_fms.h @@ -61,7 +61,7 @@ extern void cFMS_set_current_pelist(int *pelist, bool *no_sync); extern void cFMS_define_domains(int global_indices[4], int layout[2], int *domain_id, int pelist[], int *xflags, int *yflags, int *xhalo, int *yhalo, int xextent[], int yextent[], - bool **maskmap, char *name, bool *symmetry, int memory_size[2], + bool *maskmap, char *name, bool *symmetry, int memory_size[2], int *whalo, int *ehalo, int *shalo, int *nhalo, bool *is_mosaic, int *tile_count, int *tile_id, bool *complete, int *x_cyclic_offset, int *y_cyclic_offset); @@ -105,7 +105,7 @@ extern void cFMS_set_data_domain(int *domain_id, int *xbegin, int *xend, int *yb extern void cFMS_set_global_domain(int *domain_id, int *xbegin, int *xend, int *ybegin, int *yend, int *xsize, int *ysize, int *tile_count); -extern void cFMS_update_domains_float_2d(int *field_shape, float **field, int *domain_id, int *flags, int *complete, +extern void cFMS_update_domains_float_2d(int *field_shape, float *field, int *domain_id, int *flags, int *complete, int *position, int *whalo, int *ehalo, int *shalo, int *nhalo, char *name, int *tile_count); diff --git a/test_cfms/c_fms/c_mpp_domains_helper.h b/test_cfms/c_fms/c_mpp_domains_helper.h index 1445048..7b68556 100644 --- a/test_cfms/c_fms/c_mpp_domains_helper.h +++ b/test_cfms/c_fms/c_mpp_domains_helper.h @@ -20,7 +20,7 @@ typedef struct { int* yhalo; int* xextent; int* yextent; - bool** maskmap; + bool* maskmap; char* name; bool* symmetry; int *memory_size; //memory_size[2] diff --git a/test_cfms/c_fms/test_define_domains.c b/test_cfms/c_fms/test_define_domains.c index 74b4ea3..0d2b7a1 100644 --- a/test_cfms/c_fms/test_define_domains.c +++ b/test_cfms/c_fms/test_define_domains.c @@ -94,10 +94,12 @@ int main() { char name[NAME_LENGTH] = "test coarse domain"; - bool *maskmap_blob = (bool *)calloc(4,sizeof(bool)); - cdomain.maskmap = (bool **)calloc(2,sizeof(bool *)); - for(int i=0; i<2; i++) cdomain.maskmap[i] = maskmap_blob+2*i; - for(int i=0; i<2 ; i++) for (int j=0; j<2; j++) cdomain.maskmap[i][j] = true; + // bool *maskmap_blob = (bool *)calloc(4,sizeof(bool)); + // cdomain.maskmap = (bool **)calloc(2,sizeof(bool *)); + // for(int i=0; i<2; i++) cdomain.maskmap[i] = maskmap_blob+2*i; + // for(int i=0; i<2 ; i++) for (int j=0; j<2; j++) cdomain.maskmap[i][j] = true; + cdomain.maskmap = (bool *)calloc(8,sizeof(bool)); + for(int i=0; i<8; i++) cdomain.maskmap[i] = true; int xextent[2] = {0,0}; int yextent[2] = {0,0}; @@ -124,7 +126,7 @@ int main() { cFMS_define_domains_easy(cdomain); - free(maskmap_blob); + free(cdomain.maskmap); free(cdomain.layout); cFMS_null_cdomain(&cdomain); } From 7a620c68e0a79d7db07858c2a11a5d050c559dfb Mon Sep 17 00:00:00 2001 From: Frank Malatino Date: Thu, 27 Mar 2025 10:17:09 -0400 Subject: [PATCH 2/7] Removing comments --- test_cfms/c_fms/test_define_domains.c | 4 ---- 1 file changed, 4 deletions(-) diff --git a/test_cfms/c_fms/test_define_domains.c b/test_cfms/c_fms/test_define_domains.c index 0d2b7a1..e62ae92 100644 --- a/test_cfms/c_fms/test_define_domains.c +++ b/test_cfms/c_fms/test_define_domains.c @@ -94,10 +94,6 @@ int main() { char name[NAME_LENGTH] = "test coarse domain"; - // bool *maskmap_blob = (bool *)calloc(4,sizeof(bool)); - // cdomain.maskmap = (bool **)calloc(2,sizeof(bool *)); - // for(int i=0; i<2; i++) cdomain.maskmap[i] = maskmap_blob+2*i; - // for(int i=0; i<2 ; i++) for (int j=0; j<2; j++) cdomain.maskmap[i][j] = true; cdomain.maskmap = (bool *)calloc(8,sizeof(bool)); for(int i=0; i<8; i++) cdomain.maskmap[i] = true; From 95f878a8633491081de73e41a17cd9b64c2f1953 Mon Sep 17 00:00:00 2001 From: Frank Malatino Date: Sun, 30 Mar 2025 09:32:25 -0400 Subject: [PATCH 3/7] Updated c_update_domains to use c_fms_utils --- Makefile.am | 4 ++-- c_fms/c_fms.F90 | 2 ++ c_fms/include/c_update_domains.inc | 17 +++++++---------- test_cfms/c_fms/test_update_domains.c | 14 +++++++------- 4 files changed, 18 insertions(+), 19 deletions(-) diff --git a/Makefile.am b/Makefile.am index 09c54a3..23080d8 100644 --- a/Makefile.am +++ b/Makefile.am @@ -32,8 +32,8 @@ DOCS = docs endif # Make targets will be run in each subdirectory. Order is significant. -SUBDIRS = c_fms \ - c_fms_utils \ +SUBDIRS = c_fms_utils \ + c_fms \ c_constants \ c_data_override \ c_diag_manager \ diff --git a/c_fms/c_fms.F90 b/c_fms/c_fms.F90 index 3ce2011..9b58699 100644 --- a/c_fms/c_fms.F90 +++ b/c_fms/c_fms.F90 @@ -44,6 +44,8 @@ module c_fms_mod use FMS, only : NORTH, NORTH_EAST, EAST, SOUTH_EAST, CORNER, CENTER use FMS, only : SOUTH, SOUTH_WEST, WEST, NORTH_WEST use FMS, only : CYCLIC_GLOBAL_DOMAIN + + use c_fms_utils_mod, only : cFMS_pointer_to_array, cFMS_array_to_pointer use iso_c_binding diff --git a/c_fms/include/c_update_domains.inc b/c_fms/include/c_update_domains.inc index 4b61c9c..a9d7950 100644 --- a/c_fms/include/c_update_domains.inc +++ b/c_fms/include/c_update_domains.inc @@ -3,7 +3,7 @@ subroutine CFMS_UPDATE_DOMAINS_SUB_NAME_(field_shape, field, domain_id, flags, c implicit none integer, intent(in) :: field_shape(CFMS_UPDATE_DOMAINS_FIELD_NDIM_) - type(c_ptr), intent(inout) :: field + type(c_ptr), intent(in), value :: field integer, intent(in), optional :: domain_id integer, intent(in), optional :: flags logical, intent(in), optional :: complete @@ -12,25 +12,22 @@ subroutine CFMS_UPDATE_DOMAINS_SUB_NAME_(field_shape, field, domain_id, flags, c character(c_char), intent(in), optional :: name_c(NAME_LENGTH) integer, intent(inout), optional :: tile_count - CFMS_UPDATE_DOMAINS_FIELD_TYPE_, pointer :: field_cf(CFMS_UPDATE_DOMAINS_FIELD_POINTER_) - CFMS_UPDATE_DOMAINS_FIELD_TYPE_ :: field_f(CFMS_UPDATE_DOMAINS_SHAPE_F_) + CFMS_UPDATE_DOMAINS_FIELD_TYPE_, allocatable :: field_f(CFMS_UPDATE_DOMAINS_FIELD_POINTER_) character(len=NAME_LENGTH) :: name_f if(present(name_c)) name_f = fms_string_utils_c2f_string(name_c) if(present(tile_count)) tile_count = tile_count + 1 - - call c_f_pointer(field, field_cf, (/CFMS_UPDATE_DOMAINS_SHAPE_CF_/)) - if(CFMS_UPDATE_DOMAINS_FIELD_NDIM_>1) & - field_f = reshape(field_cf, shape=(/CFMS_UPDATE_DOMAINS_SHAPE_F_/), order=CFMS_UPDATE_DOMAINS_RESHAPE_ORDER_) + allocate(field_f(CFMS_UPDATE_DOMAINS_SHAPE_F_)) + call cFMS_pointer_to_array(field, field_shape, field_f) call cFMS_set_current_domain(domain_id) call fms_mpp_domains_update_domains(field=field_f, domain=current_domain, flags=flags, complete=complete, & position=position, whalo=whalo, ehalo=ehalo, shalo=shalo, nhalo=nhalo, name=name_f, tile_count=tile_count) - if(CFMS_UPDATE_DOMAINS_FIELD_NDIM_>1) & - field_cf = reshape(field_f, shape=(/CFMS_UPDATE_DOMAINS_SHAPE_CF_/), order=CFMS_UPDATE_DOMAINS_RESHAPE_ORDER_) + call cFMS_array_to_pointer(field_f, field_shape, field) + + deallocate(field_f) - if(present(tile_count)) tile_count = tile_count - 1 end subroutine CFMS_UPDATE_DOMAINS_SUB_NAME_ diff --git a/test_cfms/c_fms/test_update_domains.c b/test_cfms/c_fms/test_update_domains.c index dafdb08..e04baa9 100644 --- a/test_cfms/c_fms/test_update_domains.c +++ b/test_cfms/c_fms/test_update_domains.c @@ -1,4 +1,5 @@ #include +#include #include #include @@ -144,8 +145,9 @@ void test_float2d(int *domain_id) {49, 59, 69, 79, 89, 99, 29, 39}, {42, 52, 62, 72, 82, 92, 22, 23}, {43, 53, 63, 73, 83, 93, 23, 33}} }; + - float **global, **idata, *blob_global, *blob_idata; + float **global, *idata, *blob_global, *blob_idata; int xdatasize=(WHALO+NX+EHALO); int ydatasize=(SHALO+NY+NHALO); @@ -179,16 +181,14 @@ void test_float2d(int *domain_id) //allocate global array blob_global = (float *)calloc(xdatasize*ydatasize, sizeof(float)); global = (float **)calloc(ydatasize, sizeof(float *)); - for(int i=0; i Date: Sun, 30 Mar 2025 09:48:59 -0400 Subject: [PATCH 4/7] Fixing macro name for c_update_domains 4d int --- c_fms/include/c_update_domains.fh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/c_fms/include/c_update_domains.fh b/c_fms/include/c_update_domains.fh index ef2a95d..12aff37 100644 --- a/c_fms/include/c_update_domains.fh +++ b/c_fms/include/c_update_domains.fh @@ -45,8 +45,8 @@ #undef CFMS_UPDATE_DOMAINS_SHAPE_CF_ #undef CFMS_UPDATE_DOMAINS_SHAPE_F_ #undef CFMS_UPDATE_DOMAINS_RESHAPE_ORDER_ -#define CFMS_UPDATE_DOMAINS_SUB_NAME_ cFMS_update_domains_cfloat_4d -#define CFMS_UPDATE_DOMAINS_BINDC_ "cFMS_update_domains_cfloat_4d" +#define CFMS_UPDATE_DOMAINS_SUB_NAME_ cFMS_update_domains_int_4d +#define CFMS_UPDATE_DOMAINS_BINDC_ "cFMS_update_domains_int_4d" #define CFMS_UPDATE_DOMAINS_FIELD_TYPE_ integer #define CFMS_UPDATE_DOMAINS_FIELD_NDIM_ 4 #define CFMS_UPDATE_DOMAINS_FIELD_POINTER_ :,:,:,: From c44fd953a3d4a249e8c7b99feb5fa4a89f2ff174 Mon Sep 17 00:00:00 2001 From: Frank Malatino Date: Sun, 30 Mar 2025 10:41:57 -0400 Subject: [PATCH 5/7] Removed stdio header inclusion from test_update_domains --- test_cfms/c_fms/test_update_domains.c | 1 - 1 file changed, 1 deletion(-) diff --git a/test_cfms/c_fms/test_update_domains.c b/test_cfms/c_fms/test_update_domains.c index e04baa9..5b285b4 100644 --- a/test_cfms/c_fms/test_update_domains.c +++ b/test_cfms/c_fms/test_update_domains.c @@ -1,5 +1,4 @@ #include -#include #include #include From 8221e9b1b9220e4b8fcede07a6d484969f055889 Mon Sep 17 00:00:00 2001 From: Frank Malatino Date: Sun, 30 Mar 2025 21:09:15 -0400 Subject: [PATCH 6/7] Added back in check for tile_count in update_domains --- c_fms/include/c_update_domains.inc | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/c_fms/include/c_update_domains.inc b/c_fms/include/c_update_domains.inc index a9d7950..8b6e262 100644 --- a/c_fms/include/c_update_domains.inc +++ b/c_fms/include/c_update_domains.inc @@ -29,5 +29,6 @@ subroutine CFMS_UPDATE_DOMAINS_SUB_NAME_(field_shape, field, domain_id, flags, c deallocate(field_f) - + if(present(tile_count)) tile_count = tile_count - 1 + end subroutine CFMS_UPDATE_DOMAINS_SUB_NAME_ From 3640a013b71daa3faa27e30bd0b9307b9bdcdc96 Mon Sep 17 00:00:00 2001 From: Frank Malatino Date: Sun, 30 Mar 2025 21:32:58 -0400 Subject: [PATCH 7/7] Adding access to other dimensions and datatypes for update_domains in c_fms.h, changed test_update_domains to test access to double data type --- c_fms/c_fms.h | 44 +++++++++++++++++++++++++++ test_cfms/c_fms/test_update_domains.c | 12 ++++---- 2 files changed, 50 insertions(+), 6 deletions(-) diff --git a/c_fms/c_fms.h b/c_fms/c_fms.h index 5a86be2..566b7e6 100644 --- a/c_fms/c_fms.h +++ b/c_fms/c_fms.h @@ -105,8 +105,52 @@ extern void cFMS_set_data_domain(int *domain_id, int *xbegin, int *xend, int *yb extern void cFMS_set_global_domain(int *domain_id, int *xbegin, int *xend, int *ybegin, int *yend, int *xsize, int *ysize, int *tile_count); +extern void cFMS_update_domains_double_2d(int *field_shape, double *field, int *domain_id, int *flags, int *complete, + int *position, int *whalo, int *ehalo, int *shalo, int *nhalo, + char *name, int *tile_count); + +extern void cFMS_update_domains_double_3d(int *field_shape, double *field, int *domain_id, int *flags, int *complete, + int *position, int *whalo, int *ehalo, int *shalo, int *nhalo, + char *name, int *tile_count); + +extern void cFMS_update_domains_double_4d(int *field_shape, double *field, int *domain_id, int *flags, int *complete, + int *position, int *whalo, int *ehalo, int *shalo, int *nhalo, + char *name, int *tile_count); + +extern void cFMS_update_domains_double_5d(int *field_shape, double *field, int *domain_id, int *flags, int *complete, + int *position, int *whalo, int *ehalo, int *shalo, int *nhalo, + char *name, int *tile_count); + extern void cFMS_update_domains_float_2d(int *field_shape, float *field, int *domain_id, int *flags, int *complete, int *position, int *whalo, int *ehalo, int *shalo, int *nhalo, char *name, int *tile_count); +extern void cFMS_update_domains_float_3d(int *field_shape, float *field, int *domain_id, int *flags, int *complete, + int *position, int *whalo, int *ehalo, int *shalo, int *nhalo, + char *name, int *tile_count); + +extern void cFMS_update_domains_float_4d(int *field_shape, float *field, int *domain_id, int *flags, int *complete, + int *position, int *whalo, int *ehalo, int *shalo, int *nhalo, + char *name, int *tile_count); + +extern void cFMS_update_domains_float_5d(int *field_shape, float *field, int *domain_id, int *flags, int *complete, + int *position, int *whalo, int *ehalo, int *shalo, int *nhalo, + char *name, int *tile_count); + +extern void cFMS_update_domains_int_2d(int *field_shape, int *field, int *domain_id, int *flags, int *complete, + int *position, int *whalo, int *ehalo, int *shalo, int *nhalo, + char *name, int *tile_count); + +extern void cFMS_update_domains_int_3d(int *field_shape, int *field, int *domain_id, int *flags, int *complete, + int *position, int *whalo, int *ehalo, int *shalo, int *nhalo, + char *name, int *tile_count); + +extern void cFMS_update_domains_int_4d(int *field_shape, int *field, int *domain_id, int *flags, int *complete, + int *position, int *whalo, int *ehalo, int *shalo, int *nhalo, + char *name, int *tile_count); + +extern void cFMS_update_domains_int_5d(int *field_shape, int *field, int *domain_id, int *flags, int *complete, + int *position, int *whalo, int *ehalo, int *shalo, int *nhalo, + char *name, int *tile_count); + #endif diff --git a/test_cfms/c_fms/test_update_domains.c b/test_cfms/c_fms/test_update_domains.c index 5b285b4..49c9bc0 100644 --- a/test_cfms/c_fms/test_update_domains.c +++ b/test_cfms/c_fms/test_update_domains.c @@ -108,7 +108,7 @@ void test_float2d(int *domain_id) // (89)(99)(29)(39)(49)(59)(69)(79) (49)(59)(69)(79)(89)(99)(29)(39) // (88)(98)(28)(38)(48)(58)(68)(78) (48)(58)(68)(78)(88)(98)(28)(38) - float answers_t[4][8][8] = { + double answers_t[4][8][8] = { { {88, 98, 28, 38, 48, 58, 68, 78}, {89, 99, 29, 39, 49, 59, 69, 79}, {82, 92, 22, 32, 42, 52, 62, 72}, @@ -146,7 +146,7 @@ void test_float2d(int *domain_id) {43, 53, 63, 73, 83, 93, 23, 33}} }; - float **global, *idata, *blob_global, *blob_idata; + double **global, *idata, *blob_global, *blob_idata; int xdatasize=(WHALO+NX+EHALO); int ydatasize=(SHALO+NY+NHALO); @@ -178,12 +178,12 @@ void test_float2d(int *domain_id) x_is_global, y_is_global, tile_count, position, &whalo, &shalo); //allocate global array - blob_global = (float *)calloc(xdatasize*ydatasize, sizeof(float)); - global = (float **)calloc(ydatasize, sizeof(float *)); + blob_global = (double *)calloc(xdatasize*ydatasize, sizeof(double)); + global = (double **)calloc(ydatasize, sizeof(double *)); for(int i=0; i