diff --git a/c_data_override/Makefile.am b/c_data_override/Makefile.am index 38b02b7..925f44a 100644 --- a/c_data_override/Makefile.am +++ b/c_data_override/Makefile.am @@ -30,7 +30,9 @@ AM_FCFLAGS = $(FC_MODINC). $(FC_MODOUT)$(MODDIR) noinst_LTLIBRARIES = lib_c_data_override.la # Each convenience library depends on its source. -lib_c_data_override_la_SOURCES = c_data_override.F90 +lib_c_data_override_la_SOURCES = c_data_override.F90 \ + include/c_data_override_0d.fh \ + include/c_data_override_0d.inc c_data_override_mod.mod : c_data_override.F90 diff --git a/c_data_override/c_data_override.F90 b/c_data_override/c_data_override.F90 index e9a6c89..9b6b407 100644 --- a/c_data_override/c_data_override.F90 +++ b/c_data_override/c_data_override.F90 @@ -1,18 +1,26 @@ module c_data_override_mod use FMS, only: FmsMppDomain2D, FmsMppDomainUG, FATAL, fms_mpp_error - use FMS, only: fms_data_override_init - - use c_fms_mod, only : cFMS_get_domain_from_id + use FMS, only: fms_data_override_init, fms_data_override + use FMS, only: fms_string_utils_c2f_string, fms_string_utils_f2c_string + use FMS, only: fms_time_manager_set_time, fms_time_manager_set_date, FmsTime_type + + use c_fms_mod, only : cFMS_get_domain_from_id, NAME_LENGTH, MESSAGE_LENGTH use iso_c_binding implicit none private + + public :: cFMS_data_override_0d_cfloat + public :: cFMS_data_override_0d_cdouble public :: cFMS_data_override_init + public :: cFMS_data_override_set_time integer, public, bind(C, name="CFLOAT_MODE") :: CFLOAT_MODE = c_float integer, public, bind(C, name="CDOUBLE_MODE") :: CDOUBLE_MODE = c_double + + type(FmsTime_type) :: data_override_time contains @@ -56,4 +64,35 @@ subroutine cFMS_data_override_init(atm_domain_id, ocn_domain_id, ice_domain_id, end subroutine cFMS_data_override_init + + subroutine cFMS_data_override_set_time(year, month, day, hour, minute, second, tick, err_msg)& + bind(C, name="cFMS_data_override_set_time") + + implicit none + integer, intent(in), optional :: year + integer, intent(in), optional :: month + integer, intent(in), optional :: day + integer, intent(in), optional :: hour + integer, intent(in), optional :: minute + integer, intent(in), optional :: second + integer, intent(in), optional :: tick + character, intent(out), optional :: err_msg(MESSAGE_LENGTH) + + character(MESSAGE_LENGTH-1) :: err_msg_f = "" + + data_override_time = fms_time_manager_set_date(year = year, & + month = month, & + day = day, & + hour = hour, & + minute = minute, & + second = second, & + tick = tick, & + err_msg = err_msg_f) + + if(present(err_msg) .and. err_msg_f /= '') call fms_string_utils_f2c_string(err_msg, err_msg_f) + + end subroutine cFMS_data_override_set_time + +#include "c_data_override_0d.fh" + end module c_data_override_mod diff --git a/c_data_override/c_data_override.h b/c_data_override/c_data_override.h index cf3ad1d..a779d67 100644 --- a/c_data_override/c_data_override.h +++ b/c_data_override/c_data_override.h @@ -1,10 +1,21 @@ #ifndef C_DATA_OVERRIDE_H #define C_DATA_OVERRIDE_H +#include + extern const int CFLOAT_MODE; extern const int CDOUBLE_MODE; +extern void cFMS_data_override_0d_cfloat(char *gridname, char *fieldname_code, float *data_out, bool *override, + int *data_index); + +extern void cFMS_data_override_0d_cdouble(char *gridname, char *fieldname_code, float *data_out, bool *override, + int *data_index); + extern void cFMS_data_override_init(int *atm_domain_id, int *ocn_domain_id, int *ice_domain_id, int *land_domain_id, int *land_domainUG_id, int *mode); +extern void cFMS_data_override_set_time(int *year, int *month, int *day, int *hour, int *minute, int *second, + int *tick, char *err_msg); + #endif diff --git a/c_data_override/include/c_data_override_0d.fh b/c_data_override/include/c_data_override_0d.fh new file mode 100644 index 0000000..f5ee7c7 --- /dev/null +++ b/c_data_override/include/c_data_override_0d.fh @@ -0,0 +1,15 @@ +#undef CFMS_DATA_OVERRIDE_0D_ +#undef CFMS_DATA_OVERRIDE_0D_BINDC_ +#undef CFMS_DATA_OVERRIDE_0D_TYPE_ +#define CFMS_DATA_OVERRIDE_0D_ cFMS_data_override_0d_cfloat +#define CFMS_DATA_OVERRIDE_0D_BINDC_ "cFMS_data_override_0d_cfloat" +#define CFMS_DATA_OVERRIDE_0D_TYPE_ real(c_float) +#include "c_data_override_0d.inc" + +#undef CFMS_DATA_OVERRIDE_0D_ +#undef CFMS_DATA_OVERRIDE_0D_BINDC_ +#undef CFMS_DATA_OVERRIDE_0D_TYPE_ +#define CFMS_DATA_OVERRIDE_0D_ cFMS_data_override_0d_cdouble +#define CFMS_DATA_OVERRIDE_0D_BINDC_ "cFMS_data_override_0d_cdouble" +#define CFMS_DATA_OVERRIDE_0D_TYPE_ real(c_double) +#include "c_data_override_0d.inc" diff --git a/c_data_override/include/c_data_override_0d.inc b/c_data_override/include/c_data_override_0d.inc new file mode 100644 index 0000000..d02e0ed --- /dev/null +++ b/c_data_override/include/c_data_override_0d.inc @@ -0,0 +1,32 @@ + subroutine CFMS_DATA_OVERRIDE_0D_(gridname, fieldname_code, data_out, override, data_index) & + bind(C, name=CFMS_DATA_OVERRIDE_0D_BINDC_) + + use FMS, only : fms_time_manager_get_date + + implicit none + character(c_char), intent(in) :: gridname(NAME_LENGTH) + character(c_char), intent(in) :: fieldname_code(NAME_LENGTH) + CFMS_DATA_OVERRIDE_0D_TYPE_, intent(out) :: data_out + logical(c_bool), intent(out), optional :: override + integer, intent(in), optional :: data_index + + character(len=NAME_LENGTH-1) :: gridname_f + character(len=NAME_LENGTH-1) :: fieldname_code_f + + CFMS_DATA_OVERRIDE_0D_TYPE_ :: data_out_f + logical :: override_f + + gridname_f = fms_string_utils_c2f_string(gridname) + fieldname_code_f = fms_string_utils_c2f_string(fieldname_code) + + call fms_data_override(gridname = gridname_f, & + fieldname_code = fieldname_code_f, & + data_out = data_out, & + time = data_override_time, & + override = override_f, & + data_index = data_index) + + if(present(override)) override = logical(override_f, c_bool) + + end subroutine CFMS_DATA_OVERRIDE_0D_ + diff --git a/c_diag_manager/c_diag_manager.F90 b/c_diag_manager/c_diag_manager.F90 index 3e8371e..bb4a93c 100644 --- a/c_diag_manager/c_diag_manager.F90 +++ b/c_diag_manager/c_diag_manager.F90 @@ -9,10 +9,9 @@ module c_diag_manager_mod use FMS, only : fms_string_utils_c2f_string, fms_string_utils_f2c_string - use FMS, only : THIRTY_DAY_MONTHS, GREGORIAN, JULIAN, NOLEAP, FmsTime_type, Operator(+) - use FMS, only : fms_time_manager_init, fms_time_manager_set_date - use FMS, only : fms_time_manager_set_calendar_type, fms_time_manager_set_time - + use FMS, only : FmsTime_type, Operator(+) + use FMS, only : fms_time_manager_set_date, fms_time_manager_set_time + use FMS, only : fms_time_manager_get_date use FMS, only : FmsMppDomain2D @@ -22,7 +21,7 @@ module c_diag_manager_mod use c_fms_utils_mod, only : cFMS_pointer_to_array use iso_c_binding - + implicit none private @@ -63,11 +62,6 @@ module c_diag_manager_mod integer, public, bind(C, name="DIAG_OCEAN") :: DIAG_OCEAN_C = DIAG_OCEAN integer, public, bind(C, name="DIAG_ALL") :: DIAG_ALL_C = DIAG_ALL - integer, public, bind(C, name="THIRTY_DAY_MONTHS") :: THIRTY_DAY_MONTHS_C = THIRTY_DAY_MONTHS - integer, public, bind(C, name="GREGORIAN") :: GREGORIAN_C = GREGORIAN - integer, public, bind(C, name="JULIAN") :: JULIAN_C = JULIAN - integer, public, bind(C, name="NOLEAP") :: NOLEAP_C = NOLEAP - contains subroutine cFMS_diag_end() bind(C, name="cFMS_diag_end") @@ -78,23 +72,15 @@ subroutine cFMS_diag_end() bind(C, name="cFMS_diag_end") end subroutine cFMS_diag_end !cFMS_diag_init - subroutine cFMS_diag_init(diag_model_subset, time_init, err_msg, calendar_type) bind(C, name='cFMS_diag_init') + subroutine cFMS_diag_init(diag_model_subset, time_init, err_msg) bind(C, name='cFMS_diag_init') implicit none integer, intent(in), optional :: diag_model_subset integer, intent(in), optional :: time_init(6) - integer, intent(in), optional :: calendar_type character(c_char), intent(out), optional :: err_msg(MESSAGE_LENGTH) - integer :: nfields - + integer :: nfields character(len=MESSAGE_LENGTH-1) :: err_msg_f = "None" - integer :: calendar_type_f = NOLEAP - - if(present(calendar_type)) calendar_type_f = NOLEAP - - call fms_time_manager_init() - call fms_time_manager_set_calendar_type(calendar_type_f) call fms_diag_init(diag_model_subset = diag_model_subset, & time_init = time_init, & diff --git a/c_diag_manager/c_diag_manager.h b/c_diag_manager/c_diag_manager.h index 0aa6dcf..652a26b 100644 --- a/c_diag_manager/c_diag_manager.h +++ b/c_diag_manager/c_diag_manager.h @@ -7,12 +7,7 @@ extern const int DIAG_OTHER; extern const int DIAG_OCEAN; extern const int DIAG_ALL; -extern const int THIRTY_DAY_MONTHS; -extern const int GREGORIAN; -extern const int JULIAN; -extern const int NOLEAP; - -extern void cFMS_diag_init(int *diag_model_subset, int *time_init, int *calendar_type, char *err_msg); +extern void cFMS_diag_init(int *diag_model_subset, int *time_init, char *err_msg); extern int cFMS_diag_axis_init_cfloat(char *name, int *naxis_data, float *axis_data, char *units, char *cart_name, char *long_name, int *direction, char *set_name, int *edges, char *aux, diff --git a/c_fms/c_fms.F90 b/c_fms/c_fms.F90 index 15581cc..ef37a03 100644 --- a/c_fms/c_fms.F90 +++ b/c_fms/c_fms.F90 @@ -33,6 +33,10 @@ module c_fms_mod use FMS, only : fms_mpp_domains_set_compute_domain, fms_mpp_domains_set_data_domain, fms_mpp_domains_set_global_domain use FMS, only : fms_mpp_domains_update_domains + use FMS, only : THIRTY_DAY_MONTHS, GREGORIAN, JULIAN, NOLEAP + use FMS, only : fms_time_manager_init, fms_time_manager_set_calendar_type + + use FMS, only : GLOBAL_DATA_DOMAIN, BGRID_NE, CGRID_NE, DGRID_NE, AGRID use FMS, only : FOLD_SOUTH_EDGE, FOLD_NORTH_EDGE, FOLD_WEST_EDGE, FOLD_EAST_EDGE @@ -64,8 +68,8 @@ module c_fms_mod public :: cFMS_set_data_domain public :: cFMS_set_global_domain - integer, parameter :: NAME_LENGTH = 64 !< value taken from mpp_domains - integer, parameter :: MESSAGE_LENGTH=128 + integer, public, parameter :: NAME_LENGTH = 64 !< value taken from mpp_domains + integer, public, parameter :: MESSAGE_LENGTH=128 character(NAME_LENGTH), parameter :: input_nml_path="./input.nml" integer, public, bind(C, name="cFMS_pelist_npes") :: npes @@ -97,6 +101,11 @@ module c_fms_mod integer, public, bind(C, name="WEST") :: WEST_C = WEST integer, public, bind(C, name="NORTH_WEST") :: NORTH_WEST_C = NORTH_WEST + integer, public, bind(C, name="THIRTY_DAY_MONTHS") :: THIRTY_DAY_MONTHS_C = THIRTY_DAY_MONTHS + integer, public, bind(C, name="GREGORIAN") :: GREGORIAN_C = GREGORIAN + integer, public, bind(C, name="JULIAN") :: JULIAN_C = JULIAN + integer, public, bind(C, name="NOLEAP") :: NOLEAP_C = NOLEAP + type(FmsMppDomain2D), allocatable, target, public :: domain(:) type(FmsMppDomain2D), pointer :: current_domain @@ -112,12 +121,13 @@ subroutine cFMS_end() bind(C, name="cFMS_end") end subroutine cFMS_end !> cfms_init - subroutine cFMS_init(localcomm, alt_input_nml_path, ndomain, nnest_domain) bind(C, name="cFMS_init") + subroutine cFMS_init(localcomm, alt_input_nml_path, ndomain, nnest_domain, calendar_type) bind(C, name="cFMS_init") implicit none integer, intent(in), optional :: localcomm integer, intent(in), optional :: ndomain integer, intent(in), optional :: nnest_domain + integer, intent(in), optional :: calendar_type character(c_char), intent(in), optional :: alt_input_nml_path(NAME_LENGTH) character(100) :: alt_input_nml_path_f = input_nml_path @@ -127,6 +137,13 @@ subroutine cFMS_init(localcomm, alt_input_nml_path, ndomain, nnest_domain) bind( call fms_init(localcomm=localcomm, alt_input_nml_path=alt_input_nml_path_f) call fms_mpp_domains_init() + + call fms_time_manager_init() + if(present(calendar_type)) then + call fms_time_manager_set_calendar_type(calendar_type) + else + call fms_time_manager_set_calendar_type(NOLEAP) + end if if(present(ndomain)) then allocate(domain(0:ndomain-1)) diff --git a/c_fms/c_fms.h b/c_fms/c_fms.h index cdeadeb..731d352 100644 --- a/c_fms/c_fms.h +++ b/c_fms/c_fms.h @@ -36,7 +36,12 @@ extern int WEST; extern int NORTH_WEST; extern int CYCLIC_GLOBAL_DOMAIN; -extern void cFMS_init(int *localcomm, char *alt_input_nml_path, int *ndomain, int *nnest_domain); +extern const int THIRTY_DAY_MONTHS; +extern const int GREGORIAN; +extern const int JULIAN; +extern const int NOLEAP; + +extern void cFMS_init(int *localcomm, char *alt_input_nml_path, int *ndomain, int *nnest_domain, int *calendar_type); extern void cFMS_end(); diff --git a/test_cfms/c_data_override/Makefile.am b/test_cfms/c_data_override/Makefile.am index cd60ccb..00b0b65 100644 --- a/test_cfms/c_data_override/Makefile.am +++ b/test_cfms/c_data_override/Makefile.am @@ -31,6 +31,9 @@ TESTS = test_data_override.sh test_data_override_SOURCES = ../c_fms/c_mpp_domains_helper.c test_data_override.c +test_data_override_ongrid : test_data_override_ongrid.F90 + $(FC) $(FCFLAGS) $(LDFLAGS) -I./include test_data_override_ongrid.F90 -o test_data_override_ongrid + TEST_EXTENSIONS = .sh SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \ $(abs_top_srcdir)/test_cfms/tap-driver.sh @@ -39,5 +42,4 @@ SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \ EXTRA_DIST = test_data_override.sh # Clean up -CLEANFILES = input.nml *.out *.dpi *.spi *.dyn *.spl *_table* input* *trs *.nc* - +CLEANFILES = *.nml* *.out *.dpi *.spi *.dyn *.spl *_table* input* *trs *.nc* diff --git a/test_cfms/c_data_override/include/test_data_override_ongrid.inc b/test_cfms/c_data_override/include/test_data_override_ongrid.inc new file mode 100644 index 0000000..875c3fe --- /dev/null +++ b/test_cfms/c_data_override/include/test_data_override_ongrid.inc @@ -0,0 +1,224 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* FMS is free software: you can redistribute it and/or modify it under +!* the terms of the GNU Lesser General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or (at +!* your option) any later version. +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +!* for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS. If not, see . +!*********************************************************************** + +subroutine COMPARE_DATA_ (Domain_in, actual_result, expected_result) + integer, parameter :: lkind = DO_TEST_KIND_ !< Real precision of the test + type(domain2d), intent(in) :: Domain_in !< Domain with mask table + real(lkind), intent(in) :: expected_result !< Expected result from data_override + real(lkind), dimension(:,:), intent(in) :: actual_result !< Result from data_override + integer :: xsizec, ysizec !< Size of the compute domain + integer :: xsized, ysized !< Size of the data domain + integer :: nx, ny !< Size of acual_result + integer :: nhx, nhy !< Size of the halos + integer :: i, j !< Helper indices + + !< Data is only expected to be overriden for the compute domain -not at the halos. + call mpp_get_compute_domain(Domain_in, xsize=xsizec, ysize=ysizec) + call mpp_get_data_domain(Domain_in, xsize=xsized, ysize=ysized) + + !< Note that actual_result has indices at (1:nx,1:ny) not (is:ie,js:je) + nhx= (xsized-xsizec)/2 + nhy = (ysized-ysizec)/2 + nx = size(actual_result, 1) + ny = size(actual_result, 2) + + do i = 1, nx + do j = 1, ny + if (i <= nhx .or. i > (nx-nhx) .or. j <= nhy .or. j > (ny-nhy)) then + !< This is the result at the halos it should 999. + if (actual_result(i,j) .ne. 999._lkind) then + print *, "for i=", i, " and j=", j, " result=", actual_result(i,j) + call mpp_error(FATAL, "test_data_override_ongrid: Data was overriden in the halos!!") + endif + else + if (actual_result(i,j) .ne. expected_result) then + print *, "for i=", i, " and j=", j, " result=", actual_result(i,j), " expected=", expected_result + call mpp_error(FATAL, "test_data_override_ongrid: Result is different from expected answer!") + endif + endif + enddo + enddo +end subroutine COMPARE_DATA_ + +!> @brief Tests ongrid data overrides. +!! In the first case there is no time interpolation +!! In the second case there is time interpolation +subroutine ONGRID_TEST_ + integer, parameter :: lkind = DO_TEST_KIND_ !< Real precision of the test + real(lkind) :: expected_result !< Expected result from data_override + type(time_type) :: Time !< Time + real(lkind), allocatable, dimension(:,:) :: runoff !< Data to be written + + allocate(runoff(is:ie,js:je)) + + runoff = 999._lkind + !< Run it when time=3 + Time = set_date(1,1,4,0,0,0) + call data_override('OCN','runoff',runoff, Time) + !< Because you are getting the data when time=3, and this is an "ongrid" case, the expected result is just + !! equal to the data at time=3, which is 3. + expected_result = 3._lkind + call COMPARE_DATA_ (Domain, runoff, expected_result) + + !< Run it when time=4 + runoff = 999._lkind + Time = set_date(1,1,5,0,0,0) + call data_override('OCN','runoff',runoff, Time) + !< You are getting the data when time=4, the data at time=3 is 3. and at time=5 is 4., so the expected result + !! is the average of the 2 (because this is is an "ongrid" case and there is no horizontal interpolation). + expected_result = (3._lkind + 4._lkind) / 2._lkind + call COMPARE_DATA_ (Domain, runoff, expected_result) + + deallocate(runoff) +end subroutine ONGRID_TEST_ + +!> @brief Tests bilinear data_override with and increasing and decreasing grid case +!! and comares the output betweeen the cases to ensure it is correct +subroutine BILINEAR_TEST_ + integer, parameter :: lkind = DO_TEST_KIND_ !< Real precision of the test + type(time_type) :: Time !< Time + real(lkind), allocatable, dimension(:,:) :: runoff_decreasing !< Data to be written + real(lkind), allocatable, dimension(:,:) :: runoff_increasing !< Data to be written + + integer :: i, j, k + logical :: success + + allocate(runoff_decreasing(is:ie,js:je)) + allocate(runoff_increasing(is:ie,js:je)) + + runoff_decreasing = 999_lkind + runoff_increasing = 999_lkind + Time = set_date(1,1,4,0,0,0) + call data_override('OCN','runoff_increasing',runoff_increasing, Time, override=success) + if (.not. success) call mpp_error(FATAL, "Data override failed") + call data_override('OCN','runoff_decreasing',runoff_decreasing, Time, override=success) + if (.not. success) call mpp_error(FATAL, "Data override failed") + + do i = is, ie + do j = js, je + if (abs(runoff_decreasing(i,j) - runoff_increasing(i,j)) .gt. 1) then + call mpp_error(FATAL, "The data is not the same: "// & + string(i)//","//string(j)//":"// & + string(runoff_decreasing(i,j))//" vs "//string(runoff_increasing(i,j))) + endif + enddo + enddo + deallocate(runoff_decreasing, runoff_increasing) +end subroutine BILINEAR_TEST_ + +subroutine WEIGHT_FILE_TEST_ + integer, parameter :: lkind = DO_TEST_KIND_ !< Real precision of the test + type(time_type) :: Time !< Time + real(lkind), allocatable, dimension(:,:) :: runoff !< Data from normal override + real(lkind), allocatable, dimension(:,:) :: runoff_weight !< Data from weight file override + real(lkind) :: threshold !< Threshold for the difference in answers + + integer :: i, j, k + logical :: success + + allocate(runoff(is:ie,js:je)) + allocate(runoff_weight(is:ie,js:je)) + + runoff = 999_lkind + runoff_weight = 999_lkind + Time = set_date(1,1,4,0,0,0) + call data_override('OCN','runoff_obs',runoff, Time, override=success) + if (.not. success) call mpp_error(FATAL, "Data override failed") + call data_override('OCN','runoff_obs_weights',runoff_weight, Time, override=success) + if (.not. success) call mpp_error(FATAL, "Data override failed") + + threshold = 1e-09 + if (lkind .eq. 4) then + threshold = 1e-03 + endif + + do i = is, ie + do j = js, je + if (abs(runoff(i,j) - runoff_weight(i,j)) .gt. threshold) then + call mpp_error(FATAL, "The data is not the same: "// & + string(i)//","//string(j)//":"// & + string(runoff(i,j))//" vs "//string(runoff_weight(i,j))) + endif + enddo + enddo + deallocate(runoff, runoff_weight) +end subroutine WEIGHT_FILE_TEST_ + +subroutine SCALAR_TEST_ + integer, parameter :: lkind = DO_TEST_KIND_ !< Real precision of the test + real(lkind) :: expected_result !< Expected result from data_override + type(time_type) :: Time !< Time + real(lkind) :: co2 !< Data to be written + + co2 = 999._lkind + !< Run it when time=3 + Time = set_date(1,1,4,0,0,0) + call data_override('OCN','co2',co2, Time) + !< Because you are getting the data when time=3, and this is an "ongrid" case, the expected result is just + !! equal to the data at time=3, which is 3. + expected_result = 3._lkind + if (co2 .ne. expected_result) call mpp_error(FATAL, "co2 was not overriden to the correct value!") + + !< Run it when time=4 + co2 = 999._lkind + Time = set_date(1,1,5,0,0,0) + call data_override('OCN','co2',co2, Time) + !< You are getting the data when time=4, the data at time=3 is 3. and at time=5 is 4., so the expected result + !! is the average of the 2 (because this is is an "ongrid" case and there is no horizontal interpolation). + expected_result = (3._lkind + 4._lkind) / 2._lkind + if (co2 .ne. expected_result) call mpp_error(FATAL, "co2 was not overriden to the correct value!") +end subroutine SCALAR_TEST_ + +subroutine ENSEMBLE_TEST_ + integer, parameter :: lkind = DO_TEST_KIND_ !< Real precision of the test + real(lkind) :: expected_result !< Expected result from data_override + type(time_type) :: Time !< Time + real(lkind), allocatable, dimension(:,:) :: runoff !< Data to be written + integer :: scale_fac !< Scale factor to use when determining + !! the expected answer + logical :: sucessful !< .True. if the data_override was sucessful + + allocate(runoff(is:ie,js:je)) + + scale_fac = ensemble_id + if (test_case .eq. ensemble_same_yaml) scale_fac = 1 + + runoff = 999._lkind + !< Run it when time=3 + Time = set_date(1,1,4,0,0,0) + call data_override('OCN','runoff',runoff, Time, override=sucessful) + if (.not. sucessful) call mpp_error(FATAL, "The data was not overriden correctly") + !< Because you are getting the data when time=3, and this is an "ongrid" case, the expected result is just + !! equal to the data at time=3, which is 3+scale_fac. + expected_result = 3._lkind + real(scale_fac,kind=lkind) + call COMPARE_DATA_ (Domain, runoff, expected_result) + + !< Run it when time=4 + runoff = 999._lkind + Time = set_date(1,1,5,0,0,0) + call data_override('OCN','runoff',runoff, Time, override=sucessful) + if (.not. sucessful) call mpp_error(FATAL, "The data was not overriden correctly") + !< You are getting the data when time=4, the data at time=3 is 3+scale_fac. and at time=5 is 4+scale_fac., + !! so the expected result is the average of the 2 (because this is is an "ongrid" case and there + !! is no horizontal interpolation). + expected_result = (3._lkind + real(scale_fac,kind=lkind) + 4._lkind + real(scale_fac,kind=lkind)) / 2._lkind + call COMPARE_DATA_ (Domain, runoff, expected_result) + + deallocate(runoff) +end subroutine ENSEMBLE_TEST_ diff --git a/test_cfms/c_data_override/include/test_data_override_ongrid_r4.fh b/test_cfms/c_data_override/include/test_data_override_ongrid_r4.fh new file mode 100644 index 0000000..99613c6 --- /dev/null +++ b/test_cfms/c_data_override/include/test_data_override_ongrid_r4.fh @@ -0,0 +1,36 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* FMS is free software: you can redistribute it and/or modify it under +!* the terms of the GNU Lesser General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or (at +!* your option) any later version. +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +!* for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS. If not, see . +!*********************************************************************** + +#undef DO_TEST_KIND_ +#undef COMPARE_DATA_ +#undef ONGRID_TEST_ +#undef BILINEAR_TEST_ +#undef WEIGHT_FILE_TEST_ +#undef SCALAR_TEST_ +#undef ENSEMBLE_TEST_ + +#define DO_TEST_KIND_ r4_kind +#define COMPARE_DATA_ compare_data_r4 +#define ONGRID_TEST_ ongrid_test_r4 +#define BILINEAR_TEST_ bilinear_test_r4 +#define WEIGHT_FILE_TEST_ weight_file_test_r4 +#define SCALAR_TEST_ scalar_test_r4 +#define ENSEMBLE_TEST_ ensemble_test_r4 + +#include "test_data_override_ongrid.inc" diff --git a/test_cfms/c_data_override/include/test_data_override_ongrid_r8.fh b/test_cfms/c_data_override/include/test_data_override_ongrid_r8.fh new file mode 100644 index 0000000..1b07b48 --- /dev/null +++ b/test_cfms/c_data_override/include/test_data_override_ongrid_r8.fh @@ -0,0 +1,36 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* FMS is free software: you can redistribute it and/or modify it under +!* the terms of the GNU Lesser General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or (at +!* your option) any later version. +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +!* for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS. If not, see . +!*********************************************************************** + +#undef DO_TEST_KIND_ +#undef COMPARE_DATA_ +#undef ONGRID_TEST_ +#undef BILINEAR_TEST_ +#undef WEIGHT_FILE_TEST_ +#undef SCALAR_TEST_ +#undef ENSEMBLE_TEST_ + +#define DO_TEST_KIND_ r8_kind +#define COMPARE_DATA_ compare_data_r8 +#define ONGRID_TEST_ ongrid_test_r8 +#define BILINEAR_TEST_ bilinear_test_r8 +#define WEIGHT_FILE_TEST_ weight_file_test_r8 +#define SCALAR_TEST_ scalar_test_r8 +#define ENSEMBLE_TEST_ ensemble_test_r8 + +#include "test_data_override_ongrid.inc" diff --git a/test_cfms/c_data_override/test_data_override.c b/test_cfms/c_data_override/test_data_override.c index 3d2416d..001a2c4 100644 --- a/test_cfms/c_data_override/test_data_override.c +++ b/test_cfms/c_data_override/test_data_override.c @@ -4,8 +4,10 @@ #include #include -#define NX 384 -#define NY 384 +#define NX 360 +#define NY 180 + +#define TEST_NTIMES 11 int main() { @@ -13,8 +15,10 @@ int main() int ndomain = 1; int nnest_domain = 0; int domain_id = 0; - - cFMS_init(NULL, NULL, &ndomain, &nnest_domain); + int calendar_type = NOLEAP; + float answers[TEST_NTIMES] = {1., 2., 3., 3.5, 4., 5., 6., 7., 8., 9., 10.}; + + cFMS_init(NULL, NULL, &ndomain, &nnest_domain, &calendar_type); // define domain { @@ -43,13 +47,38 @@ int main() //data override init { - int *ocn_domain_id = NULL; + int *atm_domain_id = NULL; int *ice_domain_id = NULL; int *land_domain_id = NULL; int *land_domainUG_id = NULL; - int mode = CDOUBLE_MODE; //for r8 - cFMS_data_override_init(&domain_id, ocn_domain_id, ice_domain_id, land_domain_id, land_domainUG_id, &mode); + cFMS_data_override_init(atm_domain_id, &domain_id, ice_domain_id, land_domain_id, land_domainUG_id, NULL); } + + //data override scalar + { + char gridname[NAME_LENGTH] = "OCN"; + char fieldname_code[NAME_LENGTH] = "co2"; + float data = -100.; + bool override = false; + int *data_index = NULL; + int start_day = 1; + for(int i=0; i input.nml +&test_data_override_ongrid_nml + test_case=3 + write_only=.True. +/ +&data_override_nml + use_data_table_yaml = .True. +/ +EOF + +cat <<_EOF > data_table.yaml +data_table: + - grid_name: OCN + fieldname_in_model: co2 + override_file: + - fieldname_in_file: co2 + file_name: INPUT/scalar.nc + interp_method: none + factor : 1.0 +_EOF + +./test_data_override_ongrid + +test_expect_success "c_data_override" 'mpirun -n 2 ./test_data_override' test_done +rm -rf INPUT test_data_override_ongrid diff --git a/test_cfms/c_data_override/test_data_override_ongrid.F90 b/test_cfms/c_data_override/test_data_override_ongrid.F90 new file mode 100644 index 0000000..5795dee --- /dev/null +++ b/test_cfms/c_data_override/test_data_override_ongrid.F90 @@ -0,0 +1,516 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* FMS is free software: you can redistribute it and/or modify it under +!* the terms of the GNU Lesser General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or (at +!* your option) any later version. +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +!* for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS. If not, see . +!*********************************************************************** + +program test_data_override_ongrid + +!> @brief This file was copied from test_fms/data_override and is used to generate test input files +!! This file will eventually be replaced +!! from FMS: "This programs tests data_override ability to override data for an +!! on grid case and when using bilinear interpolation" + +use platform_mod, only: r4_kind, r8_kind +use mpp_domains_mod, only: mpp_define_domains, mpp_define_io_domain, mpp_get_data_domain, & + mpp_domains_set_stack_size, mpp_get_compute_domain, domain2d +use mpp_mod, only: mpp_init, mpp_exit, mpp_pe, mpp_root_pe, mpp_error, FATAL, & + input_nml_file, mpp_sync, NOTE, mpp_npes, mpp_get_current_pelist, & + mpp_set_current_pelist +use data_override_mod, only: data_override_init, data_override +use fms2_io_mod +use time_manager_mod, only: set_calendar_type, time_type, set_date, NOLEAP +use netcdf, only: nf90_create, nf90_def_dim, nf90_def_var, nf90_enddef, nf90_put_var, & + nf90_close, nf90_put_att, nf90_clobber, nf90_64bit_offset, nf90_char, & + nf90_double, nf90_unlimited +use ensemble_manager_mod, only: get_ensemble_size, ensemble_manager_init +use fms_mod, only: string, fms_init, fms_end + +implicit none + +integer, dimension(2) :: layout = (/2,3/) !< Domain layout +integer :: nlon = 360 !< Number of points in x axis +integer :: nlat = 180 !< Number of points in y axis +type(domain2d) :: Domain !< Domain with mask table +integer :: is !< Starting x index +integer :: ie !< Ending x index +integer :: js !< Starting y index +integer :: je !< Ending y index +integer :: nhalox=2, nhaloy=2 +integer :: io_status +integer, parameter :: ongrid = 1 +integer, parameter :: bilinear = 2 +integer, parameter :: scalar = 3 +integer, parameter :: weight_file = 4 +integer, parameter :: ensemble_case = 5 +integer, parameter :: ensemble_same_yaml = 6 +integer :: test_case = ongrid +logical :: init_with_mode = .false. +integer :: npes +integer, allocatable :: pelist(:) +integer, allocatable :: pelist_ens(:) +integer :: ensemble_id +logical :: write_only=.false. !< True if creating the input files only + +namelist /test_data_override_ongrid_nml/ nhalox, nhaloy, test_case, init_with_mode, nlon, nlat, layout, & + write_only + +call fms_init +call fms2_io_init + +read (input_nml_file, test_data_override_ongrid_nml, iostat=io_status) +if (io_status > 0) call mpp_error(FATAL,'=>test_data_override_ongrid: Error reading input.nml') + +!< Wait for the root PE to catch up +call mpp_sync + +if (write_only) then + select case (test_case) + case (ongrid) + call generate_ongrid_input_file () + case (bilinear) + call generate_bilinear_input_file () + case (scalar) + call generate_scalar_input_file () + case (weight_file) + call generate_weight_input_file () + case (ensemble_case, ensemble_same_yaml) + call generate_ensemble_input_file() + end select + + call mpp_sync() + call mpp_error(NOTE, "Finished creating INPUT Files") +endif + +call fms_end + +contains + +subroutine create_grid_spec_file + type(FmsNetcdfFile_t) :: fileobj + + if (open_file(fileobj, 'INPUT/grid_spec.nc', 'overwrite')) then + call register_axis(fileobj, 'str', 255) + call register_field(fileobj, 'ocn_mosaic_file', 'char', (/'str'/)) + call write_data(fileobj, 'ocn_mosaic_file', "ocean_mosaic.nc") + call close_file(fileobj) + else + call mpp_error(FATAL, "Error opening the file: 'INPUT/grid_spec.nc' to write") + endif +end subroutine create_grid_spec_file + +subroutine create_ocean_mosaic_file + type(FmsNetcdfFile_t) :: fileobj + character(len=10) :: dimnames(2) + + dimnames(1) = 'str' + dimnames(2) = 'ntiles' + if (open_file(fileobj, 'INPUT/ocean_mosaic.nc', 'overwrite')) then + call register_axis(fileobj, dimnames(1) , 255) + call register_axis(fileobj, dimnames(2), 1) + call register_field(fileobj, 'gridfiles', 'char', dimnames) + call write_data(fileobj, 'gridfiles', (/"ocean_hgrid.nc"/)) + call close_file(fileobj) + else + call mpp_error(FATAL, "Error opening the file: 'INPUT/ocean_mosaic.nc' to write") + endif +end subroutine create_ocean_mosaic_file + +subroutine create_ocean_hgrid_file + type(FmsNetcdfFile_t) :: fileobj + real(r4_kind), allocatable, dimension(:,:) :: xdata, ydata + integer :: nx, nxp, ny, nyp, i, j + + nx = nlon*2 + nxp = nx+1 + ny = nlat*2 + nyp = ny+1 + + allocate(xdata(nxp, nyp)) + xdata(1,:) = 0_r4_kind + do i = 2, nxp + xdata(i,:) = xdata(i-1,:) + 0.5_r4_kind + enddo + + allocate(ydata(nxp, nyp)) + ydata(:,1) = -90.0_r4_kind + do i = 2, nyp + ydata(:,i) = ydata(:, i-1) + 0.5_r4_kind + enddo + + if (open_file(fileobj, 'INPUT/ocean_hgrid.nc', 'overwrite')) then + call register_axis(fileobj, "nx", nx) + call register_axis(fileobj, "ny", ny) + call register_axis(fileobj, "nxp", nxp) + call register_axis(fileobj, "nyp", nyp) + call register_field(fileobj, 'x', 'float', (/'nxp', 'nyp'/)) + call register_field(fileobj, 'y', 'float', (/'nxp', 'nyp'/)) + call register_field(fileobj, 'area', 'float', (/'nx', 'ny'/)) + call write_data(fileobj, "x", xdata) + call write_data(fileobj, "y", ydata) + call close_file(fileobj) + else + call mpp_error(FATAL, "Error opening the file: 'INPUT/ocean_hgrid.nc' to write") + endif +end subroutine create_ocean_hgrid_file + +subroutine create_ongrid_data_file(is_ensemble) + logical, intent(in), optional :: is_ensemble + type(FmsNetcdfFile_t) :: fileobj + character(len=10) :: dimnames(3) + real(r4_kind), allocatable, dimension(:,:,:) :: runoff_in + real(r4_kind), allocatable, dimension(:) :: time_data + integer :: offset + character(len=256), allocatable :: appendix + + integer :: i + + offset = 0 + appendix = "" + + if (present(is_ensemble)) then + offset = ensemble_id + call get_filename_appendix(appendix) + appendix = "_"//trim(appendix) + endif + + allocate(runoff_in(nlon, nlat, 10)) + allocate(time_data(10)) + + do i = 1, 10 + runoff_in(:,:,i) = real(i+offset, r4_kind) + enddo + + time_data = (/1_r4_kind, 2_r4_kind, & + 3_r4_kind, 5_r4_kind, & + 6_r4_kind, 7_r4_kind, & + 8_r4_kind, 9_r4_kind, & + 10_r4_kind, 11_r4_kind/) + + dimnames(1) = 'i' + dimnames(2) = 'j' + dimnames(3) = 'time' + + if (open_file(fileobj, 'INPUT/runoff.daitren.clim.1440x1080.v20180328'//trim(appendix)//'.nc', 'overwrite')) then + call register_axis(fileobj, "i", nlon) + call register_axis(fileobj, "j", nlat) + call register_axis(fileobj, "time", unlimited) + + call register_field(fileobj, "i", "float", (/"i"/)) + call register_variable_attribute(fileobj, "i", "cartesian_axis", "x", str_len=1) + + call register_field(fileobj, "j", "float", (/"j"/)) + call register_variable_attribute(fileobj, "j", "cartesian_axis", "y", str_len=1) + + call register_field(fileobj, "time", "float", (/"time"/)) + call register_variable_attribute(fileobj, "time", "cartesian_axis", "T", str_len=1) + call register_variable_attribute(fileobj, "time", "calendar", "noleap", str_len=6) + call register_variable_attribute(fileobj, "time", "units", "days since 0001-01-01 00:00:00", str_len=30) + + call register_field(fileobj, "runoff", "float", dimnames) + call write_data(fileobj, "runoff", runoff_in) + call write_data(fileobj, "time", time_data) + call close_file(fileobj) + else + call mpp_error(FATAL, "Error opening the file: 'INPUT/runoff.daitren.clim.1440x1080.v20180328.nc' to write") + endif + deallocate(runoff_in) +end subroutine create_ongrid_data_file + +subroutine generate_ongrid_input_file + !< Create some files needed by data_override! + if (mpp_pe() .eq. mpp_root_pe()) then + call create_grid_spec_file() + call create_ocean_mosaic_file() + call create_ocean_hgrid_file() + call create_ongrid_data_file() + endif + call mpp_sync() +end subroutine generate_ongrid_input_file + +!> @brief Creates an input netcdf data file to use for the ongrid data_override test case +!! with either an increasing or decreasing lat, lon grid +subroutine create_bilinear_data_file(increasing_grid) + logical, intent(in) :: increasing_grid !< .true. if increasing a file with an increasing lat/lon + + type(FmsNetcdfFile_t) :: fileobj !< Fms2_io fileobj + character(len=10) :: dimnames(3) !< dimension names for the variable + real(r4_kind), allocatable :: runoff_in(:,:,:) !< Data to write + real(r4_kind), allocatable :: time_data(:) !< Time dimension data + real(r4_kind), allocatable :: lat_data(:) !< Lat dimension data + real(r4_kind), allocatable :: lon_data(:) !< Lon dimension data + character(len=:), allocatable :: filename !< Name of the file + integer :: factor !< This is used when creating the grid data + !! -1 if the grid is decreasing + !! +1 if the grid is increasing + integer :: i, j, k !< For looping through variables + integer :: nlon_data, nlat_data + + nlon_data = nlon + 1 + nlat_data = nlat - 1 + allocate(runoff_in(nlon_data, nlat_data, 10)) + allocate(time_data(10)) + allocate(lat_data(nlat_data)) + allocate(lon_data(nlon_data)) + + if (.not. increasing_grid) then + filename = 'INPUT/bilinear_decreasing.nc' + lon_data(1) = 360.0_r4_kind + lat_data(1) = 89.0_r4_kind + factor = -1 + do i = 1, nlon_data + do j = 1, nlat_data + do k = 1, 10 + runoff_in(i, j, k) = real(362-i, kind=r4_kind) * 1000._r4_kind + & + real(180-j, kind=r4_kind) + real(k, kind=r4_kind)/100._r4_kind + enddo + enddo + enddo + else + filename = 'INPUT/bilinear_increasing.nc' + lon_data(1) = 0.0_r4_kind + lat_data(1) = -89.0_r4_kind + factor = 1 + + do i = 1, nlon_data + do j = 1, nlat_data + do k = 1, 10 + runoff_in(i, j, k) = real(i, kind=r4_kind) * 1000._r4_kind + real(j, kind=r4_kind) + & + real(k, kind=r4_kind)/100._r4_kind + enddo + enddo + enddo + endif + + do i = 2, nlon_data + lon_data(i) = real(lon_data(i-1) + 1*factor, r4_kind) + enddo + + do i = 2, nlat_data + lat_data(i) =real(lat_data(i-1) + 1*factor, r4_kind) + enddo + + time_data = (/1_r4_kind, 2_r4_kind, & + 3_r4_kind, 5_r4_kind, & + 6_r4_kind, 7_r4_kind, & + 8_r4_kind, 9_r4_kind, & + 10_r4_kind, 11_r4_kind/) + + dimnames(1) = 'i' + dimnames(2) = 'j' + dimnames(3) = 'time' + + if (open_file(fileobj, filename, 'overwrite')) then + call register_axis(fileobj, "i", nlon_data) + call register_axis(fileobj, "j", nlat_data) + call register_axis(fileobj, "time", unlimited) + + call register_field(fileobj, "i", "float", (/"i"/)) + call register_variable_attribute(fileobj, "i", "cartesian_axis", "x", str_len=1) + + call register_field(fileobj, "j", "float", (/"j"/)) + call register_variable_attribute(fileobj, "j", "cartesian_axis", "y", str_len=1) + + call register_field(fileobj, "time", "float", (/"time"/)) + call register_variable_attribute(fileobj, "time", "cartesian_axis", "T", str_len=1) + call register_variable_attribute(fileobj, "time", "calendar", "noleap", str_len=6) + call register_variable_attribute(fileobj, "time", "units", "days since 0001-01-01 00:00:00", str_len=30) + + call register_field(fileobj, "runoff", "float", dimnames) + call write_data(fileobj, "runoff", runoff_in) + call write_data(fileobj, "i", lon_data) + call write_data(fileobj, "j", lat_data) + call write_data(fileobj, "time", time_data) + call close_file(fileobj) + else + call mpp_error(FATAL, "Error opening the file: 'INPUT/bilinear_increasing.nc' to write") + endif + deallocate(runoff_in) +end subroutine create_bilinear_data_file + +!> @brief Generates the input for the bilinear data_override test_case +subroutine generate_bilinear_input_file + if (mpp_pe() .eq. mpp_root_pe()) then + call create_grid_spec_file () + call create_ocean_mosaic_file() + call create_ocean_hgrid_file() + call create_bilinear_data_file(.true.) + call create_bilinear_data_file(.false.) + endif + call mpp_sync() +end subroutine generate_bilinear_input_file + +subroutine generate_weight_input_file + call create_grid_spec_file () + call create_ocean_mosaic_file() + call create_ocean_hgrid_file() + call create_bilinear_data_file(.true.) + call create_weight_file() +end subroutine generate_weight_input_file + +subroutine create_weight_file + type(FmsNetcdfFile_t) :: fileobj + real(kind=r8_kind), allocatable :: vdata(:,:,:) + character(len=5) :: dim_names(3) + + dim_names(1) = "nlon" + dim_names(2) = "nlat" + if (open_file(fileobj, "INPUT/remap_file.nc", "overwrite")) then + call register_axis(fileobj, "nlon", nlon) + call register_axis(fileobj, "nlat", nlat) + call register_axis(fileobj, "three", 3) + call register_axis(fileobj, "four", 4) + + dim_names(3) = "three" + call register_field(fileobj, "index", "int", dim_names) + + dim_names(3) = "four" + call register_field(fileobj, "weight", "double", dim_names) + + allocate(vdata(nlon,nlat,3)) + vdata(1,:,1) = 1 + vdata(2,:,1) = 2 + vdata(3,:,1) = 3 + vdata(4,:,1) = 4 + vdata(5,:,1) = 5 + vdata(:,1:2,2) = 1 + vdata(:,3,2) = 2 + vdata(:,4,2) = 3 + vdata(:,5,2) = 4 + vdata(:,6,2) = 5 + vdata(:,:,3) = 1 + call write_data(fileobj, "index", vdata) + deallocate(vdata) + + allocate(vdata(nlon,nlat,4)) + vdata = 0.5_r8_kind + vdata(:,1,3) = 1_r8_kind + vdata(:,6,3) = 1_r8_kind + vdata(:,1,4) = 0_r8_kind + vdata(:,6,4) = 0_r8_kind + + call write_data(fileobj, "weight", vdata) + deallocate(vdata) + + call close_file(fileobj) + endif +end subroutine create_weight_file + +!> @brief Generates the input for the bilinear data_override test_case +subroutine generate_scalar_input_file + if (mpp_pe() .eq. mpp_root_pe()) then + call create_grid_spec_file () + call create_ocean_mosaic_file() + call create_ocean_hgrid_file() + call create_scalar_data_file() + endif + call mpp_sync() +end subroutine generate_scalar_input_file + +subroutine create_scalar_data_file + type(FmsNetcdfFile_t) :: fileobj + character(len=10) :: dimnames(1) + real(r4_kind), allocatable, dimension(:) :: co2_in + real(r4_kind), allocatable, dimension(:) :: time_data + integer :: i + + allocate(co2_in(10)) + allocate(time_data(10)) + + do i = 1, 10 + co2_in(i) = real(i, r4_kind) + enddo + + time_data = (/1_r4_kind, 2_r4_kind, & + 3_r4_kind, 5_r4_kind, & + 6_r4_kind, 7_r4_kind, & + 8_r4_kind, 9_r4_kind, & + 10_r4_kind, 11_r4_kind/) + + dimnames(1) = 'time' + + if (open_file(fileobj, 'INPUT/scalar.nc', 'overwrite')) then + call register_axis(fileobj, "time", unlimited) + call register_field(fileobj, "time", "float", (/"time"/)) + call register_variable_attribute(fileobj, "time", "cartesian_axis", "T", str_len=1) + call register_variable_attribute(fileobj, "time", "calendar", "noleap", str_len=6) + call register_variable_attribute(fileobj, "time", "units", "days since 0001-01-01 00:00:00", str_len=30) + + call register_field(fileobj, "co2", "float", dimnames) + call write_data(fileobj, "co2", co2_in) + call write_data(fileobj, "time", time_data) + call close_file(fileobj) + else + call mpp_error(FATAL, "Error opening the file: 'INPUT/scalar.nc' to write") + endif + deallocate(co2_in) +end subroutine create_scalar_data_file + +subroutine set_up_ensemble_case + integer :: ens_siz(6) + character(len=10) :: text + + if (npes .ne. 12) & + call mpp_error(FATAL, "This test requires 12 pes to run") + + if (layout(1)*layout(2) .ne. 6) & + call mpp_error(FATAL, "The two members of the layout do not equal 6") + + call ensemble_manager_init + ens_siz = get_ensemble_size() + if (ens_siz(1) .ne. 2) & + call mpp_error(FATAL, "This test requires 2 ensembles") + + if (mpp_pe() < 6) then + !PEs 0-5 are the first ensemble + ensemble_id = 1 + allocate(pelist_ens(npes/ens_siz(1))) + pelist_ens = pelist(1:6) + call mpp_set_current_pelist(pelist_ens) + else + !PEs 6-11 are the second ensemble + ensemble_id = 2 + allocate(pelist_ens(npes/ens_siz(1))) + pelist_ens = pelist(7:) + call mpp_set_current_pelist(pelist_ens) + endif + + write( text,'(a,i2.2)' ) 'ens_', ensemble_id + call set_filename_appendix(trim(text)) + + if (mpp_pe() .eq. mpp_root_pe()) & + print *, "ensemble_id:", ensemble_id, ":: ", pelist_ens +end subroutine set_up_ensemble_case + +subroutine generate_ensemble_input_file + if (mpp_pe() .eq. mpp_root_pe()) then + call create_grid_spec_file () + call create_ocean_mosaic_file() + call create_ocean_hgrid_file() + endif + + !< Go back to the ensemble pelist so that each root pe can write its own input file + call mpp_set_current_pelist(pelist_ens) + if (mpp_pe() .eq. mpp_root_pe()) then + call create_ongrid_data_file(is_ensemble=.true.) + endif + call mpp_set_current_pelist(pelist) +end subroutine generate_ensemble_input_file + +#include "test_data_override_ongrid_r4.fh" +#include "test_data_override_ongrid_r8.fh" + +end program test_data_override_ongrid diff --git a/test_cfms/c_diag_manager/test_send_data.c b/test_cfms/c_diag_manager/test_send_data.c index e53a244..c12d063 100644 --- a/test_cfms/c_diag_manager/test_send_data.c +++ b/test_cfms/c_diag_manager/test_send_data.c @@ -26,6 +26,8 @@ int main() int id_var2; int var2_shape[2] = {NX, NY}; float *var2; + + int calendar_type = NOLEAP; var3 = (float *)malloc(NX*NY*NZ*sizeof(float)); int ijk = 0; @@ -45,7 +47,7 @@ int main() } } - cFMS_init(NULL, NULL, NULL, NULL); + cFMS_init(NULL, NULL, NULL, NULL, &calendar_type); // define domain { @@ -65,9 +67,8 @@ int main() { int diag_model_subset = DIAG_ALL; int *time_init = NULL; - int calendar_type = NOLEAP; char err_msg[NAME_LENGTH] = "None"; - cFMS_diag_init(&diag_model_subset, time_init, &calendar_type, err_msg); + cFMS_diag_init(&diag_model_subset, time_init, err_msg); } cFMS_set_current_domain(&domain_id); diff --git a/test_cfms/c_fms/test_define_domains.c b/test_cfms/c_fms/test_define_domains.c index b5b84cf..74b4ea3 100644 --- a/test_cfms/c_fms/test_define_domains.c +++ b/test_cfms/c_fms/test_define_domains.c @@ -68,7 +68,7 @@ int main() { int fine_shalo=2; int fine_nhalo=2; - cFMS_init(NULL, NULL, &ndomain, &nnest_domain); + cFMS_init(NULL, NULL, &ndomain, &nnest_domain, NULL); cFMS_null_cdomain(&cdomain); cFMS_null_cnest_domain(&cnest_domain); diff --git a/test_cfms/c_fms/test_getset_domains.c b/test_cfms/c_fms/test_getset_domains.c index adeb9e7..5237edf 100644 --- a/test_cfms/c_fms/test_getset_domains.c +++ b/test_cfms/c_fms/test_getset_domains.c @@ -26,7 +26,7 @@ int main() int nhalo = 2; char name[NAME_LENGTH] = "test domain"; - cFMS_init(NULL,NULL, NULL, NULL); + cFMS_init(NULL,NULL, NULL, NULL, NULL); cFMS_null_cdomain(&domain); //set domain diff --git a/test_cfms/c_fms/test_update_domains.c b/test_cfms/c_fms/test_update_domains.c index 1ad8e82..dafdb08 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 @@ -31,7 +30,7 @@ int main() { int domain_id = 0; - cFMS_init(NULL,NULL,NULL,NULL); + cFMS_init(NULL,NULL,NULL,NULL,NULL); define_domain(&domain_id); cFMS_set_current_pelist(NULL,NULL);