From 15fdb290154f5d8b2abe93d50d6d46802434ef9d Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 17 Mar 2025 14:14:18 -0400 Subject: [PATCH 01/18] first version of pointer to array subroutines --- .gitmodules | 2 +- FMS | 2 +- Makefile.am | 1 + c_fms_utils/Makefile.am | 42 ++++++ c_fms_utils/c_fms_utils.F90 | 28 ++++ c_fms_utils/c_fms_utils.h | 0 c_fms_utils/include/pointer_to_array.fh | 172 +++++++++++++++++++++++ c_fms_utils/include/pointer_to_array.inc | 13 ++ configure.ac | 2 + libcFMS/Makefile.am | 1 + test_cfms/Makefile.am | 2 +- test_cfms/c_fms_utils/Makefile.am | 48 +++++++ test_cfms/c_fms_utils/test_utils.F90 | 37 +++++ test_cfms/c_fms_utils/test_utils.sh | 30 ++++ test_cfms/c_fms_utils/test_utils_c.c | 30 ++++ 15 files changed, 407 insertions(+), 3 deletions(-) create mode 100644 c_fms_utils/Makefile.am create mode 100644 c_fms_utils/c_fms_utils.F90 create mode 100644 c_fms_utils/c_fms_utils.h create mode 100644 c_fms_utils/include/pointer_to_array.fh create mode 100644 c_fms_utils/include/pointer_to_array.inc create mode 100644 test_cfms/c_fms_utils/Makefile.am create mode 100644 test_cfms/c_fms_utils/test_utils.F90 create mode 100755 test_cfms/c_fms_utils/test_utils.sh create mode 100644 test_cfms/c_fms_utils/test_utils_c.c diff --git a/.gitmodules b/.gitmodules index a402ae5..4610ee4 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,4 +1,4 @@ [submodule "FMS"] - branch = 2024.03 + branch = main path = FMS url = https://github.com/NOAA-GFDL/FMS.git diff --git a/FMS b/FMS index d79c3b5..9f6baef 160000 --- a/FMS +++ b/FMS @@ -1 +1 @@ -Subproject commit d79c3b53c04e81ba009533aa3f6428d102868432 +Subproject commit 9f6baefcc54c4e1791f7be073135c868e7adf496 diff --git a/Makefile.am b/Makefile.am index 17d33b1..7ce53cd 100644 --- a/Makefile.am +++ b/Makefile.am @@ -34,6 +34,7 @@ endif # Make targets will be run in each subdirectory. Order is significant. SUBDIRS = c_fms \ + c_fms_utils \ c_constants \ c_grid_utils \ c_horiz_interp \ diff --git a/c_fms_utils/Makefile.am b/c_fms_utils/Makefile.am new file mode 100644 index 0000000..ad66f48 --- /dev/null +++ b/c_fms_utils/Makefile.am @@ -0,0 +1,42 @@ +#*********************************************************************** +#* 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 an automake file for the fms directory of the FMS +# package. + +# Ed Hartnett 2/22/19 + +# Include .h and .mod files. +AM_CPPFLAGS = -I. -I./include +AM_FCFLAGS = $(FC_MODINC). $(FC_MODOUT)$(MODDIR) + +# Build these uninstalled convenience libraries. +noinst_LTLIBRARIES = lib_c_fms_utils.la + +# Each convenience library depends on its source. +lib_c_fms_utils_la_SOURCES = c_fms_utils.F90 + +# Mod files are built and then installed as headers. +MODFILES = c_fms_utils_mod.$(FC_MODEXT) +BUILT_SOURCES = $(MODFILES) +nodist_include_HEADERS = $(FMS_INC_FILES) $(MODFILES) + +include_HEADERS = c_fms_utils.h + +include $(top_srcdir)/mkmods.mk diff --git a/c_fms_utils/c_fms_utils.F90 b/c_fms_utils/c_fms_utils.F90 new file mode 100644 index 0000000..1304577 --- /dev/null +++ b/c_fms_utils/c_fms_utils.F90 @@ -0,0 +1,28 @@ +module c_fms_utils_mod + + use iso_c_binding + implicit none + + private + public :: cFMS_pointer_to_array + + interface cFMS_pointer_to_array + module procedure cFMS_pointer_to_array_2d_int + module procedure cFMS_pointer_to_array_3d_int + module procedure cFMS_pointer_to_array_4d_int + module procedure cFMS_pointer_to_array_5d_int + module procedure cFMS_pointer_to_array_2d_cfloat + module procedure cFMS_pointer_to_array_3d_cfloat + module procedure cFMS_pointer_to_array_4d_cfloat + module procedure cFMS_pointer_to_array_5d_cfloat + module procedure cFMS_pointer_to_array_2d_cdouble + module procedure cFMS_pointer_to_array_3d_cdouble + module procedure cFMS_pointer_to_array_4d_cdouble + module procedure cFMS_pointer_to_array_5d_cdouble + end interface cFMS_pointer_to_array + +contains + +#include "pointer_to_array.fh" + +end module c_fms_utils_mod diff --git a/c_fms_utils/c_fms_utils.h b/c_fms_utils/c_fms_utils.h new file mode 100644 index 0000000..e69de29 diff --git a/c_fms_utils/include/pointer_to_array.fh b/c_fms_utils/include/pointer_to_array.fh new file mode 100644 index 0000000..cfc7e57 --- /dev/null +++ b/c_fms_utils/include/pointer_to_array.fh @@ -0,0 +1,172 @@ +!integer +#undef CFMS_POINTER_TO_ARRAY_ +#undef CFMS_POINTER_TO_ARRAY_TYPE_ +#undef CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ +#define CFMS_POINTER_TO_ARRAY_ cFMS_pointer_to_array_2d_int +#define CFMS_POINTER_TO_ARRAY_TYPE_ integer +#define CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ :,: +#define CFMS_POINTER_TO_ARRAY_SHAPE_ (/c_shape(1), c_shape(2)/) +#define CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ (/c_shape(2),c_shape(1)/) +#define CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ (/2,1/) +#include "pointer_to_array.inc" + +#undef CFMS_POINTER_TO_ARRAY_ +#undef CFMS_POINTER_TO_ARRAY_TYPE_ +#undef CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ +#define CFMS_POINTER_TO_ARRAY_ cFMS_pointer_to_array_3d_int +#define CFMS_POINTER_TO_ARRAY_TYPE_ integer +#define CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ :,:,: +#define CFMS_POINTER_TO_ARRAY_SHAPE_ (/c_shape(1), c_shape(2), c_shape(3)/) +#define CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ (/c_shape(3),c_shape(2),c_shape(1)/) +#define CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ (/3,2,1/) +#include "pointer_to_array.inc" + +#undef CFMS_POINTER_TO_ARRAY_ +#undef CFMS_POINTER_TO_ARRAY_TYPE_ +#undef CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ +#define CFMS_POINTER_TO_ARRAY_ cFMS_pointer_to_array_4d_int +#define CFMS_POINTER_TO_ARRAY_TYPE_ integer +#define CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ :,:,:,: +#define CFMS_POINTER_TO_ARRAY_SHAPE_ (/c_shape(1), c_shape(2), c_shape(3), c_shape(4)/) +#define CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ (/c_shape(4),c_shape(3),c_shape(2),c_shape(1)/) +#define CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ (/4,3,2,1/) +#include "pointer_to_array.inc" + +#undef CFMS_POINTER_TO_ARRAY_ +#undef CFMS_POINTER_TO_ARRAY_TYPE_ +#undef CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ +#define CFMS_POINTER_TO_ARRAY_ cFMS_pointer_to_array_5d_int +#define CFMS_POINTER_TO_ARRAY_TYPE_ integer +#define CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ :,:,:,:,: +#define CFMS_POINTER_TO_ARRAY_SHAPE_ (/c_shape(1), c_shape(2), c_shape(3), c_shape(4), c_shape(5)/) +#define CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ (/c_shape(5),c_shape(4),c_shape(3),c_shape(2),c_shape(1)/) +#define CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ (/5,4,3,2,1/) +#include "pointer_to_array.inc" + + +!c_float +#undef CFMS_POINTER_TO_ARRAY_ +#undef CFMS_POINTER_TO_ARRAY_TYPE_ +#undef CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ +#define CFMS_POINTER_TO_ARRAY_ cFMS_pointer_to_array_2d_cfloat +#define CFMS_POINTER_TO_ARRAY_TYPE_ real(c_float) +#define CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ :,: +#define CFMS_POINTER_TO_ARRAY_SHAPE_ (/c_shape(1), c_shape(2)/) +#define CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ (/c_shape(2),c_shape(1)/) +#define CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ (/2,1/) +#include "pointer_to_array.inc" + +#undef CFMS_POINTER_TO_ARRAY_ +#undef CFMS_POINTER_TO_ARRAY_TYPE_ +#undef CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ +#define CFMS_POINTER_TO_ARRAY_ cFMS_pointer_to_array_3d_cfloat +#define CFMS_POINTER_TO_ARRAY_TYPE_ real(c_float) +#define CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ :,:,: +#define CFMS_POINTER_TO_ARRAY_SHAPE_ (/c_shape(1), c_shape(2), c_shape(3)/) +#define CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ (/c_shape(3),c_shape(2),c_shape(1)/) +#define CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ (/3,2,1/) +#include "pointer_to_array.inc" + +#undef CFMS_POINTER_TO_ARRAY_ +#undef CFMS_POINTER_TO_ARRAY_TYPE_ +#undef CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ +#define CFMS_POINTER_TO_ARRAY_ cFMS_pointer_to_array_4d_cfloat +#define CFMS_POINTER_TO_ARRAY_TYPE_ real(c_float) +#define CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ :,:,:,: +#define CFMS_POINTER_TO_ARRAY_SHAPE_ (/c_shape(1), c_shape(2), c_shape(3), c_shape(4)/) +#define CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ (/c_shape(4),c_shape(3),c_shape(2),c_shape(1)/) +#define CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ (/4,3,2,1/) +#include "pointer_to_array.inc" + +#undef CFMS_POINTER_TO_ARRAY_ +#undef CFMS_POINTER_TO_ARRAY_TYPE_ +#undef CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ +#define CFMS_POINTER_TO_ARRAY_ cFMS_pointer_to_array_5d_cfloat +#define CFMS_POINTER_TO_ARRAY_TYPE_ real(c_float) +#define CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ :,:,:,:,: +#define CFMS_POINTER_TO_ARRAY_SHAPE_ (/c_shape(1), c_shape(2), c_shape(3), c_shape(4), c_shape(5)/) +#define CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ (/c_shape(5),c_shape(4),c_shape(3),c_shape(2),c_shape(1)/) +#define CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ (/5,4,3,2,1/) +#include "pointer_to_array.inc" + +!cdouble +#undef CFMS_POINTER_TO_ARRAY_ +#undef CFMS_POINTER_TO_ARRAY_TYPE_ +#undef CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ +#define CFMS_POINTER_TO_ARRAY_ cFMS_pointer_to_array_2d_cdouble +#define CFMS_POINTER_TO_ARRAY_TYPE_ real(c_double) +#define CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ :,: +#define CFMS_POINTER_TO_ARRAY_SHAPE_ (/c_shape(1), c_shape(2)/) +#define CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ (/c_shape(2),c_shape(1)/) +#define CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ (/2,1/) +#include "pointer_to_array.inc" + +#undef CFMS_POINTER_TO_ARRAY_ +#undef CFMS_POINTER_TO_ARRAY_TYPE_ +#undef CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ +#define CFMS_POINTER_TO_ARRAY_ cFMS_pointer_to_array_3d_cdouble +#define CFMS_POINTER_TO_ARRAY_TYPE_ real(c_double) +#define CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ :,:,: +#define CFMS_POINTER_TO_ARRAY_SHAPE_ (/c_shape(1), c_shape(2), c_shape(3)/) +#define CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ (/c_shape(3),c_shape(2),c_shape(1)/) +#define CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ (/3,2,1/) +#include "pointer_to_array.inc" + +#undef CFMS_POINTER_TO_ARRAY_ +#undef CFMS_POINTER_TO_ARRAY_TYPE_ +#undef CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ +#define CFMS_POINTER_TO_ARRAY_ cFMS_pointer_to_array_4d_cdouble +#define CFMS_POINTER_TO_ARRAY_TYPE_ real(c_double) +#define CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ :,:,:,: +#define CFMS_POINTER_TO_ARRAY_SHAPE_ (/c_shape(1), c_shape(2), c_shape(3), c_shape(4)/) +#define CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ (/c_shape(4),c_shape(3),c_shape(2),c_shape(1)/) +#define CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ (/4,3,2,1/) +#include "pointer_to_array.inc" + +#undef CFMS_POINTER_TO_ARRAY_ +#undef CFMS_POINTER_TO_ARRAY_TYPE_ +#undef CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ +#undef CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ +#define CFMS_POINTER_TO_ARRAY_ cFMS_pointer_to_array_5d_cdouble +#define CFMS_POINTER_TO_ARRAY_TYPE_ real(c_double) +#define CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_ :,:,:,:,: +#define CFMS_POINTER_TO_ARRAY_SHAPE_ (/c_shape(1), c_shape(2), c_shape(3), c_shape(4), c_shape(5)/) +#define CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_ (/c_shape(5),c_shape(4),c_shape(3),c_shape(2),c_shape(1)/) +#define CFMS_POINTER_TO_ARRAY_ROW_MAJOR_ (/5,4,3,2,1/) +#include "pointer_to_array.inc" + diff --git a/c_fms_utils/include/pointer_to_array.inc b/c_fms_utils/include/pointer_to_array.inc new file mode 100644 index 0000000..a7a62c9 --- /dev/null +++ b/c_fms_utils/include/pointer_to_array.inc @@ -0,0 +1,13 @@ +subroutine CFMS_POINTER_TO_ARRAY_(c_pointer, c_shape, f_array) + + implicit none + type(c_ptr), intent(in), value :: c_pointer + integer, intent(in) :: c_shape(:) + CFMS_POINTER_TO_ARRAY_TYPE_, intent(out) :: f_array(CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_) + + CFMS_POINTER_TO_ARRAY_TYPE_, pointer :: f_array_reversed(CFMS_POINTER_TO_ARRAY_ASSUMED_SHAPE_) + + call c_f_pointer(c_pointer, f_array_reversed, CFMS_POINTER_TO_ARRAY_REVERSED_SHAPE_) + f_array = reshape(f_array_reversed, shape=CFMS_POINTER_TO_ARRAY_SHAPE_, order=CFMS_POINTER_TO_ARRAY_ROW_MAJOR_) + +end subroutine CFMS_POINTER_TO_ARRAY_ diff --git a/configure.ac b/configure.ac index eea2f21..25362d1 100644 --- a/configure.ac +++ b/configure.ac @@ -355,6 +355,7 @@ AC_SUBST([MODDIR],[\$\(top_builddir\)/.mods]) AC_CONFIG_FILES([ Makefile c_fms/Makefile + c_fms_utils/Makefile c_constants/Makefile c_grid_utils/Makefile c_horiz_interp/Makefile @@ -363,6 +364,7 @@ AC_CONFIG_FILES([ test_cfms/intel_coverage.sh test_cfms/Makefile test_cfms/c_fms/Makefile + test_cfms/c_fms_utils/Makefile test_cfms/c_grid_utils/Makefile test_cfms/c_horiz_interp/Makefile ]) diff --git a/libcFMS/Makefile.am b/libcFMS/Makefile.am index e5c0ca9..b153950 100644 --- a/libcFMS/Makefile.am +++ b/libcFMS/Makefile.am @@ -35,6 +35,7 @@ libcFMS_la_LIBADD = $(top_builddir)/c_fms/lib_c_fms.la libcFMS_la_LIBADD += $(top_builddir)/c_constants/lib_c_constants.la libcFMS_la_LIBADD += $(top_builddir)/c_horiz_interp/lib_c_horiz_interp.la libcFMS_la_LIBADD += $(top_builddir)/c_grid_utils/lib_c_grid_utils.la +libcFMS_la_LIBADD += $(top_builddir)/c_fms_utils/lib_c_fms_utils.la libcFMS_la_SOURCES = diff --git a/test_cfms/Makefile.am b/test_cfms/Makefile.am index 449cbb6..db42f52 100644 --- a/test_cfms/Makefile.am +++ b/test_cfms/Makefile.am @@ -24,7 +24,7 @@ ACLOCAL_AMFLAGS = -I m4 # Make targets will be run in each subdirectory. Order is significant. -SUBDIRS = c_fms c_grid_utils c_horiz_interp +SUBDIRS = c_fms c_fms_utils c_grid_utils c_horiz_interp # testing utility scripts to distribute EXTRA_DIST = test-lib.sh.in intel_coverage.sh.in tap-driver.sh diff --git a/test_cfms/c_fms_utils/Makefile.am b/test_cfms/c_fms_utils/Makefile.am new file mode 100644 index 0000000..99e3d6e --- /dev/null +++ b/test_cfms/c_fms_utils/Makefile.am @@ -0,0 +1,48 @@ +#*********************************************************************** +#* 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 . +#*********************************************************************** +# + +# Find the needed mod and .inc files. +AM_CPPFLAGS = -I. -I$(MODDIR) + +# Link to the FMS library. +LDADD = ${top_builddir}/libcFMS/libcFMS.la + +check_PROGRAMS = test_utils + +TESTS = test_utils.sh + +test_utils_SOURCES = test_utils.F90 test_utils_c.c + +test_utils_c.o : test_utils_c.c + $(CC) -c $(CFLAGS) $(LDFLAGS) test_utils_c.c -o test_utils_c.o + +test_utils.o : test_utils.F90 + $(FC) -c $(FCFLAGS) $(LDFLAGS) $(AM_CPPFLAGS) test_utils.F90 -o test_utils.o + +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_utils.sh + +# Clean up +CLEANFILES = input.nml *.nc* *.out *.dpi *.spi *.dyn *.spl *_table* input* *trs + diff --git a/test_cfms/c_fms_utils/test_utils.F90 b/test_cfms/c_fms_utils/test_utils.F90 new file mode 100644 index 0000000..34e2381 --- /dev/null +++ b/test_cfms/c_fms_utils/test_utils.F90 @@ -0,0 +1,37 @@ +program main + + use c_fms_mod + use c_fms_utils_mod, only : cFMS_pointer_to_array + use iso_c_binding + implicit none + + + call test_3d_cdouble() + +contains + subroutine test_3d_cdouble() + + implicit none + real(c_double), target :: c_pointer(100) + real(c_double), allocatable :: test_array(:,:,:) + integer :: c_shape(3) + + integer :: i, j, k + + call test(c_shape, c_pointer) + + allocate(test_array(c_shape(1), c_shape(2), c_shape(3))) + call cFMS_pointer_to_array(c_loc(c_pointer), c_shape, test_array) + + do k=1, c_shape(3) + do j=1, c_shape(2) + do i=1, c_shape(1) + if(test_array(i,j,k).ne. real(i*100+j*10+k,c_double)) call cFMS_error(FATAL); + end do + end do + end do + + end subroutine test_3d_cdouble + +end program main + diff --git a/test_cfms/c_fms_utils/test_utils.sh b/test_cfms/c_fms_utils/test_utils.sh new file mode 100755 index 0000000..93e9b4b --- /dev/null +++ b/test_cfms/c_fms_utils/test_utils.sh @@ -0,0 +1,30 @@ +#!/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 +touch input.nml + +test_expect_success "test utils" 'mpirun -n 1 ./test_utils' +test_done diff --git a/test_cfms/c_fms_utils/test_utils_c.c b/test_cfms/c_fms_utils/test_utils_c.c new file mode 100644 index 0000000..9d75f25 --- /dev/null +++ b/test_cfms/c_fms_utils/test_utils_c.c @@ -0,0 +1,30 @@ +#include +#include + +#define NX 10 +#define NY 5 +#define NZ 2 + +// array(NX, NY, NZ) + + +void test_(int *c_shape, double *c_pointer) +{ + + c_shape[0] = NX; + c_shape[1] = NY; + c_shape[2] = NZ; + + int ijk = 0; + for(int i=0; i Date: Mon, 17 Mar 2025 18:16:15 -0400 Subject: [PATCH 02/18] maybe working c_diag_manager --- Makefile.am | 2 +- c_diag_manager/Makefile.am | 44 ++++ c_diag_manager/c_diag_manager.F90 | 247 ++++++++++++++++++ c_diag_manager/include/c_diag_axis_init.fh | 15 ++ c_diag_manager/include/c_diag_axis_init.inc | 82 ++++++ .../include/c_register_diag_field.fh | 46 ++++ .../include/c_register_diag_field.inc | 185 +++++++++++++ c_diag_manager/include/c_send_data.fh | 148 +++++++++++ c_diag_manager/include/c_send_data.inc | 26 ++ c_fms/c_fms.F90 | 10 +- c_fms/c_fms.h | 2 + configure.ac | 2 + libcFMS/Makefile.am | 1 + test_cfms/Makefile.am | 2 +- test_cfms/c_diag_manager/Makefile.am | 43 +++ test_cfms/c_diag_manager/test_send_data.c | 203 ++++++++++++++ test_cfms/c_diag_manager/test_send_data.sh | 53 ++++ 17 files changed, 1108 insertions(+), 3 deletions(-) create mode 100644 c_diag_manager/Makefile.am create mode 100644 c_diag_manager/c_diag_manager.F90 create mode 100644 c_diag_manager/include/c_diag_axis_init.fh create mode 100644 c_diag_manager/include/c_diag_axis_init.inc create mode 100644 c_diag_manager/include/c_register_diag_field.fh create mode 100644 c_diag_manager/include/c_register_diag_field.inc create mode 100644 c_diag_manager/include/c_send_data.fh create mode 100644 c_diag_manager/include/c_send_data.inc create mode 100644 test_cfms/c_diag_manager/Makefile.am create mode 100644 test_cfms/c_diag_manager/test_send_data.c create mode 100755 test_cfms/c_diag_manager/test_send_data.sh diff --git a/Makefile.am b/Makefile.am index 7ce53cd..17aeefc 100644 --- a/Makefile.am +++ b/Makefile.am @@ -2,7 +2,6 @@ #* 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 @@ -36,6 +35,7 @@ endif SUBDIRS = c_fms \ c_fms_utils \ c_constants \ + c_diag_manager \ c_grid_utils \ c_horiz_interp \ libcFMS \ diff --git a/c_diag_manager/Makefile.am b/c_diag_manager/Makefile.am new file mode 100644 index 0000000..3417ef1 --- /dev/null +++ b/c_diag_manager/Makefile.am @@ -0,0 +1,44 @@ +#*********************************************************************** +#* 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 an automake file for the fms directory of the FMS +# package. + +# Ed Hartnett 2/22/19 + +# Include .h and .mod files. +AM_CPPFLAGS = -I. -I./include +AM_FCFLAGS = $(FC_MODINC). $(FC_MODOUT)$(MODDIR) + +# Build these uninstalled convenience libraries. +noinst_LTLIBRARIES = lib_c_diag_manager.la + +# Each convenience library depends on its source. +lib_c_diag_manager_la_SOURCES = c_diag_manager.F90 + +c_diag_manager_mod.mod : c_diag_manager.F90 + +# Mod files are built and then installed as headers. +MODFILES = c_diag_manager_mod.mod +BUILT_SOURCES = $(MODFILES) +nodist_include_HEADERS = $(FMS_INC_FILES) $(MODFILES) + +include_HEADERS = c_diag_manager.h + +include $(top_srcdir)/mkmods.mk diff --git a/c_diag_manager/c_diag_manager.F90 b/c_diag_manager/c_diag_manager.F90 new file mode 100644 index 0000000..dd55a71 --- /dev/null +++ b/c_diag_manager/c_diag_manager.F90 @@ -0,0 +1,247 @@ +module c_diag_manager_mod + + use FMS, only : fms_diag_init, fms_diag_end + use FMS, only : fms_diag_register_diag_field, fms_diag_register_static_field, fms_diag_axis_init + use FMS, only : fms_diag_send_data, fms_diag_send_complete, fms_diag_set_time_end + use FMS, only : DIAG_OTHER, DIAG_OCEAN, DIAG_ALL + + use fms_diag_yaml_mod, only: get_num_unique_fields + + 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 : fms_time_manager_get_date + + use FMS, only : FmsMppDomain2D + + use c_fms_mod, only : cFMS_get_current_domain + use c_fms_mod, only : NAME_LENGTH, MESSAGE_LENGTH + use c_fms_utils_mod, only : cFMS_pointer_to_array + + use iso_c_binding + + implicit none + + private + + public :: cFMS_diag_axis_init_cfloat + public :: cFMS_diag_axis_init_cdouble + public :: cFMS_diag_end + public :: cFMS_diag_send_complete + public :: cFMS_diag_init + public :: cFMS_diag_set_time_end + public :: cFMS_diag_set_field_init_time + public :: cFMS_diag_set_field_timestep + public :: cFMS_diag_advance_field_time + + public :: cFMS_register_diag_field_scalar_cint + public :: cFMS_register_diag_field_scalar_cfloat + public :: cFMS_register_diag_field_scalar_cdouble + public :: cFMS_register_diag_field_array_cint + public :: cFMS_register_diag_field_array_cfloat + public :: cFMS_register_diag_field_array_cdouble + + public :: cFMS_diag_send_data_2d_cint + public :: cFMS_diag_send_data_3d_cint + public :: cFMS_diag_send_data_4d_cint + public :: cFMS_diag_send_data_5d_cint + public :: cFMS_diag_send_data_2d_cfloat + public :: cFMS_diag_send_data_3d_cfloat + public :: cFMS_diag_send_data_4d_cfloat + public :: cFMS_diag_send_data_5d_cfloat + public :: cFMS_diag_send_data_2d_cdouble + public :: cFMS_diag_send_data_3d_cdouble + public :: cFMS_diag_send_data_4d_cdouble + public :: cFMS_diag_send_data_5d_cdouble + + type(FmsTime_type) :: field_init_time + type(FmsTime_type) :: cFMS_diag_end_time + type(FmsTime_type), allocatable :: field_curr_time(:) + type(FmsTime_type), allocatable :: field_timestep(:) + + integer, public, bind(C, name="DIAG_OTHER") :: DIAG_OTHER_C = DIAG_OTHER + 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") + implicit none + + call fms_diag_end(cFMS_diag_end_time) + + 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') + + 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 + + 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, & + err_msg = err_msg_f) + + nfields = get_num_unique_fields() + allocate(field_curr_time(nfields)) + allocate(field_timestep(nfields)) + + if(present(err_msg) .and. err_msg_f /= '' ) call fms_string_utils_f2c_string(err_msg, err_msg_f) + + end subroutine cFMS_diag_init + + + !cFMS_diag_send_complete + subroutine cFMS_diag_send_complete(diag_field_id, err_msg) bind(C, name="cFMS_diag_send_complete") + + implicit none + integer, intent(in) :: diag_field_id + character(c_char), intent(out), optional :: err_msg(MESSAGE_LENGTH) + + character(len=MESSAGE_LENGTH-1) :: err_msg_f = "None" + + call fms_diag_send_complete(field_timestep(diag_field_id), 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_diag_send_complete + + + !cFMS_diag_set_field_init_time + subroutine cFMS_diag_set_field_init_time(year, month, day, hour, minute, second, tick, err_msg) & + bind(C, name="cFMS_diag_set_field_init_time") + + implicit none + integer, intent(in) :: year + integer, intent(in) :: month + integer, intent(in) :: day + integer, intent(in) :: hour + integer, intent(in) :: 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 = "" + + field_init_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_diag_set_field_init_time + + + !cFMS_diag_set_field_timestep + subroutine cFMS_diag_set_field_timestep(diag_field_id, dseconds, ddays, dticks, & + err_msg) bind(C, name="cFMS_diag_set_field_timestep") + + implicit none + integer, intent(in) :: diag_field_id + integer, intent(in) :: dseconds + integer, intent(in), optional :: ddays + integer, intent(in), optional :: dticks + character, intent(out), optional :: err_msg(MESSAGE_LENGTH) + + character(MESSAGE_LENGTH-1) :: err_msg_f = "" + + field_timestep(diag_field_id) = fms_time_manager_set_time(seconds = dseconds, & + days = ddays, & + ticks = dticks, & + 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_diag_set_field_timestep + + + !cFMS_diag_advance_field_time + subroutine cFMS_diag_advance_field_time(diag_field_id) bind(C, name="cFMS_diag_advance_field_time") + + implicit none + integer, intent(in) :: diag_field_id + + integer :: year, month, day, hour, minute, second + + field_curr_time(diag_field_id) = field_curr_time(diag_field_id) + field_timestep(diag_field_id) + + + end subroutine cFMS_diag_advance_field_time + + subroutine cFMS_diag_set_time_end(year, month, day, hour, minute, second, tick, err_msg) & + bind(C, name="cFMS_diag_set_time_end") + + 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(c_char), intent(in), optional :: err_msg(MESSAGE_LENGTH) + + character(MESSAGE_LENGTH-1) :: err_msg_f + + cFMS_diag_end_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) + + call fms_diag_set_time_end(cFMS_diag_end_time) + + end subroutine cFMS_diag_set_time_end + +#include "c_diag_axis_init.fh" +#include "c_register_diag_field.fh" +#include "c_send_data.fh" + + !subroutine register_diag_field + !subroutine register_static_field + + + !subroutine send_data + !subroutine send_tile_averaged_data + !subroutine diag_end + !subroutine get_base_time + !subroutine get_base_date + !subroutine get_diag_global_att + !subroutine set_diag_global_att + !subroutine diag_field_add_attribute + !subroutine get_diag_field_id + !subroutine diag_axis_add_attribute + !subroutine diag_send_complete + !subroutine diag_send_complete_instant + + +end module c_diag_manager_mod diff --git a/c_diag_manager/include/c_diag_axis_init.fh b/c_diag_manager/include/c_diag_axis_init.fh new file mode 100644 index 0000000..04aa0e4 --- /dev/null +++ b/c_diag_manager/include/c_diag_axis_init.fh @@ -0,0 +1,15 @@ +#undef CFMS_DIAG_AXIS_INIT_ +#undef CFMS_DIAG_AXIS_INIT_BINDC_ +#undef CFMS_AXIS_DATA_KIND_ +#define CFMS_DIAG_AXIS_INIT_ cFMS_diag_axis_init_cfloat +#define CFMS_DIAG_AXIS_INIT_BINDC_ "cFMS_diag_axis_init_cfloat" +#define CFMS_AXIS_DATA_KIND_ c_float +#include "c_diag_axis_init.inc" + +#undef CFMS_DIAG_AXIS_INIT_ +#undef CFMS_DIAG_AXIS_INIT_BINDC_ +#undef CFMS_AXIS_DATA_KIND_ +#define CFMS_DIAG_AXIS_INIT_ cFMS_diag_axis_init_cdouble +#define CFMS_DIAG_AXIS_INIT_BINDC_ "cFMS_diag_axis_init_cdouble" +#define CFMS_AXIS_DATA_KIND_ c_double +#include "c_diag_axis_init.inc" diff --git a/c_diag_manager/include/c_diag_axis_init.inc b/c_diag_manager/include/c_diag_axis_init.inc new file mode 100644 index 0000000..1af2e92 --- /dev/null +++ b/c_diag_manager/include/c_diag_axis_init.inc @@ -0,0 +1,82 @@ +function CFMS_DIAG_AXIS_INIT_(name, naxis_data, axis_data, units, cart_name, long_name, direction, & + set_name, edges, aux, req, tile_count, domain_position, not_xy) bind(C, name=CFMS_DIAG_AXIS_INIT_BINDC_) + + implicit none + character(c_char), intent(in) :: name(NAME_LENGTH) + integer, intent(in) :: naxis_data + real(CFMS_AXIS_DATA_KIND_), intent(in) :: axis_data(naxis_data) + character(c_char), intent(in) :: units(NAME_LENGTH) + character(c_char), intent(in) :: cart_name(NAME_LENGTH) + character(c_char), intent(in), optional :: long_name(NAME_LENGTH) + character(c_char), intent(in), optional :: set_name(NAME_LENGTH) + integer, intent(in), optional :: direction + integer, intent(in), optional :: edges + character(c_char), intent(in), optional :: aux + character(c_char), intent(in), optional :: req + integer, intent(in), optional :: tile_count + integer, intent(in), optional :: domain_position + logical(c_bool), intent(in), optional :: not_xy + + type(FmsMppDomain2D), pointer :: domain + + character(NAME_LENGTH-1) :: name_f + character(NAME_LENGTH-1) :: units_f + character(NAME_LENGTH-1) :: cart_name_f + character(NAME_LENGTH-1) :: set_name_f + character(NAME_LENGTH-1) :: long_name_f + character(NAME_LENGTH-1) :: aux_f + character(NAME_LENGTH-1) :: req_f + + integer :: CFMS_DIAG_AXIS_INIT_ + + logical :: not_xy_f + + set_name_f = "" + aux_f = "none" + req_f = "none" + + name_f = fms_string_utils_c2f_string(name) + units_f = fms_string_utils_c2f_string(units) + cart_name_f = fms_string_utils_c2f_string(cart_name) + if(present(set_name)) set_name_f = fms_string_utils_c2f_string(set_name) + if(present(long_name)) long_name_f = fms_string_utils_c2f_string(long_name) + + domain => cFMS_get_current_domain() + + not_xy_f = .False. + if(present(not_xy)) not_xy_f = logical(not_xy) + + if(not_xy_f) then + CFMS_DIAG_AXIS_INIT_ = fms_diag_axis_init(name = name_f, & + array_data = axis_data, & + units = units_f, & + cart_name = cart_name_f, & + long_name = long_name_f, & + direction = direction, & + set_name = set_name_f, & + edges = edges, & + aux = aux, & + req = req, & + tile_count = tile_count, & + domain_position = domain_position) + else + CFMS_DIAG_AXIS_INIT_ = fms_diag_axis_init(name = name_f, & + array_data = axis_data, & + units = units_f, & + cart_name = cart_name_f, & + long_name = long_name_f, & + direction = direction, & + set_name = set_name_f, & + edges = edges, & + Domain2 = domain, & + aux = aux, & + req = req, & + tile_count = tile_count, & + domain_position = domain_position) + end if + nullify(domain) + + end function CFMS_DIAG_AXIS_INIT_ + + + diff --git a/c_diag_manager/include/c_register_diag_field.fh b/c_diag_manager/include/c_register_diag_field.fh new file mode 100644 index 0000000..899044e --- /dev/null +++ b/c_diag_manager/include/c_register_diag_field.fh @@ -0,0 +1,46 @@ +! integers +#undef CFMS_REGISTER_DIAG_FIELD_SCALAR_ +#undef CFMS_REGISTER_DIAG_FIELD_SCALAR_BINDC_ +#undef CFMS_REGISTER_DIAG_FIELD_SCALAR_TYPE_ +#define CFMS_REGISTER_DIAG_FIELD_SCALAR_ cFMS_register_diag_field_scalar_cint +#define CFMS_REGISTER_DIAG_FIELD_SCALAR_BINDC_ "cFMS_register_diag_field_scalar_cint" +#define CFMS_REGISTER_DIAG_FIELD_SCALAR_TYPE_ integer +#undef CFMS_REGISTER_DIAG_FIELD_ARRAY_ +#undef CFMS_REGISTER_DIAG_FIELD_ARRAY_BINDC_ +#undef CFMS_REGISTER_DIAG_FIELD_ARRAY_TYPE_ +#define CFMS_REGISTER_DIAG_FIELD_ARRAY_ cFMS_register_diag_field_array_cint +#define CFMS_REGISTER_DIAG_FIELD_ARRAY_BINDC_ "cFMS_register_diag_field_array_cint" +#define CFMS_REGISTER_DIAG_FIELD_ARRAY_TYPE_ integer +#include "c_register_diag_field.inc" + + +! cfloats +#undef CFMS_REGISTER_DIAG_FIELD_SCALAR_ +#undef CFMS_REGISTER_DIAG_FIELD_SCALAR_BINDC_ +#undef CFMS_REGISTER_DIAG_FIELD_SCALAR_TYPE_ +#define CFMS_REGISTER_DIAG_FIELD_SCALAR_ cFMS_register_diag_field_scalar_cfloat +#define CFMS_REGISTER_DIAG_FIELD_SCALAR_BINDC_ "cFMS_register_diag_field_scalar_cfloat" +#define CFMS_REGISTER_DIAG_FIELD_SCALAR_TYPE_ real(c_float) +#undef CFMS_REGISTER_DIAG_FIELD_ARRAY_ +#undef CFMS_REGISTER_DIAG_FIELD_ARRAY_BINDC_ +#undef CFMS_REGISTER_DIAG_FIELD_ARRAY_TYPE_ +#define CFMS_REGISTER_DIAG_FIELD_ARRAY_ cFMS_register_diag_field_array_cfloat +#define CFMS_REGISTER_DIAG_FIELD_ARRAY_BINDC_ "cFMS_register_diag_field_array_cfloat" +#define CFMS_REGISTER_DIAG_FIELD_ARRAY_TYPE_ real(c_float) +#include "c_register_diag_field.inc" + + +! cdoubles +#undef CFMS_REGISTER_DIAG_FIELD_SCALAR_ +#undef CFMS_REGISTER_DIAG_FIELD_SCALAR_BINDC_ +#undef CFMS_REGISTER_DIAG_FIELD_SCALAR_TYPE_ +#define CFMS_REGISTER_DIAG_FIELD_SCALAR_ cFMS_register_diag_field_scalar_cdouble +#define CFMS_REGISTER_DIAG_FIELD_SCALAR_BINDC_ "cFMS_register_diag_field_scalar_cdouble" +#define CFMS_REGISTER_DIAG_FIELD_SCALAR_TYPE_ real(c_double) +#undef CFMS_REGISTER_DIAG_FIELD_ARRAY_ +#undef CFMS_REGISTER_DIAG_FIELD_ARRAY_BINDC_ +#undef CFMS_REGISTER_DIAG_FIELD_ARRAY_TYPE_ +#define CFMS_REGISTER_DIAG_FIELD_ARRAY_ cFMS_register_diag_field_array_cdouble +#define CFMS_REGISTER_DIAG_FIELD_ARRAY_BINDC_ "cFMS_register_diag_field_array_cdouble" +#define CFMS_REGISTER_DIAG_FIELD_ARRAY_TYPE_ real(c_double) +#include "c_register_diag_field.inc" diff --git a/c_diag_manager/include/c_register_diag_field.inc b/c_diag_manager/include/c_register_diag_field.inc new file mode 100644 index 0000000..7b739c5 --- /dev/null +++ b/c_diag_manager/include/c_register_diag_field.inc @@ -0,0 +1,185 @@ +function CFMS_REGISTER_DIAG_FIELD_SCALAR_(module_name, field_name, long_name, units, & + missing_value, range, standard_name, do_not_log, err_msg, area, volume, realm, multiple_send_data) & + bind(C, name=CFMS_REGISTER_DIAG_FIELD_SCALAR_BINDC_) + + implicit none + character(c_char), intent(in) :: module_name(NAME_LENGTH) + character(c_char), intent(in) :: field_name(NAME_LENGTH) + character(c_char), intent(in), optional :: long_name(NAME_LENGTH) + character(c_char), intent(in), optional :: units(NAME_LENGTH) + character(c_char), intent(in), optional :: standard_name(NAME_LENGTH) + CFMS_REGISTER_DIAG_FIELD_SCALAR_TYPE_, intent(in), optional :: missing_value + CFMS_REGISTER_DIAG_FIELD_SCALAR_TYPE_, intent(in), optional :: range(2) + logical(c_bool), intent(in), optional :: do_not_log + character(c_char), intent(out), optional :: err_msg(NAME_LENGTH) + integer, intent(in), optional :: area + integer, intent(in), optional :: volume + character(c_char), intent(in), optional :: realm(NAME_LENGTH) + logical(c_bool), intent(in), optional :: multiple_send_data + + character(len=NAME_LENGTH-1) :: module_name_f = '' + character(len=NAME_LENGTH-1) :: field_name_f = '' + character(len=NAME_LENGTH-1) :: long_name_f = '' + character(len=NAME_LENGTH-1) :: standard_name_f = '' + character(len=NAME_LENGTH-1) :: units_f = '' + character(len=NAME_LENGTH-1) :: err_msg_f = '' + character(len=NAME_LENGTH-1) :: realm_f = '' + + logical :: do_not_log_f + logical :: multiple_send_data_f + integer :: CFMS_REGISTER_DIAG_FIELD_SCALAR_ + + module_name_f = '' + field_name_f = '' + long_name_f = '' + standard_name_f = '' + units_f = '' + err_msg_f = '' + realm_f = '' + + do_not_log_f = .False. + multiple_send_data_f = .False. + + if(present(do_not_log)) do_not_log_f = logical(do_not_log) + if(present(multiple_send_data)) multiple_send_data_f = logical(multiple_send_data) + + module_name_f = fms_string_utils_c2f_string(module_name) + field_name_f = fms_string_utils_c2f_string(field_name) + if(present(units)) units_f = fms_string_utils_c2f_string(units) + if(present(realm)) realm_f = fms_string_utils_c2f_string(realm) + if(present(long_name)) long_name_f = fms_string_utils_c2f_string(long_name) + if(present(standard_name)) standard_name_f = fms_string_utils_c2f_string(standard_name) + + CFMS_REGISTER_DIAG_FIELD_SCALAR_ = fms_diag_register_diag_field(module_name_f, & + field_name_f, & + init_time = field_init_time, & + long_name = long_name_f, & + units = units_f, & + missing_value = missing_value, & + range = range, & + standard_name = standard_name_f, & + do_not_log = do_not_log_f, & + err_msg = err_msg_f, & + area = area, & + volume = volume, & + realm = realm_f, & + multiple_send_data = multiple_send_data_f) + + field_curr_time(CFMS_REGISTER_DIAG_FIELD_SCALAR_) = field_init_time + + if(present(err_msg) .and. err_msg_f /= '') call fms_string_utils_f2c_string(err_msg, err_msg_f) + +end function CFMS_REGISTER_DIAG_FIELD_SCALAR_ + + +function CFMS_REGISTER_DIAG_FIELD_ARRAY_(module_name, field_name, axes, long_name, units, & + missing_value, range, mask_variant, standard_name, verbose, do_not_log, err_msg, interp_method, & + tile_count, area, volume, realm, multiple_send_data) bind(C, name=CFMS_REGISTER_DIAG_FIELD_ARRAY_BINDC_) + + implicit none + character(c_char), intent(in) :: module_name(NAME_LENGTH) + character(c_char), intent(in) :: field_name(NAME_LENGTH) + integer, intent(in), optional :: axes(5) + character(c_char), intent(in), optional :: long_name(NAME_LENGTH) + character(c_char), intent(in), optional :: units(NAME_LENGTH) + CFMS_REGISTER_DIAG_FIELD_ARRAY_TYPE_, intent(in), optional :: missing_value + CFMS_REGISTER_DIAG_FIELD_ARRAY_TYPE_, intent(in), optional :: range(2) + logical(c_bool), intent(in), optional :: mask_variant + character(c_char), intent(in), optional :: standard_name(NAME_LENGTH) + logical(c_bool), intent(in), optional :: verbose + logical(c_bool), intent(in), optional :: do_not_log + character(c_char), intent(out), optional :: err_msg(MESSAGE_LENGTH) + character(c_char), intent(in), optional :: interp_method(NAME_LENGTH) + integer, intent(in), optional :: tile_count + integer, intent(in), optional :: area + integer, intent(in), optional :: volume + character(c_char), intent(in), optional :: realm(NAME_LENGTH) + logical(c_bool), intent(in), optional :: multiple_send_data + + character(len=NAME_LENGTH-1) :: module_name_f + character(len=NAME_LENGTH-1) :: field_name_f + character(len=NAME_LENGTH-1) :: long_name_f + character(len=NAME_LENGTH-1) :: units_f + character(len=NAME_LENGTH-1) :: standard_name_f + character(len=NAME_LENGTH-1) :: err_msg_f + character(len=NAME_LENGTH-1) :: interp_method_f + character(len=NAME_LENGTH-1) :: realm_f + + logical :: mask_variant_f + logical :: verbose_f + logical :: do_not_log_f + logical :: multiple_send_data_f + integer :: naxes + + integer :: CFMS_REGISTER_DIAG_FIELD_ARRAY_ + + long_name_f = '' + units_f = '' + standard_name_f = '' + interp_method_f = '' + realm_f = '' + + mask_variant_f = .false. + verbose_f = .false. + do_not_log_f = .false. + multiple_send_data_f = .false. + + module_name_f = fms_string_utils_c2f_string(module_name) + field_name_f = fms_string_utils_c2f_string(field_name) + if(present(long_name)) long_name_f = fms_string_utils_c2f_string(long_name) + if(present(units)) units_f = fms_string_utils_c2f_string(units) + if(present(standard_name)) standard_name_f = fms_string_utils_c2f_string(standard_name) + if(present(interp_method)) interp_method_f = fms_string_utils_c2f_string(interp_method) + if(present(realm)) realm_f = fms_string_utils_c2f_string(realm) + + if(present(mask_variant)) mask_variant_f = logical(mask_variant) + if(present(verbose)) verbose_f = logical(verbose) + if(present(do_not_log)) do_not_log_f = logical(do_not_log) + if(present(multiple_send_data)) multiple_send_data_f = logical(multiple_send_data) + + if(present(axes)) then + naxes = 5 - count(axes<=0) + CFMS_REGISTER_DIAG_FIELD_ARRAY_ = fms_diag_register_diag_field(module_name = module_name_f, & + field_name = field_name_f, & + axes = axes(1:naxes), & + init_time = field_init_time, & + long_name = long_name_f, & + units = units_f, & + missing_value = missing_value, & + range = range, & + mask_variant = mask_variant_f, & + standard_name = standard_name_f, & + verbose = verbose_f, & + do_not_log = do_not_log_f, & + err_msg = err_msg_f, & + interp_method = interp_method_f, & + tile_count = tile_count, & + area = area, & + volume = volume, & + realm = realm_f, & + multiple_send_data = multiple_send_data_f) + else + CFMS_REGISTER_DIAG_FIELD_ARRAY_ = fms_diag_register_diag_field(module_name_f, & + field_name_f, & + axes, & + init_time = field_init_time, & + long_name = long_name_f, & + units = units_f, & + missing_value = missing_value, & + range = range, & + mask_variant = logical(mask_variant), & + standard_name = standard_name_f, & + verbose = logical(verbose), & + do_not_log = logical(do_not_log), & + err_msg = err_msg_f, & + interp_method = interp_method_f, & + tile_count = tile_count, & + area = area, & + volume = volume, & + realm = realm_f, & + multiple_send_data = logical(multiple_send_data)) + end if + + field_curr_time(CFMS_REGISTER_DIAG_FIELD_ARRAY_) = field_init_time + +end function CFMS_REGISTER_DIAG_FIELD_ARRAY_ diff --git a/c_diag_manager/include/c_send_data.fh b/c_diag_manager/include/c_send_data.fh new file mode 100644 index 0000000..90ff3a6 --- /dev/null +++ b/c_diag_manager/include/c_send_data.fh @@ -0,0 +1,148 @@ +!cints +#undef CFMS_DIAG_SEND_DATA_ +#undef CFMS_DIAG_SEND_DATA_BINDC_ +#undef CFMS_DIAG_SEND_DATA_FIELD_NDIM_ +#undef CFMS_DIAG_SEND_DATA_FIELD_TYPE_ +#undef CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ +#define CFMS_DIAG_SEND_DATA_ cFMS_diag_send_data_2d_cint +#define CFMS_DIAG_SEND_DATA_BINDC_ "cFMS_diag_send_data_2d_cint" +#define CFMS_DIAG_SEND_DATA_FIELD_NDIM_ 2 +#define CFMS_DIAG_SEND_DATA_FIELD_TYPE_ integer +#define CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ field_shape(1),field_shape(2) +#include "c_send_data.inc" + +#undef CFMS_DIAG_SEND_DATA_ +#undef CFMS_DIAG_SEND_DATA_BINDC_ +#undef CFMS_DIAG_SEND_DATA_FIELD_NDIM_ +#undef CFMS_DIAG_SEND_DATA_FIELD_TYPE_ +#undef CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ +#define CFMS_DIAG_SEND_DATA_ cFMS_diag_send_data_3d_cint +#define CFMS_DIAG_SEND_DATA_BINDC_ "cFMS_diag_send_data_3d_cint" +#define CFMS_DIAG_SEND_DATA_FIELD_NDIM_ 3 +#define CFMS_DIAG_SEND_DATA_FIELD_TYPE_ integer +#define CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ field_shape(1),field_shape(2),field_shape(3) +#include "c_send_data.inc" + +#undef CFMS_DIAG_SEND_DATA_ +#undef CFMS_DIAG_SEND_DATA_BINDC_ +#undef CFMS_DIAG_SEND_DATA_FIELD_NDIM_ +#undef CFMS_DIAG_SEND_DATA_FIELD_TYPE_ +#undef CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ +#define CFMS_DIAG_SEND_DATA_ cFMS_diag_send_data_4d_cint +#define CFMS_DIAG_SEND_DATA_BINDC_ "cFMS_diag_send_data_4d_cint" +#define CFMS_DIAG_SEND_DATA_FIELD_NDIM_ 4 +#define CFMS_DIAG_SEND_DATA_FIELD_TYPE_ integer +#define CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ field_shape(1),field_shape(2),field_shape(4) +#include "c_send_data.inc" + +#undef CFMS_DIAG_SEND_DATA_ +#undef CFMS_DIAG_SEND_DATA_BINDC_ +#undef CFMS_DIAG_SEND_DATA_FIELD_NDIM_ +#undef CFMS_DIAG_SEND_DATA_FIELD_TYPE_ +#undef CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ +#define CFMS_DIAG_SEND_DATA_ cFMS_diag_send_data_5d_cint +#define CFMS_DIAG_SEND_DATA_BINDC_ "cFMS_diag_send_data_5d_cint" +#define CFMS_DIAG_SEND_DATA_FIELD_NDIM_ 5 +#define CFMS_DIAG_SEND_DATA_FIELD_TYPE_ integer +#define CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ field_shape(1),field_shape(2),field_shape(4),field_shape(5) +#include "c_send_data.inc" + +!cdouble +#undef CFMS_DIAG_SEND_DATA_ +#undef CFMS_DIAG_SEND_DATA_BINDC_ +#undef CFMS_DIAG_SEND_DATA_FIELD_NDIM_ +#undef CFMS_DIAG_SEND_DATA_FIELD_TYPE_ +#undef CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ +#define CFMS_DIAG_SEND_DATA_ cFMS_diag_send_data_2d_cfloat +#define CFMS_DIAG_SEND_DATA_BINDC_ "cFMS_diag_send_data_2d_cfloat" +#define CFMS_DIAG_SEND_DATA_FIELD_NDIM_ 2 +#define CFMS_DIAG_SEND_DATA_FIELD_TYPE_ real(c_float) +#define CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ field_shape(1),field_shape(2) +#include "c_send_data.inc" + +#undef CFMS_DIAG_SEND_DATA_ +#undef CFMS_DIAG_SEND_DATA_BINDC_ +#undef CFMS_DIAG_SEND_DATA_FIELD_NDIM_ +#undef CFMS_DIAG_SEND_DATA_FIELD_TYPE_ +#undef CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ +#define CFMS_DIAG_SEND_DATA_ cFMS_diag_send_data_3d_cfloat +#define CFMS_DIAG_SEND_DATA_BINDC_ "cFMS_diag_send_data_3d_cfloat" +#define CFMS_DIAG_SEND_DATA_FIELD_NDIM_ 3 +#define CFMS_DIAG_SEND_DATA_FIELD_TYPE_ real(c_float) +#define CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ field_shape(1),field_shape(2),field_shape(3) +#include "c_send_data.inc" + +#undef CFMS_DIAG_SEND_DATA_ +#undef CFMS_DIAG_SEND_DATA_BINDC_ +#undef CFMS_DIAG_SEND_DATA_FIELD_NDIM_ +#undef CFMS_DIAG_SEND_DATA_FIELD_TYPE_ +#undef CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ +#define CFMS_DIAG_SEND_DATA_ cFMS_diag_send_data_4d_cfloat +#define CFMS_DIAG_SEND_DATA_BINDC_ "cFMS_diag_send_data_4d_cfloat" +#define CFMS_DIAG_SEND_DATA_FIELD_NDIM_ 4 +#define CFMS_DIAG_SEND_DATA_FIELD_TYPE_ real(c_float) +#define CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ field_shape(1),field_shape(2),field_shape(4) +#include "c_send_data.inc" + +#undef CFMS_DIAG_SEND_DATA_ +#undef CFMS_DIAG_SEND_DATA_BINDC_ +#undef CFMS_DIAG_SEND_DATA_FIELD_NDIM_ +#undef CFMS_DIAG_SEND_DATA_FIELD_TYPE_ +#undef CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ +#define CFMS_DIAG_SEND_DATA_ cFMS_diag_send_data_5d_cfloat +#define CFMS_DIAG_SEND_DATA_BINDC_ "cFMS_diag_send_data_5d_cfloat" +#define CFMS_DIAG_SEND_DATA_FIELD_NDIM_ 5 +#define CFMS_DIAG_SEND_DATA_FIELD_TYPE_ real(c_float) +#define CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ field_shape(1),field_shape(2),field_shape(4),field_shape(5) +#include "c_send_data.inc" + + +!cdoubles +#undef CFMS_DIAG_SEND_DATA_ +#undef CFMS_DIAG_SEND_DATA_BINDC_ +#undef CFMS_DIAG_SEND_DATA_FIELD_NDIM_ +#undef CFMS_DIAG_SEND_DATA_FIELD_TYPE_ +#undef CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ +#define CFMS_DIAG_SEND_DATA_ cFMS_diag_send_data_2d_cdouble +#define CFMS_DIAG_SEND_DATA_BINDC_ "cFMS_diag_send_data_2d_cdouble" +#define CFMS_DIAG_SEND_DATA_FIELD_NDIM_ 2 +#define CFMS_DIAG_SEND_DATA_FIELD_TYPE_ real(c_double) +#define CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ field_shape(1),field_shape(2) +#include "c_send_data.inc" + +#undef CFMS_DIAG_SEND_DATA_ +#undef CFMS_DIAG_SEND_DATA_BINDC_ +#undef CFMS_DIAG_SEND_DATA_FIELD_NDIM_ +#undef CFMS_DIAG_SEND_DATA_FIELD_TYPE_ +#undef CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ +#define CFMS_DIAG_SEND_DATA_ cFMS_diag_send_data_3d_cdouble +#define CFMS_DIAG_SEND_DATA_BINDC_ "cFMS_diag_send_data_3d_cdouble" +#define CFMS_DIAG_SEND_DATA_FIELD_NDIM_ 3 +#define CFMS_DIAG_SEND_DATA_FIELD_TYPE_ real(c_double) +#define CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ field_shape(1),field_shape(2),field_shape(3) +#include "c_send_data.inc" + +#undef CFMS_DIAG_SEND_DATA_ +#undef CFMS_DIAG_SEND_DATA_BINDC_ +#undef CFMS_DIAG_SEND_DATA_FIELD_NDIM_ +#undef CFMS_DIAG_SEND_DATA_FIELD_TYPE_ +#undef CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ +#define CFMS_DIAG_SEND_DATA_ cFMS_diag_send_data_4d_cdouble +#define CFMS_DIAG_SEND_DATA_BINDC_ "cFMS_diag_send_data_4d_cdouble" +#define CFMS_DIAG_SEND_DATA_FIELD_NDIM_ 4 +#define CFMS_DIAG_SEND_DATA_FIELD_TYPE_ real(c_double) +#define CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ field_shape(1),field_shape(2),field_shape(4) +#include "c_send_data.inc" + +#undef CFMS_DIAG_SEND_DATA_ +#undef CFMS_DIAG_SEND_DATA_BINDC_ +#undef CFMS_DIAG_SEND_DATA_FIELD_NDIM_ +#undef CFMS_DIAG_SEND_DATA_FIELD_TYPE_ +#undef CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ +#define CFMS_DIAG_SEND_DATA_ cFMS_diag_send_data_5d_cdouble +#define CFMS_DIAG_SEND_DATA_BINDC_ "cFMS_diag_send_data_5d_cdouble" +#define CFMS_DIAG_SEND_DATA_FIELD_NDIM_ 5 +#define CFMS_DIAG_SEND_DATA_FIELD_TYPE_ real(c_double) +#define CFMS_DIAG_SEND_DATA_FIELD_SHAPE_ field_shape(1),field_shape(2),field_shape(4),field_shape(5) +#include "c_send_data.inc" + diff --git a/c_diag_manager/include/c_send_data.inc b/c_diag_manager/include/c_send_data.inc new file mode 100644 index 0000000..f787246 --- /dev/null +++ b/c_diag_manager/include/c_send_data.inc @@ -0,0 +1,26 @@ +function CFMS_DIAG_SEND_DATA_(diag_field_id, field_shape, field_ptr, err_msg) bind(C, name=CFMS_DIAG_SEND_DATA_BINDC_) + + implicit none + + integer, intent(in) :: diag_field_id + integer, intent(in) :: field_shape(CFMS_DIAG_SEND_DATA_FIELD_NDIM_) + type(c_ptr), value, intent(in) :: field_ptr + character(c_bool), intent(out), optional :: err_msg(MESSAGE_LENGTH) + + character(MESSAGE_LENGTH-1) :: err_msg_f + logical(c_bool) :: CFMS_DIAG_SEND_DATA_ + + CFMS_DIAG_SEND_DATA_FIELD_TYPE_ :: field(CFMS_DIAG_SEND_DATA_FIELD_SHAPE_) + + call cFMS_pointer_to_array(field_ptr, field_shape, field) + + CFMS_DIAG_SEND_DATA_ = fms_diag_send_data(diag_field_id = diag_field_id, & + field = field, & + time = field_curr_time(diag_field_id), & + err_msg = err_msg_f) + + CFMS_DIAG_SEND_DATA_ = logical(CFMS_DIAG_SEND_DATA_, kind=c_bool) + + if(present(err_msg) .and. err_msg_f /= '' ) call fms_string_utils_f2c_string(err_msg, err_msg_f) + +end function CFMS_DIAG_SEND_DATA_ diff --git a/c_fms/c_fms.F90 b/c_fms/c_fms.F90 index 652094d..55aa4ac 100644 --- a/c_fms/c_fms.F90 +++ b/c_fms/c_fms.F90 @@ -54,10 +54,12 @@ module c_fms_mod public :: cFMS_define_nest_domains public :: cFMS_domain_is_initialized public :: cFMS_get_compute_domain + public :: cFMS_get_current_domain public :: cFMS_get_data_domain public :: cFMS_get_domain_name public :: cFMS_get_layout public :: cFMS_set_compute_domain + public :: cFMS_set_current_domain public :: cFMS_set_data_domain public :: cFMS_set_global_domain @@ -409,6 +411,12 @@ subroutine cFMS_get_compute_domain(domain_id, xbegin, xend, ybegin, yend, xsize, end subroutine cFMS_get_compute_domain + function cFMS_get_current_domain() + implicit none + type(FmsMppDomain2D), pointer :: cFMS_get_current_domain + cFMS_get_current_domain => current_domain + end function cFMS_get_current_domain + !> cFMS_get_data_domain subroutine cFMS_get_data_domain(domain_id, xbegin, xend, ybegin, yend, xsize, xmax_size, ysize, ymax_size, & x_is_global, y_is_global, tile_count, position, whalo, shalo) bind(C, name="cFMS_get_data_domain") @@ -541,7 +549,7 @@ end subroutine cFMS_set_compute_domain !> cFMS_set_current_domain sets the domain to the current_domain where the !! current_domain has id=domain_id - subroutine cFMS_set_current_domain(domain_id) + subroutine cFMS_set_current_domain(domain_id) bind(C, name="cFMS_set_current_domain") implicit none integer, intent(in), optional :: domain_id diff --git a/c_fms/c_fms.h b/c_fms/c_fms.h index 09c0905..cdeadeb 100644 --- a/c_fms/c_fms.h +++ b/c_fms/c_fms.h @@ -91,6 +91,8 @@ extern void cFMS_set_compute_domain(int *domain_id, int *xbegin, int *xend, int int *xsize, int *ysize, bool *x_is_global, bool *y_is_global, int *tile_count, int *whalo, int *shalo); +extern void cFMS_set_current_domain(int *domain_id); + extern void cFMS_set_data_domain(int *domain_id, int *xbegin, int *xend, int *ybegin, int *yend, int *xsize, int *ysize, bool *x_is_global, bool *y_is_global, int *tile_count, int *whalo, int *shalo); diff --git a/configure.ac b/configure.ac index 25362d1..421b866 100644 --- a/configure.ac +++ b/configure.ac @@ -357,12 +357,14 @@ AC_CONFIG_FILES([ c_fms/Makefile c_fms_utils/Makefile c_constants/Makefile + c_diag_manager/Makefile c_grid_utils/Makefile c_horiz_interp/Makefile libcFMS/Makefile test_cfms/test-lib.sh test_cfms/intel_coverage.sh test_cfms/Makefile + test_cfms/c_diag_manager/Makefile test_cfms/c_fms/Makefile test_cfms/c_fms_utils/Makefile test_cfms/c_grid_utils/Makefile diff --git a/libcFMS/Makefile.am b/libcFMS/Makefile.am index b153950..accda37 100644 --- a/libcFMS/Makefile.am +++ b/libcFMS/Makefile.am @@ -33,6 +33,7 @@ libcFMS_la_LDFLAGS = -version-info 21:0:0 # Add the convenience libraries to the FMS library. libcFMS_la_LIBADD = $(top_builddir)/c_fms/lib_c_fms.la libcFMS_la_LIBADD += $(top_builddir)/c_constants/lib_c_constants.la +libcFMS_la_LIBADD += $(top_builddir)/c_diag_manager/lib_c_diag_manager.la libcFMS_la_LIBADD += $(top_builddir)/c_horiz_interp/lib_c_horiz_interp.la libcFMS_la_LIBADD += $(top_builddir)/c_grid_utils/lib_c_grid_utils.la libcFMS_la_LIBADD += $(top_builddir)/c_fms_utils/lib_c_fms_utils.la diff --git a/test_cfms/Makefile.am b/test_cfms/Makefile.am index db42f52..598faa4 100644 --- a/test_cfms/Makefile.am +++ b/test_cfms/Makefile.am @@ -24,7 +24,7 @@ ACLOCAL_AMFLAGS = -I m4 # Make targets will be run in each subdirectory. Order is significant. -SUBDIRS = c_fms c_fms_utils c_grid_utils c_horiz_interp +SUBDIRS = c_diag_manager c_fms c_fms_utils c_grid_utils c_horiz_interp # testing utility scripts to distribute EXTRA_DIST = test-lib.sh.in intel_coverage.sh.in tap-driver.sh diff --git a/test_cfms/c_diag_manager/Makefile.am b/test_cfms/c_diag_manager/Makefile.am new file mode 100644 index 0000000..34aca0f --- /dev/null +++ b/test_cfms/c_diag_manager/Makefile.am @@ -0,0 +1,43 @@ +#*********************************************************************** +#* 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 . +#*********************************************************************** +# + +# Find the needed mod and .inc files. +AM_CPPFLAGS = -I. -I$(MODDIR) -I${top_builddir}/c_diag_manager \ + -I${top_builddir}/c_fms -I${top_builddir}/test_cfms/c_fms + +# Link to the FMS library. +LDADD = ${top_builddir}/libcFMS/libcFMS.la + +check_PROGRAMS = test_send_data + +TESTS = test_send_data.sh + +test_send_data_SOURCES = ../c_fms/c_mpp_domains_helper.c test_send_data.c + +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_send_data.sh + +# Clean up +CLEANFILES = input.nml *.out *.dpi *.spi *.dyn *.spl *_table* input* *trs #*.nc* + diff --git a/test_cfms/c_diag_manager/test_send_data.c b/test_cfms/c_diag_manager/test_send_data.c new file mode 100644 index 0000000..192cbda --- /dev/null +++ b/test_cfms/c_diag_manager/test_send_data.c @@ -0,0 +1,203 @@ +#include +#include +#include +#include +#include +#include + +#define NX 8 +#define NY 8 +#define NZ 2 + +void set_domain(int *domain_id); + +int main() +{ + + int domain_id = 0; + int id_x, id_y, id_z; + + int id_var3; + int var3_shape[3] = {NX, NY, NZ}; + float *var3; + + var3 = (float *)malloc(NX*NY*NZ*sizeof(float)); + int ijk = 0; + for(int i=0; i. +#*********************************************************************** +# 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 +cat < input.nml +&diag_manager_nml + use_modern_diag = .true. +/ +EOF + +#from test_fms/test_diag_manager2.sh +cat < diag_table.yaml +title: test_diag_manager +base_date: 2 1 1 1 1 1 + +diag_files: +- file_name: test + freq: 1 hours + time_units: hours + unlimdim: time + varlist: + - module: atm_mod + var_name: var_3d + reduction: average + kind: r4 + output_name: var3_avg +EOF + +test_expect_success "cdiag_manager" 'mpirun -n 1 ./test_send_data' +test_done + From 6add3bb475dd775c9880738e72f6001ce2d754be Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 18 Mar 2025 11:24:40 -0400 Subject: [PATCH 03/18] add 2d test --- test_cfms/c_diag_manager/Makefile.am | 11 +- test_cfms/c_diag_manager/test_send_data_2d.c | 174 ++++++++++++++++++ test_cfms/c_diag_manager/test_send_data_2d.sh | 53 ++++++ .../{test_send_data.c => test_send_data_3d.c} | 1 - ...test_send_data.sh => test_send_data_3d.sh} | 4 +- 5 files changed, 235 insertions(+), 8 deletions(-) create mode 100644 test_cfms/c_diag_manager/test_send_data_2d.c create mode 100755 test_cfms/c_diag_manager/test_send_data_2d.sh rename test_cfms/c_diag_manager/{test_send_data.c => test_send_data_3d.c} (98%) rename test_cfms/c_diag_manager/{test_send_data.sh => test_send_data_3d.sh} (94%) diff --git a/test_cfms/c_diag_manager/Makefile.am b/test_cfms/c_diag_manager/Makefile.am index 34aca0f..efe523f 100644 --- a/test_cfms/c_diag_manager/Makefile.am +++ b/test_cfms/c_diag_manager/Makefile.am @@ -25,19 +25,20 @@ AM_CPPFLAGS = -I. -I$(MODDIR) -I${top_builddir}/c_diag_manager \ # Link to the FMS library. LDADD = ${top_builddir}/libcFMS/libcFMS.la -check_PROGRAMS = test_send_data +check_PROGRAMS = test_send_data_3d test_send_data_2d -TESTS = test_send_data.sh +TESTS = test_send_data_3d.sh test_send_data_2d.sh -test_send_data_SOURCES = ../c_fms/c_mpp_domains_helper.c test_send_data.c +test_send_data_3d_SOURCES = ../c_fms/c_mpp_domains_helper.c test_send_data_3d.c +test_send_data_2d_SOURCES = ../c_fms/c_mpp_domains_helper.c test_send_data_2d.c 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_send_data.sh +EXTRA_DIST = test_send_data_3d.sh test_send_data_2d.sh # Clean up -CLEANFILES = input.nml *.out *.dpi *.spi *.dyn *.spl *_table* input* *trs #*.nc* +CLEANFILES = input.nml *.out *.dpi *.spi *.dyn *.spl *_table* input* *trs *.nc* diff --git a/test_cfms/c_diag_manager/test_send_data_2d.c b/test_cfms/c_diag_manager/test_send_data_2d.c new file mode 100644 index 0000000..4c3a32d --- /dev/null +++ b/test_cfms/c_diag_manager/test_send_data_2d.c @@ -0,0 +1,174 @@ +#include +#include +#include +#include +#include +#include + +#define NX 8 +#define NY 8 + +void set_domain(int *domain_id); + +int main() +{ + + int domain_id = 0; + int id_x, id_y; + + int id_var2; + int var2_shape[2] = {NX, NY}; + float *var2; + + var2 = (float *)malloc(NX*NY*sizeof(float)); + int ij = 0; + for(int i=0; i. +#*********************************************************************** +# 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 +cat < input.nml +&diag_manager_nml + use_modern_diag = .true. +/ +EOF + +#from test_fms/test_diag_manager2.sh +cat < diag_table.yaml +title: test_diag_manager +base_date: 2 1 1 1 1 1 + +diag_files: +- file_name: test_2d + freq: 1 hours + time_units: hours + unlimdim: time + varlist: + - module: atm_mod + var_name: var_2d + reduction: average + kind: r4 + output_name: var2_avg +EOF + +test_expect_success "cdiag_manager 2d" 'mpirun -n 1 ./test_send_data_2d' +test_done + diff --git a/test_cfms/c_diag_manager/test_send_data.c b/test_cfms/c_diag_manager/test_send_data_3d.c similarity index 98% rename from test_cfms/c_diag_manager/test_send_data.c rename to test_cfms/c_diag_manager/test_send_data_3d.c index 192cbda..a5cd7ca 100644 --- a/test_cfms/c_diag_manager/test_send_data.c +++ b/test_cfms/c_diag_manager/test_send_data_3d.c @@ -178,7 +178,6 @@ int main() } // send_data - cFMS_diag_send_data_3d_cfloat(&id_var3, var3_shape, var3, NULL); for(int itime=0; itime<24; itime++) { int ijk = 0; for(int i=0; i Date: Tue, 18 Mar 2025 11:35:00 -0400 Subject: [PATCH 04/18] add with-yaml to fms build --- .github/workflows/test.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/test.sh b/.github/workflows/test.sh index fad5ecd..4c12bc0 100755 --- a/.github/workflows/test.sh +++ b/.github/workflows/test.sh @@ -9,7 +9,7 @@ cd FMS autoreconf -iv export FCFLAGS="$FCFLAGS -fPIC" export CFLAGS="$CFLAGS -fPIC" -./configure --enable-portable-kinds --prefix=$install_fms +./configure --enable-portable-kinds --with-yaml --prefix=$install_fms make install cd $curr_dir From 725a6311b81cd0e0e8cef13d0ccceeeb377ef33f Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 18 Mar 2025 11:41:18 -0400 Subject: [PATCH 05/18] add untracked file --- c_diag_manager/c_diag_manager.h | 85 +++++++++++++++++++++++++++++++++ 1 file changed, 85 insertions(+) create mode 100644 c_diag_manager/c_diag_manager.h diff --git a/c_diag_manager/c_diag_manager.h b/c_diag_manager/c_diag_manager.h new file mode 100644 index 0000000..0aa6dcf --- /dev/null +++ b/c_diag_manager/c_diag_manager.h @@ -0,0 +1,85 @@ +#ifndef CDIAG_MANAGER_H +#define CDIAG_MANAGER_H + +#include + +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 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, + char *req, int *tile_count, int *domain_position, bool *not_xy); + +extern int cFMS_diag_axis_init_cdouble(char *name, int *naxis_data, double *axis_data, char *units, char *cart_name, + char *long_name, int *direction, char *set_name, int *edges, char *aux, + char *req, int *tile_count, int *domain_position, bool *not_xy); + +extern void cFMS_diag_end(); + +extern void cFMS_diag_send_complete(int *diag_field_id, char *err_msg); + +extern void cFMS_diag_set_field_init_time(int *year, int *month, int *day, int *hour, int *minute, int *second, + int *tick, char *err_msg); + +extern void cFMS_diag_set_field_timestep(int *diag_field_id, int *dseconds, int *ddays, int *dticks, char *err_msg); + +extern void cFMS_diag_advance_field_time(int *diag_field_id); + +extern void cFMS_diag_set_time_end(int *year, int *month, int *day, int *hour, int *minute, int *second, + int *tick, char *err_msg); + +extern int cFMS_register_diag_field_scalar_int(char *module_name, char *field_name, char *long_name, + char *units, int *missing_value, int *range, + char *standard_name, bool *do_not_log, char *err_msg, + int *area, int *volume, char *realm, bool *multiple_send_data); + +extern int cFMS_register_diag_field_scalar_cfloat(char *module_name, char *field_name, char *long_name, + char *units, float *missing_value, float *range, + char *standard_name, bool *do_not_log, char *err_msg, + int *area, int *volume, char *realm, bool *multiple_send_data); + +extern int cFMS_register_diag_field_scalar_cdouble(char *module_name, char *field_name, char *long_name, + char *units, double *missing_value, double *range, + char *standard_name, bool *do_not_log, char *err_msg, + int *area, int *volume, char *realm, bool *multiple_send_data); + +extern int cFMS_register_diag_field_array_cint(char *module_name, char *field_name, int *axes, char *long_name, + char *units, int *missing_value, int *range, bool *mask_variant, + char *standard_name, bool *verbose, bool *do_not_log, char *err_msg, + char *interp_method, int *tile_count, int *area, int *volume, + char *realm, bool *multiple_send_data); + +extern int cFMS_register_diag_field_array_cfloat(char *module_name, char *field_name, int *axes, char *long_name, + char *units, float *missing_value, float *range, bool *mask_variant, + char *standard_name, bool *verbose, bool *do_not_log, char *err_msg, + char *interp_method, int *tile_count, int *area, int *volume, + char *realm, bool *multiple_send_data); + +extern int cFMS_register_diag_field_array_cdouble(char *module_name, char *field_name, int *axes, char *long_name, + char *units, double *missing_value, double *range, bool *mask_variant, + char *standard_name, bool *verbose, bool *do_not_log, char *err_msg, + char *interp_method, int *tile_count, int *area, int *volume, + char *realm, bool *multiple_send_data); + +extern bool cFMS_diag_send_data_2d_cint(int *diag_field_id, int *field_shape, int *field, char *err_msg); +extern bool cFMS_diag_send_data_3d_cint(int *diag_field_id, int *field_shape, int *field, char *err_msg); +extern bool cFMS_diag_send_data_4d_cint(int *diag_field_id, int *field_shape, int *field, char *err_msg); +extern bool cFMS_diag_send_data_5d_cint(int *diag_field_id, int *field_shape, int *field, char *err_msg); +extern bool cFMS_diag_send_data_2d_cfloat(int *diag_field_id, int *field_shape, float *field, char *err_msg); +extern bool cFMS_diag_send_data_3d_cfloat(int *diag_field_id, int *field_shape, float *field, char *err_msg); +extern bool cFMS_diag_send_data_4d_cfloat(int *diag_field_id, int *field_shape, float *field, char *err_msg); +extern bool cFMS_diag_send_data_5d_cfloat(int *diag_field_id, int *field_shape, float *field, char *err_msg); +extern bool cFMS_diag_send_data_2d_cdouble(int *diag_field_id, int *field_shape, double *field, char *err_msg); +extern bool cFMS_diag_send_data_3d_cdouble(int *diag_field_id, int *field_shape, double *field, char *err_msg); +extern bool cFMS_diag_send_data_4d_cdouble(int *diag_field_id, int *field_shape, double *field, char *err_msg); +extern bool cFMS_diag_send_data_5d_cdouble(int *diag_field_id, int *field_shape, double *field, char *err_msg); + +#endif From cf3246e9d6c1556e761f35bda073b13c248904b0 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 18 Mar 2025 11:45:10 -0400 Subject: [PATCH 06/18] add TODO comments to tests --- test_cfms/c_diag_manager/test_send_data_2d.c | 2 ++ test_cfms/c_diag_manager/test_send_data_3d.c | 2 ++ 2 files changed, 4 insertions(+) diff --git a/test_cfms/c_diag_manager/test_send_data_2d.c b/test_cfms/c_diag_manager/test_send_data_2d.c index 4c3a32d..1198e24 100644 --- a/test_cfms/c_diag_manager/test_send_data_2d.c +++ b/test_cfms/c_diag_manager/test_send_data_2d.c @@ -10,6 +10,8 @@ void set_domain(int *domain_id); +//TODO: add reading in the outputted file for correctness +//Currently, answers have been checked separately/manually for correctness int main() { diff --git a/test_cfms/c_diag_manager/test_send_data_3d.c b/test_cfms/c_diag_manager/test_send_data_3d.c index a5cd7ca..645fe83 100644 --- a/test_cfms/c_diag_manager/test_send_data_3d.c +++ b/test_cfms/c_diag_manager/test_send_data_3d.c @@ -11,6 +11,8 @@ void set_domain(int *domain_id); +//TODO: add reading in the outputted file for correctness +//Currently, answers have been checked separately/manually for correctness int main() { From 03d080510ad8d89b359b1b50e84ff4a1e2a9c8b9 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 18 Mar 2025 12:15:58 -0400 Subject: [PATCH 07/18] combine 2d and 3d test --- test_cfms/c_diag_manager/Makefile.am | 9 +- .../{test_send_data_3d.c => test_send_data.c} | 68 ++++++- ...test_send_data_2d.sh => test_send_data.sh} | 9 +- test_cfms/c_diag_manager/test_send_data_2d.c | 176 ------------------ test_cfms/c_diag_manager/test_send_data_3d.sh | 53 ------ 5 files changed, 77 insertions(+), 238 deletions(-) rename test_cfms/c_diag_manager/{test_send_data_3d.c => test_send_data.c} (74%) rename test_cfms/c_diag_manager/{test_send_data_2d.sh => test_send_data.sh} (87%) delete mode 100644 test_cfms/c_diag_manager/test_send_data_2d.c delete mode 100755 test_cfms/c_diag_manager/test_send_data_3d.sh diff --git a/test_cfms/c_diag_manager/Makefile.am b/test_cfms/c_diag_manager/Makefile.am index efe523f..d9a2def 100644 --- a/test_cfms/c_diag_manager/Makefile.am +++ b/test_cfms/c_diag_manager/Makefile.am @@ -25,19 +25,18 @@ AM_CPPFLAGS = -I. -I$(MODDIR) -I${top_builddir}/c_diag_manager \ # Link to the FMS library. LDADD = ${top_builddir}/libcFMS/libcFMS.la -check_PROGRAMS = test_send_data_3d test_send_data_2d +check_PROGRAMS = test_send_data -TESTS = test_send_data_3d.sh test_send_data_2d.sh +TESTS = test_send_data.sh -test_send_data_3d_SOURCES = ../c_fms/c_mpp_domains_helper.c test_send_data_3d.c -test_send_data_2d_SOURCES = ../c_fms/c_mpp_domains_helper.c test_send_data_2d.c +test_send_data_SOURCES = ../c_fms/c_mpp_domains_helper.c test_send_data.c 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_send_data_3d.sh test_send_data_2d.sh +EXTRA_DIST = test_send_data.sh # Clean up CLEANFILES = input.nml *.out *.dpi *.spi *.dyn *.spl *_table* input* *trs *.nc* diff --git a/test_cfms/c_diag_manager/test_send_data_3d.c b/test_cfms/c_diag_manager/test_send_data.c similarity index 74% rename from test_cfms/c_diag_manager/test_send_data_3d.c rename to test_cfms/c_diag_manager/test_send_data.c index 645fe83..e53a244 100644 --- a/test_cfms/c_diag_manager/test_send_data_3d.c +++ b/test_cfms/c_diag_manager/test_send_data.c @@ -22,7 +22,11 @@ int main() int id_var3; int var3_shape[3] = {NX, NY, NZ}; float *var3; - + + int id_var2; + int var2_shape[2] = {NX, NY}; + float *var2; + var3 = (float *)malloc(NX*NY*NZ*sizeof(float)); int ijk = 0; for(int i=0; i -#include -#include -#include -#include -#include - -#define NX 8 -#define NY 8 - -void set_domain(int *domain_id); - -//TODO: add reading in the outputted file for correctness -//Currently, answers have been checked separately/manually for correctness -int main() -{ - - int domain_id = 0; - int id_x, id_y; - - int id_var2; - int var2_shape[2] = {NX, NY}; - float *var2; - - var2 = (float *)malloc(NX*NY*sizeof(float)); - int ij = 0; - for(int i=0; i. -#*********************************************************************** -# 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 -cat < input.nml -&diag_manager_nml - use_modern_diag = .true. -/ -EOF - -#from test_fms/test_diag_manager2.sh -cat < diag_table.yaml -title: test_diag_manager -base_date: 2 1 1 1 1 1 - -diag_files: -- file_name: test_3d - freq: 1 hours - time_units: hours - unlimdim: time - varlist: - - module: atm_mod - var_name: var_3d - reduction: average - kind: r4 - output_name: var3_avg -EOF - -test_expect_success "cdiag_manager 3d" 'mpirun -n 1 ./test_send_data_3d' -test_done - From a2b22aed0343aeb5cd919a879e59c4103e8dcd46 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 18 Mar 2025 13:22:13 -0400 Subject: [PATCH 08/18] data_override_init --- Makefile.am | 1 + c_data_override/Makefile.am | 44 +++++++++++++++ c_data_override/c_data_override.F90 | 44 +++++++++++++++ c_data_override/c_data_override.h | 10 ++++ c_fms/c_fms.F90 | 12 +++- configure.ac | 2 + libcFMS/Makefile.am | 1 + test_cfms/Makefile.am | 2 +- test_cfms/c_data_override/Makefile.am | 43 +++++++++++++++ .../c_data_override/test_data_override.c | 55 +++++++++++++++++++ .../c_data_override/test_data_override.sh | 31 +++++++++++ 11 files changed, 242 insertions(+), 3 deletions(-) create mode 100644 c_data_override/Makefile.am create mode 100644 c_data_override/c_data_override.F90 create mode 100644 c_data_override/c_data_override.h create mode 100644 test_cfms/c_data_override/Makefile.am create mode 100644 test_cfms/c_data_override/test_data_override.c create mode 100755 test_cfms/c_data_override/test_data_override.sh diff --git a/Makefile.am b/Makefile.am index 17aeefc..09c54a3 100644 --- a/Makefile.am +++ b/Makefile.am @@ -35,6 +35,7 @@ endif SUBDIRS = c_fms \ c_fms_utils \ c_constants \ + c_data_override \ c_diag_manager \ c_grid_utils \ c_horiz_interp \ diff --git a/c_data_override/Makefile.am b/c_data_override/Makefile.am new file mode 100644 index 0000000..38b02b7 --- /dev/null +++ b/c_data_override/Makefile.am @@ -0,0 +1,44 @@ +#*********************************************************************** +#* 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 an automake file for the fms directory of the FMS +# package. + +# Ed Hartnett 2/22/19 + +# Include .h and .mod files. +AM_CPPFLAGS = -I. -I./include +AM_FCFLAGS = $(FC_MODINC). $(FC_MODOUT)$(MODDIR) + +# Build these uninstalled convenience libraries. +noinst_LTLIBRARIES = lib_c_data_override.la + +# Each convenience library depends on its source. +lib_c_data_override_la_SOURCES = c_data_override.F90 + +c_data_override_mod.mod : c_data_override.F90 + +# Mod files are built and then installed as headers. +MODFILES = c_data_override_mod.mod +BUILT_SOURCES = $(MODFILES) +nodist_include_HEADERS = $(FMS_INC_FILES) $(MODFILES) + +include_HEADERS = c_data_override.h + +include $(top_srcdir)/mkmods.mk diff --git a/c_data_override/c_data_override.F90 b/c_data_override/c_data_override.F90 new file mode 100644 index 0000000..ed7d1c6 --- /dev/null +++ b/c_data_override/c_data_override.F90 @@ -0,0 +1,44 @@ +module c_data_override_mod + + use FMS, only: FmsMppDomain2D, FATAL, fms_mpp_error + use FMS, only: fms_data_override_init + + use c_fms_mod, only : cFMS_get_domain_from_id + + use iso_c_binding + implicit none + + private + public :: cFMS_data_override_init + + integer, public, bind(C, name="CFLOAT_MODE") :: CFLOAT_MODE = c_float + integer, public, bind(C, name="CDOUBLE_MODE") :: CDOUBLE_MODE = c_double + +contains + + subroutine cFMS_data_override_init(atm_domain_id, ocn_domain_id, ice_domain_id, land_domain_id, & + land_domainUG_id, mode) bind(C, name="cFMS_data_override_init") + + implicit none + integer, intent(in), optional :: atm_domain_id + integer, intent(in), optional :: ocn_domain_id + integer, intent(in), optional :: ice_domain_id + integer, intent(in), optional :: land_domain_id + integer, intent(in), optional :: land_domainUG_id + integer, intent(in), optional :: mode + + type(FmsMppDomain2D), pointer :: atm_domain + + if(present(ocn_domain_id)) call fms_mpp_error(FATAL, "ocn_domain will be implemented in the near future") + if(present(ice_domain_id)) call fms_mpp_error(FATAL, "ice_domain will be implemented in the near future") + if(present(land_domain_id)) call fms_mpp_error(FATAL, "land_domain will be implemented in the near future") + if(present(land_domainUG_id)) call fms_mpp_error(FATAL, "land unstructured domain will be implemented in the near future") + + if(present(atm_domain_id)) atm_domain => cFMS_get_domain_from_id(atm_domain_id) + + call fms_data_override_init(atm_domain_in = atm_domain,& + mode = mode) + + end subroutine cFMS_data_override_init + +end module c_data_override_mod diff --git a/c_data_override/c_data_override.h b/c_data_override/c_data_override.h new file mode 100644 index 0000000..cf3ad1d --- /dev/null +++ b/c_data_override/c_data_override.h @@ -0,0 +1,10 @@ +#ifndef C_DATA_OVERRIDE_H +#define C_DATA_OVERRIDE_H + +extern const int CFLOAT_MODE; +extern const int CDOUBLE_MODE; + +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); + +#endif diff --git a/c_fms/c_fms.F90 b/c_fms/c_fms.F90 index 55aa4ac..15581cc 100644 --- a/c_fms/c_fms.F90 +++ b/c_fms/c_fms.F90 @@ -56,6 +56,7 @@ module c_fms_mod public :: cFMS_get_compute_domain public :: cFMS_get_current_domain public :: cFMS_get_data_domain + public :: cFMS_get_domain_from_id public :: cFMS_get_domain_name public :: cFMS_get_layout public :: cFMS_set_compute_domain @@ -96,8 +97,7 @@ 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 - - type(FmsMppDomain2D), allocatable, target, public :: domain(:) + type(FmsMppDomain2D), allocatable, target, public :: domain(:) type(FmsMppDomain2D), pointer :: current_domain type(FmsMppDomainsNestDomain_type), allocatable, target, public :: nest_domain(:) @@ -453,6 +453,14 @@ subroutine cFMS_get_data_domain(domain_id, xbegin, xend, ybegin, yend, xsize, xm end subroutine cFMS_get_data_domain + function cFMS_get_domain_from_id(domain_id) + implicit none + integer, intent(in) :: domain_id + type(FmsMppDomain2D), pointer :: cFMS_get_domain_from_id + cFMS_get_domain_from_id => domain(domain_id) + end function cFMS_get_domain_from_id + + !> cFMS_get_domain_name subroutine cFMS_get_domain_name(domain_name_c, domain_id) bind(C, name="cFMS_get_domain_name") diff --git a/configure.ac b/configure.ac index 421b866..6b1b3f0 100644 --- a/configure.ac +++ b/configure.ac @@ -357,6 +357,7 @@ AC_CONFIG_FILES([ c_fms/Makefile c_fms_utils/Makefile c_constants/Makefile + c_data_override/Makefile c_diag_manager/Makefile c_grid_utils/Makefile c_horiz_interp/Makefile @@ -364,6 +365,7 @@ AC_CONFIG_FILES([ test_cfms/test-lib.sh test_cfms/intel_coverage.sh test_cfms/Makefile + test_cfms/c_data_override/Makefile test_cfms/c_diag_manager/Makefile test_cfms/c_fms/Makefile test_cfms/c_fms_utils/Makefile diff --git a/libcFMS/Makefile.am b/libcFMS/Makefile.am index accda37..2fdea59 100644 --- a/libcFMS/Makefile.am +++ b/libcFMS/Makefile.am @@ -33,6 +33,7 @@ libcFMS_la_LDFLAGS = -version-info 21:0:0 # Add the convenience libraries to the FMS library. libcFMS_la_LIBADD = $(top_builddir)/c_fms/lib_c_fms.la libcFMS_la_LIBADD += $(top_builddir)/c_constants/lib_c_constants.la +libcFMS_la_LIBADD += $(top_builddir)/c_data_override/lib_c_data_override.la libcFMS_la_LIBADD += $(top_builddir)/c_diag_manager/lib_c_diag_manager.la libcFMS_la_LIBADD += $(top_builddir)/c_horiz_interp/lib_c_horiz_interp.la libcFMS_la_LIBADD += $(top_builddir)/c_grid_utils/lib_c_grid_utils.la diff --git a/test_cfms/Makefile.am b/test_cfms/Makefile.am index 598faa4..eb51332 100644 --- a/test_cfms/Makefile.am +++ b/test_cfms/Makefile.am @@ -24,7 +24,7 @@ ACLOCAL_AMFLAGS = -I m4 # Make targets will be run in each subdirectory. Order is significant. -SUBDIRS = c_diag_manager c_fms c_fms_utils c_grid_utils c_horiz_interp +SUBDIRS = c_data_override c_diag_manager c_fms c_fms_utils c_grid_utils c_horiz_interp # testing utility scripts to distribute EXTRA_DIST = test-lib.sh.in intel_coverage.sh.in tap-driver.sh diff --git a/test_cfms/c_data_override/Makefile.am b/test_cfms/c_data_override/Makefile.am new file mode 100644 index 0000000..cd60ccb --- /dev/null +++ b/test_cfms/c_data_override/Makefile.am @@ -0,0 +1,43 @@ +#*********************************************************************** +#* 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 . +#*********************************************************************** +# + +# Find the needed mod and .inc files. +AM_CPPFLAGS = -I. -I$(MODDIR) -I${top_builddir}/c_data_override \ + -I${top_builddir}/c_fms -I${top_builddir}/test_cfms/c_fms + +# Link to the FMS library. +LDADD = ${top_builddir}/libcFMS/libcFMS.la + +check_PROGRAMS = test_data_override + +TESTS = test_data_override.sh + +test_data_override_SOURCES = ../c_fms/c_mpp_domains_helper.c test_data_override.c + +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.sh + +# Clean up +CLEANFILES = input.nml *.out *.dpi *.spi *.dyn *.spl *_table* input* *trs *.nc* + diff --git a/test_cfms/c_data_override/test_data_override.c b/test_cfms/c_data_override/test_data_override.c new file mode 100644 index 0000000..3d2416d --- /dev/null +++ b/test_cfms/c_data_override/test_data_override.c @@ -0,0 +1,55 @@ +#include +#include +#include +#include +#include + +#define NX 384 +#define NY 384 + +int main() +{ + + int ndomain = 1; + int nnest_domain = 0; + int domain_id = 0; + + cFMS_init(NULL, NULL, &ndomain, &nnest_domain); + + // define domain + { + int global_indices[4] = {0, NX-1, 0, NY-1}; + int ehalo = 2; + int whalo = 2; + int shalo = 2; + int nhalo = 2; + + cDomainStruct domain; + cFMS_null_cdomain(&domain); + + int ndivs = cFMS_npes(); + domain.layout = (int *)malloc(2*sizeof(int)); + cFMS_define_layout(global_indices, &ndivs, domain.layout); + + domain.domain_id = &domain_id; + domain.global_indices = global_indices; + domain.ehalo = &ehalo; + domain.whalo = &whalo; + domain.shalo = &shalo; + domain.nhalo = &nhalo; + + cFMS_define_domains_easy(domain); + } + + //data override init + { + int *ocn_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); + } + + return EXIT_SUCCESS; +} diff --git a/test_cfms/c_data_override/test_data_override.sh b/test_cfms/c_data_override/test_data_override.sh new file mode 100755 index 0000000..92dc91f --- /dev/null +++ b/test_cfms/c_data_override/test_data_override.sh @@ -0,0 +1,31 @@ +#!/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 +touch -a input.nml + +test_expect_success "c_data_override" 'mpirun -n 1 ./test_data_override' +test_done + From da9b9ab77935ff82a499ef6b565838714fd83592 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 18 Mar 2025 15:20:14 -0400 Subject: [PATCH 09/18] fix merge error --- test_cfms/c_diag_manager/Makefile.am | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test_cfms/c_diag_manager/Makefile.am b/test_cfms/c_diag_manager/Makefile.am index cd9b534..4c68a64 100644 --- a/test_cfms/c_diag_manager/Makefile.am +++ b/test_cfms/c_diag_manager/Makefile.am @@ -40,5 +40,5 @@ EXTRA_DIST = test_send_data.sh # Clean up CLEANFILES = input.nml *.out *.dpi *.spi *.dyn *.spl *_table* input* *trs *.nc* *.yaml* ->>>>>>> origin/main + From 14d5db599db22788696b75852d02a50f29662a56 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 19 Mar 2025 10:19:58 -0400 Subject: [PATCH 10/18] make optional arguments null pointers --- c_data_override/c_data_override.F90 | 37 ++++++++++++++++++++--------- 1 file changed, 26 insertions(+), 11 deletions(-) diff --git a/c_data_override/c_data_override.F90 b/c_data_override/c_data_override.F90 index ed7d1c6..e9a6c89 100644 --- a/c_data_override/c_data_override.F90 +++ b/c_data_override/c_data_override.F90 @@ -1,6 +1,6 @@ module c_data_override_mod - use FMS, only: FmsMppDomain2D, FATAL, fms_mpp_error + 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 @@ -11,7 +11,7 @@ module c_data_override_mod private public :: cFMS_data_override_init - integer, public, bind(C, name="CFLOAT_MODE") :: CFLOAT_MODE = c_float + integer, public, bind(C, name="CFLOAT_MODE") :: CFLOAT_MODE = c_float integer, public, bind(C, name="CDOUBLE_MODE") :: CDOUBLE_MODE = c_double contains @@ -27,17 +27,32 @@ subroutine cFMS_data_override_init(atm_domain_id, ocn_domain_id, ice_domain_id, integer, intent(in), optional :: land_domainUG_id integer, intent(in), optional :: mode - type(FmsMppDomain2D), pointer :: atm_domain + type(FmsMppDomain2D), pointer :: atm_domain + type(FmsMppDomain2D), pointer :: ocn_domain + type(FmsMppDomain2D), pointer :: ice_domain + type(FmsMppDomain2D), pointer :: land_domain + type(FmsMppDomainUG), pointer :: land_domainUG - if(present(ocn_domain_id)) call fms_mpp_error(FATAL, "ocn_domain will be implemented in the near future") - if(present(ice_domain_id)) call fms_mpp_error(FATAL, "ice_domain will be implemented in the near future") - if(present(land_domain_id)) call fms_mpp_error(FATAL, "land_domain will be implemented in the near future") - if(present(land_domainUG_id)) call fms_mpp_error(FATAL, "land unstructured domain will be implemented in the near future") - - if(present(atm_domain_id)) atm_domain => cFMS_get_domain_from_id(atm_domain_id) + atm_domain => NULL() + ocn_domain => NULL() + ice_domain => NULL() + land_domain => NULL() + land_domainUG => NULL() - call fms_data_override_init(atm_domain_in = atm_domain,& - mode = mode) + !NULL pointers are interpreted as not present optional arguments + !https://fortran-lang.discourse.group/t/an-unallocated-variable-passed-as-an-argument-is-not-present/1724/3 + if(present(atm_domain_id)) atm_domain => cFMS_get_domain_from_id(atm_domain_id) + if(present(ocn_domain_id)) ocn_domain => cFMS_get_domain_from_id(ocn_domain_id) + if(present(ice_domain_id)) ice_domain => cFMS_get_domain_from_id(ice_domain_id) + if(present(land_domain_id)) land_domain => cFMS_get_domain_from_id(land_domain_id) + if(present(land_domainUG_id)) call fms_mpp_error(FATAL, "unstructured domain is currently not implemented") + + call fms_data_override_init(atm_domain_in = atm_domain, & + ocean_domain_in = ocn_domain, & + ice_domain_in = ice_domain, & + land_domain_in = land_domain, & + land_domainUG_in = land_domainUG, & + mode = mode) end subroutine cFMS_data_override_init From f3db2700d7bbc58fb1737a64dd9c73711b311e2a Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 19 Mar 2025 10:20:47 -0400 Subject: [PATCH 11/18] woking version before merge --- c_data_override/Makefile.am | 4 +- c_data_override/c_data_override.F90 | 62 +++++++++++++++---- c_data_override/c_data_override.h | 11 ++++ c_diag_manager/c_diag_manager.F90 | 26 ++------ c_diag_manager/c_diag_manager.h | 7 +-- c_fms/c_fms.F90 | 23 ++++++- c_fms/c_fms.h | 7 ++- test_cfms/c_data_override/Makefile.am | 3 + .../c_data_override/test_data_override.c | 30 +++++++-- .../c_data_override/test_data_override.sh | 26 +++++++- test_cfms/c_diag_manager/Makefile.am | 2 +- test_cfms/c_diag_manager/test_send_data.c | 7 ++- test_cfms/c_fms/test_define_domains.c | 2 +- test_cfms/c_fms/test_getset_domains.c | 2 +- 14 files changed, 158 insertions(+), 54 deletions(-) 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 ed7d1c6..2aac66e 100644 --- a/c_data_override/c_data_override.F90 +++ b/c_data_override/c_data_override.F90 @@ -1,18 +1,25 @@ module c_data_override_mod use FMS, only: FmsMppDomain2D, 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="CFLOAT_MODE") :: CFLOAT_MODE = c_float integer, public, bind(C, name="CDOUBLE_MODE") :: CDOUBLE_MODE = c_double + + type(FmsTime_type) :: data_override_time contains @@ -28,17 +35,50 @@ subroutine cFMS_data_override_init(atm_domain_id, ocn_domain_id, ice_domain_id, integer, intent(in), optional :: mode type(FmsMppDomain2D), pointer :: atm_domain - - if(present(ocn_domain_id)) call fms_mpp_error(FATAL, "ocn_domain will be implemented in the near future") - if(present(ice_domain_id)) call fms_mpp_error(FATAL, "ice_domain will be implemented in the near future") - if(present(land_domain_id)) call fms_mpp_error(FATAL, "land_domain will be implemented in the near future") - if(present(land_domainUG_id)) call fms_mpp_error(FATAL, "land unstructured domain will be implemented in the near future") + type(FmsMppDomain2D), pointer :: ocn_domain + type(FmsMppDomain2D), pointer :: ice_domain + type(FmsMppDomain2D), pointer :: land_domain + type(FmsMppDomain2D), pointer :: land_domainUG if(present(atm_domain_id)) atm_domain => cFMS_get_domain_from_id(atm_domain_id) + if(present(ocn_domain_id)) ocn_domain => cFMS_get_domain_from_id(ocn_domain_id) + if(present(ice_domain_id)) ice_domain => cFMS_get_domain_from_id(ice_domain_id) + if(present(land_domain_id)) land_domain => cFMS_get_domain_from_id(land_domain_id) + if(present(land_domainUG_id)) landUG_domain => cFMS_get_domain_from_id(land_domainUG_id) - call fms_data_override_init(atm_domain_in = atm_domain,& - mode = mode) + call fms_data_override_init(atm_domain_in = atm_domain, mode = mode) 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_diag_manager/c_diag_manager.F90 b/c_diag_manager/c_diag_manager.F90 index dd55a71..c9649fd 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 @@ -66,11 +65,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") @@ -81,23 +75,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..ec4d45b 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 diff --git a/test_cfms/c_data_override/test_data_override.c b/test_cfms/c_data_override/test_data_override.c index 3d2416d..c4f0095 100644 --- a/test_cfms/c_data_override/test_data_override.c +++ b/test_cfms/c_data_override/test_data_override.c @@ -13,8 +13,9 @@ int main() int ndomain = 1; int nnest_domain = 0; int domain_id = 0; - - cFMS_init(NULL, NULL, &ndomain, &nnest_domain); + int calendar_type = NOLEAP; + + cFMS_init(NULL, NULL, &ndomain, &nnest_domain, &calendar_type); // define domain { @@ -47,9 +48,28 @@ int main() 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(&domain_id, ocn_domain_id, ice_domain_id, land_domain_id, land_domainUG_id, NULL); } - + + //data override scalar + { + char gridname[NAME_LENGTH] = "ATM"; + char fieldname_code[NAME_LENGTH] = "co2"; + float data = -100.; + bool *override = NULL; + int *data_index = NULL; + + int year = 1; + int month = 1; + int day = 2; + int hour = 0; + int minute = 0; + int second = 0; + + cFMS_data_override_set_time(&year, &month, &day, &hour, &minute, &second, NULL, NULL); + + cFMS_data_override_0d_cfloat(gridname, fieldname_code, &data, + } + return EXIT_SUCCESS; } diff --git a/test_cfms/c_data_override/test_data_override.sh b/test_cfms/c_data_override/test_data_override.sh index 92dc91f..c39db36 100755 --- a/test_cfms/c_data_override/test_data_override.sh +++ b/test_cfms/c_data_override/test_data_override.sh @@ -24,7 +24,31 @@ . ../test-lib.sh if [ -f "input.nml" ] ; then rm -f input.nml ; fi -touch -a input.nml + +make test_data_override_ongrid +mkdir INPUT + +#generate input for scalar +cat < input.nml +&test_data_override_ongrid_nml + test_case=3 + write_only=.True. +/ +EOF + +cat <<_EOF > data_table.yaml +data_table: + - grid_name: ATM + fieldname_in_model: co2 + override_file: + - fieldname_in_file: co2 + file_name: INPUT/scalar.nc + interp_method: none + factor : 1.0 +_EOF +fi + +./test_data_override_ongrid test_expect_success "c_data_override" 'mpirun -n 1 ./test_data_override' test_done diff --git a/test_cfms/c_diag_manager/Makefile.am b/test_cfms/c_diag_manager/Makefile.am index cd9b534..4c68a64 100644 --- a/test_cfms/c_diag_manager/Makefile.am +++ b/test_cfms/c_diag_manager/Makefile.am @@ -40,5 +40,5 @@ EXTRA_DIST = test_send_data.sh # Clean up CLEANFILES = input.nml *.out *.dpi *.spi *.dyn *.spl *_table* input* *trs *.nc* *.yaml* ->>>>>>> origin/main + 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 From a86c92de3417ceb16e318ed874e741299649e7e1 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 19 Mar 2025 13:08:16 -0400 Subject: [PATCH 12/18] add scalar --- c_data_override/c_data_override.F90 | 1 - c_fms_utils/include/array_to_pointer.inc | 1 + test_cfms/c_data_override/Makefile.am | 3 +- .../c_data_override/test_data_override.c | 44 +- .../c_data_override/test_data_override.sh | 11 +- .../test_data_override_ongrid.F90 | 515 ++++++++++++++++++ 6 files changed, 552 insertions(+), 23 deletions(-) create mode 100644 c_fms_utils/include/array_to_pointer.inc create mode 100644 test_cfms/c_data_override/test_data_override_ongrid.F90 diff --git a/c_data_override/c_data_override.F90 b/c_data_override/c_data_override.F90 index 422222d..e2c32b6 100644 --- a/c_data_override/c_data_override.F90 +++ b/c_data_override/c_data_override.F90 @@ -60,7 +60,6 @@ subroutine cFMS_data_override_init(atm_domain_id, ocn_domain_id, ice_domain_id, land_domain_in = land_domain, & land_domainUG_in = land_domainUG, & mode = mode) ->>>>>>> origin/data_override end subroutine cFMS_data_override_init diff --git a/c_fms_utils/include/array_to_pointer.inc b/c_fms_utils/include/array_to_pointer.inc new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/c_fms_utils/include/array_to_pointer.inc @@ -0,0 +1 @@ + diff --git a/test_cfms/c_data_override/Makefile.am b/test_cfms/c_data_override/Makefile.am index ec4d45b..00b0b65 100644 --- a/test_cfms/c_data_override/Makefile.am +++ b/test_cfms/c_data_override/Makefile.am @@ -42,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/test_data_override.c b/test_cfms/c_data_override/test_data_override.c index c4f0095..aa43cc4 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() { @@ -14,6 +16,8 @@ int main() int nnest_domain = 0; int domain_id = 0; 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); @@ -44,31 +48,37 @@ 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; - cFMS_data_override_init(&domain_id, ocn_domain_id, ice_domain_id, land_domain_id, land_domainUG_id, NULL); + 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] = "ATM"; + char gridname[NAME_LENGTH] = "OCN"; char fieldname_code[NAME_LENGTH] = "co2"; float data = -100.; - bool *override = NULL; + bool override = false; int *data_index = NULL; - - int year = 1; - int month = 1; - int day = 2; - int hour = 0; - int minute = 0; - int second = 0; - - cFMS_data_override_set_time(&year, &month, &day, &hour, &minute, &second, NULL, NULL); - - cFMS_data_override_0d_cfloat(gridname, fieldname_code, &data, + int start_day = 1; + + for(int i=0; i input.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: ATM + - grid_name: OCN fieldname_in_model: co2 override_file: - fieldname_in_file: co2 @@ -46,10 +51,10 @@ data_table: interp_method: none factor : 1.0 _EOF -fi ./test_data_override_ongrid -test_expect_success "c_data_override" 'mpirun -n 1 ./test_data_override' +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..29af061 --- /dev/null +++ b/test_cfms/c_data_override/test_data_override_ongrid.F90 @@ -0,0 +1,515 @@ +!*********************************************************************** +!* 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 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 From b2383fe7a9c6dd7e716bb8a35a0e0de55f0a4b45 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 19 Mar 2025 13:16:22 -0400 Subject: [PATCH 13/18] fix comment in test_data_override_ongrid --- test_cfms/c_data_override/test_data_override_ongrid.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) 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 29af061..5795dee 100644 --- a/test_cfms/c_data_override/test_data_override_ongrid.F90 +++ b/test_cfms/c_data_override/test_data_override_ongrid.F90 @@ -19,8 +19,9 @@ program test_data_override_ongrid -!>@brief This file was copied from test_fms/data_override and is used to generate test input files -!!"This programs tests data_override ability to override data for an +!> @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 From 0ed947f3c86c5d08163a5cb910524420a91f5306 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 19 Mar 2025 13:19:38 -0400 Subject: [PATCH 14/18] commit files that were not commited previously? --- c_data_override/c_data_override.F90 | 4 +--- c_fms/c_fms.F90 | 1 + test_cfms/c_data_override/Makefile.am | 1 - test_cfms/c_data_override/test_data_override.c | 10 ---------- 4 files changed, 2 insertions(+), 14 deletions(-) diff --git a/c_data_override/c_data_override.F90 b/c_data_override/c_data_override.F90 index f801889..9b6b407 100644 --- a/c_data_override/c_data_override.F90 +++ b/c_data_override/c_data_override.F90 @@ -63,7 +63,7 @@ subroutine cFMS_data_override_init(atm_domain_id, ocn_domain_id, ice_domain_id, mode = mode) 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") @@ -94,7 +94,5 @@ subroutine cFMS_data_override_set_time(year, month, day, hour, minute, second, t end subroutine cFMS_data_override_set_time #include "c_data_override_0d.fh" -======= ->>>>>>> origin/main end module c_data_override_mod diff --git a/c_fms/c_fms.F90 b/c_fms/c_fms.F90 index ec0f9b2..ef37a03 100644 --- a/c_fms/c_fms.F90 +++ b/c_fms/c_fms.F90 @@ -105,6 +105,7 @@ module c_fms_mod 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 diff --git a/test_cfms/c_data_override/Makefile.am b/test_cfms/c_data_override/Makefile.am index 6d17f10..00b0b65 100644 --- a/test_cfms/c_data_override/Makefile.am +++ b/test_cfms/c_data_override/Makefile.am @@ -42,5 +42,4 @@ SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \ EXTRA_DIST = test_data_override.sh # Clean up - CLEANFILES = *.nml* *.out *.dpi *.spi *.dyn *.spl *_table* input* *trs *.nc* diff --git a/test_cfms/c_data_override/test_data_override.c b/test_cfms/c_data_override/test_data_override.c index 2dd216d..001a2c4 100644 --- a/test_cfms/c_data_override/test_data_override.c +++ b/test_cfms/c_data_override/test_data_override.c @@ -80,15 +80,5 @@ int main() } } -======= - int *ocn_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); - } - ->>>>>>> origin/main return EXIT_SUCCESS; } From 8b765dc6aaeb362159269bf9d8a5da02b0928350 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 19 Mar 2025 13:27:43 -0400 Subject: [PATCH 15/18] add untracked files --- c_data_override/include/c_data_override_0d.fh | 15 +++++++++ .../include/c_data_override_0d.inc | 32 +++++++++++++++++++ 2 files changed, 47 insertions(+) create mode 100644 c_data_override/include/c_data_override_0d.fh create mode 100644 c_data_override/include/c_data_override_0d.inc 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_ + From 7cecfcbdb4615b211cfcc64d7954b05f15c420c3 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 19 Mar 2025 13:47:04 -0400 Subject: [PATCH 16/18] UNTRACKED FILES --- .../include/test_data_override_ongrid.inc | 224 ++++++++++++++++++ .../include/test_data_override_ongrid_r4.fh | 36 +++ .../include/test_data_override_ongrid_r8.fh | 36 +++ 3 files changed, 296 insertions(+) create mode 100644 test_cfms/c_data_override/include/test_data_override_ongrid.inc create mode 100644 test_cfms/c_data_override/include/test_data_override_ongrid_r4.fh create mode 100644 test_cfms/c_data_override/include/test_data_override_ongrid_r8.fh 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" From 727ace07cc2417f6d6752e243de8091f988e3e23 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 19 Mar 2025 14:01:52 -0400 Subject: [PATCH 17/18] update cfms_init in test_update_domain --- test_cfms/c_fms/test_update_domains.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) 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); From c4d3942b8c7235f437ba45370ddf64994d5d9171 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 24 Mar 2025 10:53:51 -0400 Subject: [PATCH 18/18] fix merging error --- c_fms_utils/include/array_to_pointer.inc | 1 - 1 file changed, 1 deletion(-) diff --git a/c_fms_utils/include/array_to_pointer.inc b/c_fms_utils/include/array_to_pointer.inc index 60281b4..da67dda 100644 --- a/c_fms_utils/include/array_to_pointer.inc +++ b/c_fms_utils/include/array_to_pointer.inc @@ -18,4 +18,3 @@ subroutine CFMS_ARRAY_TO_POINTER_(f_array, c_shape, c_pointer) nullify(cf_pointer) end subroutine CFMS_ARRAY_TO_POINTER_ ->>>>>>> origin/main