diff --git a/c_data_override/Makefile.am b/c_data_override/Makefile.am index 68dff90..74e3dbe 100644 --- a/c_data_override/Makefile.am +++ b/c_data_override/Makefile.am @@ -31,10 +31,12 @@ noinst_LTLIBRARIES = lib_c_data_override.la # Each convenience library depends on its source. lib_c_data_override_la_SOURCES = c_data_override.F90 \ - include/c_data_override_0d.fh \ + include/c_data_override_0d.fh \ include/c_data_override_0d.inc \ - include/c_data_override_2d.fh \ - include/c_data_override_2d.inc + include/c_data_override_2d.fh \ + include/c_data_override_2d.inc \ + include/c_data_override_3d.fh \ + include/c_data_override_3d.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 f09432e..2980143 100644 --- a/c_data_override/c_data_override.F90 +++ b/c_data_override/c_data_override.F90 @@ -17,6 +17,8 @@ module c_data_override_mod public :: cFMS_data_override_0d_cdouble public :: cFMS_data_override_2d_cfloat public :: cFMS_data_override_2d_cdouble + public :: cFMS_data_override_3d_cfloat + public :: cFMS_data_override_3d_cdouble public :: cFMS_data_override_init public :: cFMS_data_override_set_time @@ -98,5 +100,6 @@ end subroutine cFMS_data_override_set_time #include "c_data_override_0d.fh" #include "c_data_override_2d.fh" +#include "c_data_override_3d.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 0b21509..0424c5e 100644 --- a/c_data_override/c_data_override.h +++ b/c_data_override/c_data_override.h @@ -18,6 +18,12 @@ extern void cFMS_data_override_2d_cfloat(char *gridname, char *fieldname, int *d extern void cFMS_data_override_2d_cdouble(char *gridname, char *fieldname, int *data_shape, double *data, bool *override, int *is, int *ie, int *js, int *je); +extern void cFMS_data_override_3d_cfloat(char *gridname, char *fieldname, int *data_shape, float *data, + bool *override, int *data_index, int *is, int *ie, int *js, int *je); + +extern void cFMS_data_override_3d_cdouble(char *gridname, char *fieldname, int *data_shape, double *data, + bool *override, int *data_index, int *is, int *ie, int *js, int *je); + 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); diff --git a/c_data_override/include/c_data_override_2d.inc b/c_data_override/include/c_data_override_2d.inc index 1082b13..a0a0fdf 100644 --- a/c_data_override/include/c_data_override_2d.inc +++ b/c_data_override/include/c_data_override_2d.inc @@ -17,7 +17,6 @@ subroutine CFMS_DATA_OVERRIDE_2D_(gridname, fieldname, data_shape, data, overrid logical :: override_f CFMS_DATA_OVERRIDE_2D_TYPE_, allocatable :: data_f(:,:) - integer :: i, j gridname_f = fms_string_utils_c2f_string(gridname) fieldname_f = fms_string_utils_c2f_string(fieldname) diff --git a/c_data_override/include/c_data_override_3d.fh b/c_data_override/include/c_data_override_3d.fh new file mode 100644 index 0000000..be9e56d --- /dev/null +++ b/c_data_override/include/c_data_override_3d.fh @@ -0,0 +1,16 @@ +#undef CFMS_DATA_OVERRIDE_3D_ +#undef CFMS_DATA_OVERRIDE_3D_BINDC_ +#undef CFMS_DATA_OVERRIDE_3D_TYPE_ +#define CFMS_DATA_OVERRIDE_3D_ cFMS_data_override_3d_cfloat +#define CFMS_DATA_OVERRIDE_3D_BINDC_ "cFMS_data_override_3d_cfloat" +#define CFMS_DATA_OVERRIDE_3D_TYPE_ real(c_float) +#include "c_data_override_3d.inc" + +#undef CFMS_DATA_OVERRIDE_3D_ +#undef CFMS_DATA_OVERRIDE_3D_BINDC_ +#undef CFMS_DATA_OVERRIDE_3D_TYPE_ +#define CFMS_DATA_OVERRIDE_3D_ cFMS_data_override_3d_cdouble +#define CFMS_DATA_OVERRIDE_3D_BINDC_ "cFMS_data_override_3d_cdouble" +#define CFMS_DATA_OVERRIDE_3D_TYPE_ real(c_double) +#include "c_data_override_3d.inc" + diff --git a/c_data_override/include/c_data_override_3d.inc b/c_data_override/include/c_data_override_3d.inc new file mode 100644 index 0000000..1e71683 --- /dev/null +++ b/c_data_override/include/c_data_override_3d.inc @@ -0,0 +1,43 @@ +subroutine CFMS_DATA_OVERRIDE_3D_(gridname, fieldname, data_shape, data, override, data_index, is, ie, js, je) & + bind(C, name=CFMS_DATA_OVERRIDE_3D_BINDC_) + + implicit none + character(c_char), intent(in) :: gridname(NAME_LENGTH) + character(c_char), intent(in) :: fieldname(NAME_LENGTH) + integer, intent(in) :: data_shape(3) + type(c_ptr), value,intent(in) :: data + logical(c_bool), intent(out), optional :: override + integer, intent(in), optional :: data_index + integer, intent(in), optional :: is + integer, intent(in), optional :: ie + integer, intent(in), optional :: js + integer, intent(in), optional :: je + + character(len=NAME_LENGTH-1) :: gridname_f + character(len=NAME_LENGTH-1) :: fieldname_f + logical :: override_f + + CFMS_DATA_OVERRIDE_2D_TYPE_, allocatable :: data_f(:,:,:) + + gridname_f = fms_string_utils_c2f_string(gridname) + fieldname_f = fms_string_utils_c2f_string(fieldname) + + allocate(data_f(data_shape(1),data_shape(2),data_shape(3))) + + call fms_data_override(gridname = gridname_f, & + fieldname_code = fieldname_f, & + return_data = data_f, & + time = data_override_time, & + override = override_f, & + data_index = data_index, & + is_in = is, & + js_in = js, & + ie_in = ie, & + je_in = je) + + call cfms_array_to_pointer(data_f, data_shape, data) + deallocate(data_f) + + if(present(override)) override = logical(override, c_bool) + +end subroutine CFMS_DATA_OVERRIDE_3D_ diff --git a/test_cfms/c_data_override/Makefile.am b/test_cfms/c_data_override/Makefile.am index 3661613..4355d3e 100644 --- a/test_cfms/c_data_override/Makefile.am +++ b/test_cfms/c_data_override/Makefile.am @@ -26,26 +26,27 @@ AM_CPPFLAGS = -I. -I$(MODDIR) -I${top_builddir}/c_data_override \ LDADD = ${top_builddir}/libcFMS/libcFMS.la check_PROGRAMS = test_data_override_scalar \ - test_data_override_2d + test_data_override_2d \ + test_data_override_3d TESTS = test_data_override_scalar.sh \ - test_data_override_2d.sh + test_data_override_2d.sh \ + test_data_override_3d.sh test_data_override_scalar_SOURCES = ../c_fms/c_mpp_domains_helper.c test_data_override_scalar.c test_data_override_2d_SOURCES = ../c_fms/c_mpp_domains_helper.c test_data_override_2d.c +test_data_override_3d_SOURCES = ../c_fms/c_mpp_domains_helper.c test_data_override_3d.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 + $(FC) $(FCFLAGS) $(LDFLAGS) test_data_override_ongrid.F90 -o test_data_override_ongrid -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 # Include these files with the distribution. -EXTRA_DIST = test_data_override_scalar.sh test_data_override_2d.sh +EXTRA_DIST = test_data_override_scalar.sh test_data_override_2d.sh test_data_override_3d.sh # Clean up 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 deleted file mode 100644 index 875c3fe..0000000 --- a/test_cfms/c_data_override/include/test_data_override_ongrid.inc +++ /dev/null @@ -1,224 +0,0 @@ -!*********************************************************************** -!* 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 deleted file mode 100644 index 99613c6..0000000 --- a/test_cfms/c_data_override/include/test_data_override_ongrid_r4.fh +++ /dev/null @@ -1,36 +0,0 @@ -!*********************************************************************** -!* 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 deleted file mode 100644 index 1b07b48..0000000 --- a/test_cfms/c_data_override/include/test_data_override_ongrid_r8.fh +++ /dev/null @@ -1,36 +0,0 @@ -!*********************************************************************** -!* 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_2d.c b/test_cfms/c_data_override/test_data_override_2d.c index 450604a..9ca1b53 100644 --- a/test_cfms/c_data_override/test_data_override_2d.c +++ b/test_cfms/c_data_override/test_data_override_2d.c @@ -72,7 +72,7 @@ int main() // data override 2d { char gridname[NAME_LENGTH] = "OCN"; - char fieldname[NAME_LENGTH] = "runoff_decreasing"; + char fieldname[NAME_LENGTH] = "runoff"; int data_shape[2]; double *data = NULL; bool override = false; diff --git a/test_cfms/c_data_override/test_data_override_2d.sh b/test_cfms/c_data_override/test_data_override_2d.sh index 08a04ce..a916fcf 100755 --- a/test_cfms/c_data_override/test_data_override_2d.sh +++ b/test_cfms/c_data_override/test_data_override_2d.sh @@ -34,7 +34,6 @@ mkdir INPUT cat < input.nml &test_data_override_ongrid_nml test_case=2 - write_only=.True. / &data_override_nml use_data_table_yaml = .True. @@ -44,17 +43,10 @@ EOF cat <<_EOF > data_table.yaml data_table: - grid_name: OCN - fieldname_in_model: runoff_increasing + fieldname_in_model: runoff override_file: - fieldname_in_file: runoff - file_name: ./INPUT/bilinear_increasing.nc - interp_method: bilinear - factor: 1.0 -- grid_name: OCN - fieldname_in_model: runoff_decreasing - override_file: - - fieldname_in_file: runoff - file_name: ./INPUT/bilinear_decreasing.nc + file_name: ./INPUT/array_2d.nc interp_method: bilinear factor: 1.0 _EOF diff --git a/test_cfms/c_data_override/test_data_override_3d.c b/test_cfms/c_data_override/test_data_override_3d.c new file mode 100644 index 0000000..f334c70 --- /dev/null +++ b/test_cfms/c_data_override/test_data_override_3d.c @@ -0,0 +1,116 @@ +#include +#include +#include +#include +#include + +#define NX 360 +#define NY 180 +#define NZ 5 +#define TOLERANCE 1e-11 +#define TEST_NTIMES 11 + +#define ABS(val,answ) (val TOLERANCE ) { + printf("index %d data=%lf answer=%lf, diff=%lf\n", ijk, data[ijk], answ, ABS(data[ijk],answ)); + cFMS_error(FATAL, "FAILURE IN 3D DATA_OVERRIDE"); + exit(EXIT_FAILURE); + } + ijk++; + } + } + } + } + + cFMS_end(); + return EXIT_SUCCESS; +} diff --git a/test_cfms/c_data_override/test_data_override_3d.sh b/test_cfms/c_data_override/test_data_override_3d.sh new file mode 100755 index 0000000..e3234b3 --- /dev/null +++ b/test_cfms/c_data_override/test_data_override_3d.sh @@ -0,0 +1,59 @@ +#!/bin/sh +#*********************************************************************** +#* 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 . +#*********************************************************************** +# This is part of the GFDL FMS package. This is a shell script to +# execute tests in the test_fms/coupler directory. + +# Set common test settings. +. ../test-lib.sh + +if [ -f "input.nml" ] ; then rm -f input.nml ; fi + +make test_data_override_ongrid + +if [ -d INPUT ] ; then rm -rf INPUT; fi +mkdir INPUT + +#generate input for bilinear 3d +cat < input.nml +&test_data_override_ongrid_nml + test_case=1 +/ +&data_override_nml + use_data_table_yaml = .True. +/ +EOF + +cat <<_EOF > data_table.yaml +data_table: +- grid_name: OCN + fieldname_in_model: runoff + override_file: + - fieldname_in_file: runoff + file_name: ./INPUT/array_3d.nc + interp_method: bilinear + factor: 1.0 +_EOF + +./test_data_override_ongrid + +test_expect_success "c_data_override_3d" 'mpirun -n 6 ./test_data_override_3d' +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 index 21ef8b0..b023568 100644 --- a/test_cfms/c_data_override/test_data_override_ongrid.F90 +++ b/test_cfms/c_data_override/test_data_override_ongrid.F90 @@ -36,7 +36,6 @@ program test_data_override_ongrid 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 @@ -51,22 +50,16 @@ program test_data_override_ongrid integer :: je !< Ending y index integer :: nhalox=2, nhaloy=2 integer :: io_status -integer, parameter :: ongrid = 1 -integer, parameter :: bilinear = 2 +integer, parameter :: array_3d = 1 +integer, parameter :: array_2d = 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 +integer :: test_case 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 +namelist /test_data_override_ongrid_nml/ test_case call fms_init call fms2_io_init @@ -77,23 +70,17 @@ program test_data_override_ongrid !< 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 +select case (test_case) +case (array_3d) + call generate_array_3d_input_file () +case (array_2d) + call generate_array_2d_input_file () +case (scalar) + call generate_scalar_input_file () +end select - call mpp_sync() - call mpp_error(NOTE, "Finished creating INPUT Files") -endif +call mpp_sync() +call mpp_error(NOTE, "Finished creating INPUT Files") call fms_end @@ -131,7 +118,7 @@ end subroutine create_ocean_mosaic_file subroutine create_ocean_hgrid_file type(FmsNetcdfFile_t) :: fileobj - real(r4_kind), allocatable, dimension(:,:) :: xdata, ydata + real(r8_kind), allocatable, dimension(:,:) :: xdata, ydata integer :: nx, nxp, ny, nyp, i, j nx = nlon*2 @@ -140,15 +127,15 @@ subroutine create_ocean_hgrid_file nyp = ny+1 allocate(xdata(nxp, nyp)) - xdata(1,:) = 0_r4_kind + xdata(1,:) = 0_r8_kind do i = 2, nxp - xdata(i,:) = xdata(i-1,:) + 0.5_r4_kind + xdata(i,:) = xdata(i-1,:) + 0.5_r8_kind enddo allocate(ydata(nxp, nyp)) - ydata(:,1) = -90.0_r4_kind + ydata(:,1) = -90.0_r8_kind do i = 2, nyp - ydata(:,i) = ydata(:, i-1) + 0.5_r4_kind + ydata(:,i) = ydata(:, i-1) + 0.5_r8_kind enddo if (open_file(fileobj, 'INPUT/ocean_hgrid.nc', 'overwrite')) then @@ -167,46 +154,64 @@ subroutine create_ocean_hgrid_file 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 = "" +!> @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_array_2d_data_file() - if (present(is_ensemble)) then - offset = ensemble_id - call get_filename_appendix(appendix) - appendix = "_"//trim(appendix) - endif + type(FmsNetcdfFile_t) :: fileobj !< Fms2_io fileobj + character(len=10) :: dimnames(3) !< dimension names for the variable + real(r8_kind), allocatable :: runoff_in(:,:,:) !< Data to write + real(r8_kind), allocatable :: time_data(:) !< Time dimension data + real(r8_kind), allocatable :: lat_data(:) !< Lat dimension data + real(r8_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 - allocate(runoff_in(nlon, nlat, 10)) + 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)) - do i = 1, 10 - runoff_in(:,:,i) = real(i+offset, r4_kind) + filename = 'INPUT/array_2d.nc' + lon_data(1) = 360.0_r8_kind + lat_data(1) = 89.0_r8_kind + factor = -1 + do i = 1, nlon_data + do j = 1, nlat_data + do k = 1, 10 + runoff_in(i, j, k) = 100._r8_kind + k*.01_r8_kind + enddo + enddo + enddo + + do i = 2, nlon_data + lon_data(i) = real(lon_data(i-1) + 1*factor, r8_kind) + enddo + + do i = 2, nlat_data + lat_data(i) =real(lat_data(i-1) + 1*factor, r8_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/) + time_data = (/1_r8_kind, 2_r8_kind, & + 3_r8_kind, 5_r8_kind, & + 6_r8_kind, 7_r8_kind, & + 8_r8_kind, 9_r8_kind, & + 10_r8_kind, 11_r8_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) + 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"/)) @@ -220,82 +225,60 @@ subroutine create_ongrid_data_file(is_ensemble) 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 register_field(fileobj, "runoff", "double", 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/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 +end subroutine create_array_2d_data_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 +subroutine create_array_3d_data_file() type(FmsNetcdfFile_t) :: fileobj !< Fms2_io fileobj - character(len=10) :: dimnames(3) !< dimension names for the variable - real(r8_kind), allocatable :: runoff_in(:,:,:) !< Data to write + character(len=10) :: dimnames(4) !< dimension names for the variable + real(r8_kind), allocatable :: runoff_in(:,:,:,:) !< Data to write real(r8_kind), allocatable :: time_data(:) !< Time dimension data real(r8_kind), allocatable :: lat_data(:) !< Lat dimension data real(r8_kind), allocatable :: lon_data(:) !< Lon dimension data + integer, allocatable :: z_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 + integer :: i, j, k, z !< For looping through variables + integer :: nlon_data, nlat_data, nz_data nlon_data = nlon + 1 nlat_data = nlat - 1 - allocate(runoff_in(nlon_data, nlat_data, 10)) + nz_data = 5 + allocate(runoff_in(nlon_data, nlat_data, nz_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_r8_kind - lat_data(1) = 89.0_r8_kind - factor = -1 - do i = 1, nlon_data - do j = 1, nlat_data - do k = 1, 10 - runoff_in(i, j, k) = 100._r8_kind + k*.01_r8_kind - != real(-i, kind=r8_kind) * 100._r8_kind + & - ! real(-j, kind=r8_kind) + real(-k, kind=r8_kind)/100._r8_kind + allocate(z_data(nz_data)) + + filename = 'INPUT/array_3d.nc' + lon_data(1) = 360.0_r8_kind + lat_data(1) = 89.0_r8_kind + factor = -1 + do i = 1, nlon_data + do j = 1, nlat_data + do z=1, nz_data + do k = 1, 10 + runoff_in(i, j, z, k) = z*100._r8_kind + k*.01_r8_kind + != real(-i, kind=r8_kind) * 100._r8_kind + & + ! real(-j, kind=r8_kind) + real(-k, kind=r8_kind)/100._r8_kind + end do enddo - enddo - enddo - else - filename = 'INPUT/bilinear_increasing.nc' - lon_data(1) = 0.0_r8_kind - lat_data(1) = -89.0_r8_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=r8_kind) * 1000._r8_kind + real(j, kind=r8_kind) + & - real(k, kind=r8_kind)/100._r8_kind - enddo - enddo - enddo - endif - + enddo + enddo + do i = 2, nlon_data lon_data(i) = real(lon_data(i-1) + 1*factor, r8_kind) enddo @@ -304,6 +287,10 @@ subroutine create_bilinear_data_file(increasing_grid) lat_data(i) =real(lat_data(i-1) + 1*factor, r8_kind) enddo + do i=1, nz_data + z_data(i) = i + end do + time_data = (/1_r8_kind, 2_r8_kind, & 3_r8_kind, 5_r8_kind, & 6_r8_kind, 7_r8_kind, & @@ -312,11 +299,13 @@ subroutine create_bilinear_data_file(increasing_grid) dimnames(1) = 'i' dimnames(2) = 'j' - dimnames(3) = 'time' + dimnames(3) = 'z' + dimnames(4) = '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, "z", nz_data) call register_axis(fileobj, "time", unlimited) call register_field(fileobj, "i", "float", (/"i"/)) @@ -325,6 +314,9 @@ subroutine create_bilinear_data_file(increasing_grid) call register_field(fileobj, "j", "float", (/"j"/)) call register_variable_attribute(fileobj, "j", "cartesian_axis", "y", str_len=1) + call register_field(fileobj, "z", "int", (/"z"/)) + call register_variable_attribute(fileobj, "z", "extra_axis", "z", 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) @@ -335,81 +327,35 @@ subroutine create_bilinear_data_file(increasing_grid) 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, "z", z_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 +end subroutine create_array_3d_data_file !> @brief Generates the input for the bilinear data_override test_case -subroutine generate_bilinear_input_file +subroutine generate_array_2d_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.) + call create_array_2d_data_file() 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 +end subroutine generate_array_2d_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) +!> @brief Generates the input for the bilinear data_override test_case +subroutine generate_array_3d_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_array_3d_data_file() endif -end subroutine create_weight_file + call mpp_sync() +end subroutine generate_array_3d_input_file + !> @brief Generates the input for the bilinear data_override test_case subroutine generate_scalar_input_file @@ -425,22 +371,22 @@ 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 + real(r8_kind), allocatable, dimension(:) :: co2_in + real(r8_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) + co2_in(i) = real(i, r8_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/) + time_data = (/1_r8_kind, 2_r8_kind, & + 3_r8_kind, 5_r8_kind, & + 6_r8_kind, 7_r8_kind, & + 8_r8_kind, 9_r8_kind, & + 10_r8_kind, 11_r8_kind/) dimnames(1) = 'time' @@ -461,58 +407,4 @@ subroutine create_scalar_data_file 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_data_override/test_data_override_scalar.sh b/test_cfms/c_data_override/test_data_override_scalar.sh index c1e05f4..715c0ea 100755 --- a/test_cfms/c_data_override/test_data_override_scalar.sh +++ b/test_cfms/c_data_override/test_data_override_scalar.sh @@ -34,7 +34,6 @@ mkdir INPUT cat < input.nml &test_data_override_ongrid_nml test_case=3 - write_only=.True. / &data_override_nml use_data_table_yaml = .True.