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/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/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_ :,:,:,: diff --git a/c_fms/include/c_update_domains.inc b/c_fms/include/c_update_domains.inc index 4b61c9c..8b6e262 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,23 @@ 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..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}, @@ -144,8 +144,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; + double **global, *idata, *blob_global, *blob_idata; int xdatasize=(WHALO+NX+EHALO); int ydatasize=(SHALO+NY+NHALO); @@ -177,32 +178,30 @@ 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 *)); - for(int i=0; i