diff --git a/components/mpas-framework/Makefile b/components/mpas-framework/Makefile
index c7804a511102..050242d2071a 100644
--- a/components/mpas-framework/Makefile
+++ b/components/mpas-framework/Makefile
@@ -517,6 +517,7 @@ CPPINCLUDES =
FCINCLUDES =
LIBS =
+
#
# If user has indicated a PIO2 library, define USE_PIO2 pre-processor macro
#
@@ -605,6 +606,15 @@ endif
LIBS += -L$(PNETCDF)/$(PNETCDFLIBLOC) -lpnetcdf
endif
+ifeq "$(USE_SMARTSIM)" "true"
+ CPPINCLUDES += -I$(SMARTREDIS_PATH)/include
+ FCINCLUDES += -I$(SMARTREDIS_PATH)/include
+ LIBS += -L$(SMARTREDIS_PATH)/lib
+ LIBS += -lhiredis.a
+ LIBS += -lredis++.a
+ LIBS += -lsmartredis-fortran.a
+endif
+
ifeq "$(USE_LAPACK)" "true"
ifndef LAPACK
$(error LAPACK is not set. Please set LAPACK to the LAPACK install directory when USE_LAPACK=true)
@@ -1005,7 +1015,7 @@ drver: $(AUTOCLEAN_DEPS) framework dycore
mpas: $(AUTOCLEAN_DEPS) framework dycore drver
- $(LINKER) $(LDFLAGS) -o $(EXE_NAME) $(FWPATH)/driver/*.o -L$(FWPATH) -Lsrc -ldycore -lops -lframework $(LIBS) -I./external/esmf_time_f90 -L$(FWPATH)/external/esmf_time_f90 -lesmf_time
+ $(LINKER) $(LDFLAGS) -o $(EXE_NAME) $(FWPATH)/driver/*.o -L$(FWPATH) -Lsrc -ldycore -lops -lframework $(LIBS) -I./external/esmf_time_f90 -L$(FWPATH)/external/esmf_time_f90 -lesmf_time -L$(SMARTREDIS_PATH)/lib -lhiredis -lredis++ -lsmartredis-fortran
framework:
cd $(FWPATH); $(MAKE) \
diff --git a/components/mpas-framework/src/framework/Makefile b/components/mpas-framework/src/framework/Makefile
index 96976d054ff3..d71a7737e4c1 100644
--- a/components/mpas-framework/src/framework/Makefile
+++ b/components/mpas-framework/src/framework/Makefile
@@ -32,6 +32,7 @@ OBJS = mpas_kind_types.o \
mpas_domain_routines.o \
mpas_field_routines.o \
mpas_pool_routines.o \
+ mpas_smart_routines.o \
xml_stream_parser.o \
regex_matching.o \
mpas_field_accessor.o \
@@ -110,6 +111,11 @@ mpas_forcing.o: mpas_derived_types.o mpas_timekeeping.o mpas_stream_manager.o mp
mpas_c_interfacing.o:
+mpas_smart_routines.o: mpas_derived_types.o mpas_kind_types.o mpas_pool_routines.o mpas_field_routines.o mpas_threading.o mpas_log.o \
+ $(SMARTREDIS_PATH)/../src/fortran/fortran_c_interop.F90 \
+ $(SMARTREDIS_PATH)/../src/fortran/dataset.F90 \
+ $(SMARTREDIS_PATH)/../src/fortran/client.F90
+
xml_stream_parser.o: xml_stream_parser.c
$(CC) $(CFLAGS) $(CPPFLAGS) $(CPPINCLUDES) -I../external/ezxml -c xml_stream_parser.c
diff --git a/components/mpas-framework/src/framework/enum_fortran.inc b/components/mpas-framework/src/framework/enum_fortran.inc
new file mode 100644
index 000000000000..0555b0901462
--- /dev/null
+++ b/components/mpas-framework/src/framework/enum_fortran.inc
@@ -0,0 +1,79 @@
+! BSD 2-Clause License
+!
+! Copyright (c) 2021, Hewlett Packard Enterprise
+! All rights reserved.
+!
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+!
+! 1. Redistributions of source code must retain the above copyright notice, this
+! list of conditions and the following disclaimer.
+!
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+! this list of conditions and the following disclaimer in the documentation
+! and/or other materials provided with the distribution.
+!
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+! Dummy enum, used to set the integer kind used
+integer, parameter :: enum_kind = 4
+
+! The following enums have analogues to the C and C++ clients. Fortran does not haven named enums, but the name:value
+! parameters must be the same. By convention negative enums, represent items that are not supported in the Fortran
+! client.
+
+! TensorType
+enum, bind(c)
+ enumerator :: tensor_invalid = -1
+ enumerator :: tensor_dbl = 1
+ enumerator :: tensor_flt = 2
+ enumerator :: tensor_int8 = 3
+ enumerator :: tensor_int16 = 4
+ enumerator :: tensor_int32 = 5
+ enumerator :: tensor_int64 = 6
+ enumerator :: tensor_uint8 = -1
+ enumerator :: tensor_uint16 = -1
+end enum
+
+! MemoryLayout
+enum, bind(c)
+ enumerator :: c_invalid = -1
+ enumerator :: c_nested = 1
+ enumerator :: c_contiguous = 2
+ enumerator :: c_fortran_nested = 3
+ enumerator :: c_fortran_contiguous = 4
+end enum
+
+! MetadataType
+enum, bind(c)
+ enumerator :: meta_invalid = -1
+ enumerator :: meta_dbl = 1
+ enumerator :: meta_flt = 2
+ enumerator :: meta_int32 = 3
+ enumerator :: meta_int64 = 4
+ enumerator :: meta_uint32 = -1
+ enumerator :: meta_uint64 = -1
+ enumerator :: meta_string = 7
+end enum
+
+! SRError
+enum, bind(c)
+ enumerator :: SRNoError = 0
+ enumerator :: SRBadAllocError = 1
+ enumerator :: SRDatabaseError = 2
+ enumerator :: SRInternalError = 3
+ enumerator :: SRRuntimeError = 4
+ enumerator :: SRParameterError = 5
+ enumerator :: SRTimeoutError = 6
+ enumerator :: SRKeyError = 7
+ enumerator :: SRInvalidError = -1
+end enum
diff --git a/components/mpas-framework/src/framework/mpas_smart_routines.F b/components/mpas-framework/src/framework/mpas_smart_routines.F
new file mode 100644
index 000000000000..c2145b67c762
--- /dev/null
+++ b/components/mpas-framework/src/framework/mpas_smart_routines.F
@@ -0,0 +1,988 @@
+! Copyright (c) 2013, Los Alamos National Security, LLC (LANS)
+! and the University Corporation for Atmospheric Research (UCAR).
+!
+! Unless noted otherwise source code is licensed under the BSD license.
+! Additional copyright and license information can be found in the LICENSE file
+! distributed with this code, or at http://mpas-dev.github.com/license.html
+!
+module mpas_smart_routines
+
+#define COMMA ,
+#define STREAM_DEBUG_WRITE(M) call mpas_log_write(M)
+
+#ifdef SINGLE_PRECISION
+#define REAL_IO_TYPE MPAS_IO_REAL
+#else
+#define REAL_IO_TYPE MPAS_IO_DOUBLE
+#endif
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_field_routines
+ use mpas_threading
+ use mpas_log
+ use smartredis_client, only: client_type
+ use smartredis_dataset, only: dataset_type
+
+ implicit none
+ save
+
+ public :: mpas_smart_client_init, mpas_smart_dataset_init
+
+# include "enum_fortran.inc"
+
+! --- Private module variables ---
+ type(client_type) :: client
+
+ interface mpas_smart_field_client_send
+ module procedure mpas_smart_field_client_send_1d
+ module procedure mpas_smart_field_client_send_2d
+ module procedure mpas_smart_field_client_send_3d
+ module procedure mpas_smart_field_client_send_4d
+ end interface
+
+ interface mpas_smart_field_client_recv
+ module procedure mpas_smart_field_client_recv_1d
+ module procedure mpas_smart_field_client_recv_2d
+ module procedure mpas_smart_field_client_recv_3d
+ module procedure mpas_smart_field_client_recv_4d
+ end interface
+
+ interface mpas_smart_dataset_add_field_real
+ module procedure mpas_smart_dataset_add_field_real_1d
+ module procedure mpas_smart_dataset_add_field_real_2d
+ module procedure mpas_smart_dataset_add_field_real_3d
+ module procedure mpas_smart_dataset_add_field_real_4d
+ end interface
+
+ interface mpas_smart_dataset_recv_field_real
+ module procedure mpas_smart_dataset_recv_field_real_1d
+ module procedure mpas_smart_dataset_recv_field_real_2d
+ module procedure mpas_smart_dataset_recv_field_real_3d
+ module procedure mpas_smart_dataset_recv_field_real_4d
+ end interface
+
+ contains
+
+ subroutine mpas_smart_client_init(client_out, ierr)
+
+ !implicit none
+
+ type(client_type), intent(out) :: client_out
+ integer, intent(out), optional :: ierr
+
+ character(len=100) :: log_string
+ integer(kind=enum_kind) :: err_client
+
+ call get_environment_variable('SSDB',log_string)
+ call mpas_log_write('SSDB='//TRIM(log_string))
+ if (len(TRIM(log_string)) < 5) then
+ call mpas_log_write('FWK: No SSDB')!, &
+ else
+ err_client = client%initialize(.false.)
+ if (err_client /= SRNoError) then
+ write(log_string,*) 'FWK: Error initializing redis client:', &
+ err_client
+ call mpas_log_write(log_string)
+ err_client = client%SR_error_parser(err_client)
+ ierr = ior(ierr, 1)
+ else
+ call mpas_log_write('FWK: Client initialized')
+ client_out = client
+ endif
+ endif
+
+ end subroutine mpas_smart_client_init
+
+ subroutine mpas_smart_dataset_init(dataset_name, dataset, ierr)
+
+ character(len=strKIND), intent(in) :: dataset_name
+ type(dataset_type), intent(out) :: dataset
+ integer, intent(out), optional :: ierr
+
+ character(len=100) :: log_string
+ integer(kind=enum_kind) :: err_client
+
+ err_client = dataset%initialize(dataset_name)
+ if (err_client /= SRNoError) then
+ write(log_string,*) 'FWK: Error initializing redis database:', &
+ err_client
+ call mpas_log_write(log_string)
+ ierr = ior(ierr, 1)
+ else
+ call mpas_log_write('FWK: Database initialized')
+ endif
+
+ end subroutine mpas_smart_dataset_init
+
+ subroutine mpas_smart_dataset_put(dataset, ierr)
+
+ type(dataset_type), intent(in) :: dataset
+ integer, intent(out), optional :: ierr
+
+ integer(kind=enum_kind) :: err_client
+
+ err_client = client%put_dataset(dataset)
+ if (err_client /= SRNoError) then
+ call mpas_log_write('FWK: Error putting redis dataset: $i', &
+ intArgs=(/err_client/))
+ ierr = ior(ierr, 1)
+ else
+ call mpas_log_write('FWK: Dataset put')
+ endif
+
+ end subroutine mpas_smart_dataset_put
+
+! --------------------------------------------------------------------
+! SUBROUTINE mpas_smart_stream_send
+! Send the stream to a client.
+! --------------------------------------------------------------------
+! subroutine mpas_smart_stream_send(stream, ierr)
+
+! implicit none
+
+! !type (MPAS_streamManager_type), intent(inout) :: manager
+! !character (len=*), intent(in), optional :: streamID
+! type (MPAS_Stream_type), intent(in) :: stream
+! !type (MPAS_stream_list_type), pointer :: stream_cursor
+! integer, intent(out), optional :: ierr
+
+! type (field_list_type), pointer :: field_cursor
+! type (field1dReal), pointer :: field_1d_ptr
+! !call MPAS_stream_list_query(manager % streams, streamID, stream_cursor, ierr=ierr))
+! !
+! ! Loop over fields in the stream
+! !
+! field_cursor => stream % fieldList
+! do while (associated(field_cursor))
+! if (field_cursor % field_type == FIELD_1D_REAL) then
+! field_1d_ptr = field_cursor % real1dField
+! call mpas_smart_field_send_1d(client, field_1d_ptr, ierr)
+! else
+! call mpas_log_write('field is not of type 1D REAL')
+! endif
+! end do
+
+! end subroutine mpas_smart_stream_send
+
+! --------------------------------------------------------------------
+! SUBROUTINE mpas_smart_stream_database_send
+! Send the stream to a database.
+! TODO: if decomposed and blockWrite, send each block to a
+! different database
+! --------------------------------------------------------------------
+
+! subroutine mpas_smart_stream_database_send(stream, database_list)
+!
+! type (field_list_type), pointer :: field_cursor
+
+! field_cursor => stream % fieldList
+! do while (associated(field_cursor))
+
+! if (field_cursor % isDecomposed) then
+! ! Gather field from across multiple blocks
+! field_2dreal_ptr => field_cursor % real2dField
+! i = 1
+! do while (associated(field_2dreal_ptr))
+! i = i + ownedSize
+! if ( .not. stream % blockWrite ) then
+! field_2dreal_ptr => field_2dreal_ptr % next
+! else
+! nullify(field_2dreal_ptr)
+! end if
+! end do
+! end if
+! if ( .not. stream % blockWrite ) then
+
+! end subroutine mpas_smart_database_send
+
+ subroutine mpas_smart_config_send(domain, configName, ierr)
+
+ type (domain_type), intent(in) :: domain
+ character(len=*), intent(in) :: configName
+ integer, intent(out), optional :: ierr
+
+ type (mpas_pool_field_info_type) :: fieldInfo
+ real (kind=RKIND), pointer :: config_ptr
+ real (kind=RKIND), dimension(1) :: config_temp
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+
+ call mpas_pool_get_config(domain % configs, &
+ trim(configName), &
+ config_ptr)
+ config_temp(1) = config_ptr
+ err_client = client%put_tensor(trim(configName), &
+ config_temp, shape(config_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'FWK: Error put config:', trim(configName)
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'FWK: Put config:', trim(configName)
+ call mpas_log_write(trim(log_string))
+ endif
+
+ end subroutine mpas_smart_config_send
+
+ subroutine mpas_smart_config_recv(domain, configName, ierr)
+
+ type (domain_type), intent(in) :: domain
+ character(len=*), intent(in) :: configName
+ integer, intent(out), optional :: ierr
+
+ type (mpas_pool_field_info_type) :: fieldInfo
+ real (kind=RKIND), pointer :: config_ptr
+ real (kind=RKIND), dimension(1) :: config_temp
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+
+ call mpas_pool_get_config(domain % configs, &
+ trim(configName), &
+ config_ptr)
+ err_client = client%unpack_tensor(trim(configName), &
+ config_temp, shape(config_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'FWK: Error unpack config:', trim(configName)
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'FWK: unpack config:', trim(configName)
+ call mpas_log_write(trim(log_string))
+ endif
+ config_ptr = config_temp(1)
+
+ end subroutine mpas_smart_config_recv
+
+ subroutine mpas_smart_field_send(domain, fieldName, ierr)
+
+ type (domain_type), intent(in) :: domain
+ character(len=StrKIND), intent(in) :: fieldName
+ integer, intent(out), optional :: ierr
+
+ type (mpas_pool_field_info_type) :: fieldInfo
+ type (field1DReal), pointer :: field_real1d_ptr
+ type (field2DReal), pointer :: field_real2d_ptr
+ type (field3DReal), pointer :: field_real3d_ptr
+ type (field4DReal), pointer :: field_real4d_ptr
+ character(len=StrKIND) :: log_string
+
+ call mpas_pool_get_field_info(domain%blocklist%allFields, &
+ fieldName, fieldInfo)
+ call mpas_log_write(log_string)
+ if ( fieldInfo % fieldType == MPAS_POOL_REAL ) then
+ if ( fieldInfo % nDims == 1 ) then
+ call mpas_pool_get_field(domain%blocklist%allFields, &
+ trim(fieldName), field_real1d_ptr)
+ call mpas_log_write(trim(fieldName)//' retrieved')
+ call mpas_smart_field_client_send(field_real1d_ptr, ierr)
+ elseif ( fieldInfo % nDims == 2 ) then
+ call mpas_pool_get_field(domain%blocklist%allFields, &
+ trim(fieldName), field_real2d_ptr)
+ call mpas_log_write(trim(fieldName)//' retrieved')
+ call mpas_smart_field_client_send(field_real2d_ptr, ierr)
+ elseif ( fieldInfo % nDims == 3 ) then
+ call mpas_pool_get_field(domain%blocklist%allFields, &
+ trim(fieldName), field_real3d_ptr)
+ call mpas_log_write(trim(fieldName)//' retrieved')
+ call mpas_smart_field_client_send(field_real3d_ptr, ierr)
+ elseif ( fieldInfo % nDims == 4 ) then
+ call mpas_pool_get_field(domain%blocklist%allFields, &
+ trim(fieldName), field_real4d_ptr)
+ call mpas_log_write(trim(fieldName)//' retrieved')
+ call mpas_smart_field_client_send(field_real4d_ptr, ierr)
+ else
+ call mpas_log_write(trim(fieldName)// &
+ ' is not of a supported dimension')
+ endif
+ else
+ call mpas_log_write(trim(fieldName)//' is not real')
+ endif
+
+ end subroutine mpas_smart_field_send
+
+ subroutine mpas_smart_field_recv(domain, fieldName, ierr)
+
+ type (domain_type), intent(in) :: domain
+ character(len=StrKIND), intent(in) :: fieldName
+ integer, intent(out), optional :: ierr
+
+ type (mpas_pool_field_info_type) :: fieldInfo
+ type (field1DReal), pointer :: field_real1d_ptr
+ type (field2DReal), pointer :: field_real2d_ptr
+ type (field3DReal), pointer :: field_real3d_ptr
+ type (field4DReal), pointer :: field_real4d_ptr
+ character(len=StrKIND) :: log_string
+
+ call mpas_pool_get_field_info(domain%blocklist%allFields, &
+ fieldName, fieldInfo)
+ call mpas_log_write(log_string)
+ if ( fieldInfo % fieldType == MPAS_POOL_REAL ) then
+ if ( fieldInfo % nDims == 1 ) then
+ call mpas_pool_get_field(domain%blocklist%allFields, &
+ trim(fieldName), field_real1d_ptr)
+ call mpas_log_write(trim(fieldName)//' retrieved')
+ call mpas_smart_field_client_recv(field_real1d_ptr, ierr)
+ elseif ( fieldInfo % nDims == 2 ) then
+ call mpas_pool_get_field(domain%blocklist%allFields, &
+ trim(fieldName), field_real2d_ptr)
+ call mpas_log_write(trim(fieldName)//' retrieved')
+ call mpas_smart_field_client_recv(field_real2d_ptr, ierr)
+ elseif ( fieldInfo % nDims == 3 ) then
+ call mpas_pool_get_field(domain%blocklist%allFields, &
+ trim(fieldName), field_real3d_ptr)
+ call mpas_log_write(trim(fieldName)//' retrieved')
+ call mpas_smart_field_client_recv(field_real3d_ptr, ierr)
+ elseif ( fieldInfo % nDims == 4 ) then
+ call mpas_pool_get_field(domain%blocklist%allFields, &
+ trim(fieldName), field_real4d_ptr)
+ call mpas_log_write(trim(fieldName)//' retrieved')
+ call mpas_smart_field_client_recv(field_real4d_ptr, ierr)
+ else
+ call mpas_log_write(trim(fieldName)// &
+ ' is not of a supported dimension')
+ endif
+ else
+ call mpas_log_write(trim(fieldName)//' is not real')
+ endif
+
+ end subroutine mpas_smart_field_recv
+
+ subroutine mpas_smart_dataset_config_send(dataset, domain, configName, ierr)
+
+ type(dataset_type), intent(in) :: dataset
+ type (domain_type), intent(in) :: domain
+ character(len=*), intent(in) :: configName
+ integer, intent(out), optional :: ierr
+
+ type (mpas_pool_field_info_type) :: fieldInfo
+ real (kind=RKIND), pointer :: config_ptr
+ real (kind=RKIND), dimension(1) :: config_temp
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+
+ call mpas_pool_get_config(domain % configs, &
+ trim(configName), &
+ config_ptr)
+ config_temp(1) = config_ptr
+ err_client = dataset%add_meta_scalar(trim(configName), &
+ config_ptr)
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'FWK: Error put config in dataset:', trim(configName)
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'FWK: Put config in dataset:', trim(configName)
+ call mpas_log_write(trim(log_string))
+ endif
+
+ end subroutine mpas_smart_dataset_config_send
+
+ subroutine mpas_smart_dataset_config_recv(dataset, domain, configName, ierr)
+
+ type(dataset_type), intent(in) :: dataset
+ type (domain_type), intent(in) :: domain
+ character(len=*), intent(in) :: configName
+ integer, intent(out), optional :: ierr
+
+ type (mpas_pool_field_info_type) :: fieldInfo
+ real (kind=RKIND), pointer :: config_ptr
+ real (kind=RKIND), dimension(:), pointer :: config_temp
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+
+ call mpas_pool_get_config(domain % configs, &
+ trim(configName), &
+ config_ptr)
+ err_client = dataset%get_meta_scalars(trim(configName), &
+ config_temp)
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'FWK: Error put config in dataset:', trim(configName)
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'FWK: Put config in dataset:', trim(configName)
+ call mpas_log_write(trim(log_string))
+ endif
+ config_ptr = config_temp(1)
+
+ end subroutine mpas_smart_dataset_config_recv
+
+ subroutine mpas_smart_dataset_add_field(dataset, domain, fieldName, ierr)
+
+ type(dataset_type), intent(in) :: dataset
+ type (domain_type), intent(in) :: domain
+ character(len=StrKIND), intent(in) :: fieldName
+ integer, intent(out), optional :: ierr
+
+ type (mpas_pool_field_info_type) :: fieldInfo
+ type (field1DReal), pointer :: field_real1d_ptr
+ type (field2DReal), pointer :: field_real2d_ptr
+ type (field3DReal), pointer :: field_real3d_ptr
+ type (field4DReal), pointer :: field_real4d_ptr
+ character(len=StrKIND) :: log_string
+
+ call mpas_pool_get_field_info(domain%blocklist%allFields, &
+ fieldName, fieldInfo)
+ call mpas_log_write(log_string)
+ if ( fieldInfo % fieldType == MPAS_POOL_REAL ) then
+ if ( fieldInfo % nDims == 1 ) then
+ call mpas_pool_get_field(domain%blocklist%allFields, &
+ trim(fieldName), field_real1d_ptr)
+ call mpas_log_write(trim(fieldName)//' retrieved')
+ call mpas_smart_dataset_add_field_real(dataset, field_real1d_ptr, ierr)
+ elseif ( fieldInfo % nDims == 2 ) then
+ call mpas_pool_get_field(domain%blocklist%allFields, &
+ trim(fieldName), field_real2d_ptr)
+ call mpas_log_write(trim(fieldName)//' retrieved')
+ call mpas_smart_dataset_add_field_real(dataset, field_real2d_ptr, ierr)
+ elseif ( fieldInfo % nDims == 3 ) then
+ call mpas_pool_get_field(domain%blocklist%allFields, &
+ trim(fieldName), field_real3d_ptr)
+ call mpas_log_write(trim(fieldName)//' retrieved')
+ call mpas_smart_dataset_add_field_real(dataset, field_real3d_ptr, ierr)
+ elseif ( fieldInfo % nDims == 4 ) then
+ call mpas_pool_get_field(domain%blocklist%allFields, &
+ trim(fieldName), field_real4d_ptr)
+ call mpas_log_write(trim(fieldName)//' retrieved')
+ call mpas_smart_dataset_add_field_real(dataset, field_real4d_ptr, ierr)
+ else
+ call mpas_log_write(trim(fieldName)// &
+ ' is not of a supported dimension')
+ endif
+ else
+ call mpas_log_write(trim(fieldName)//' is not real')
+ endif
+
+ end subroutine mpas_smart_dataset_add_field
+
+ subroutine mpas_smart_dataset_recv_field(dataset, domain, fieldName, ierr)
+
+ type(dataset_type), intent(in) :: dataset
+ type (domain_type), intent(in) :: domain
+ character(len=StrKIND), intent(in) :: fieldName
+ integer, intent(out), optional :: ierr
+
+ type (mpas_pool_field_info_type) :: fieldInfo
+ type (field1DReal), pointer :: field_real1d_ptr
+ type (field2DReal), pointer :: field_real2d_ptr
+ type (field3DReal), pointer :: field_real3d_ptr
+ type (field4DReal), pointer :: field_real4d_ptr
+ character(len=StrKIND) :: log_string
+
+ call mpas_pool_get_field_info(domain%blocklist%allFields, &
+ fieldName, fieldInfo)
+ call mpas_log_write(log_string)
+ if ( fieldInfo % fieldType == MPAS_POOL_REAL ) then
+ if ( fieldInfo % nDims == 1 ) then
+ call mpas_pool_get_field(domain%blocklist%allFields, &
+ trim(fieldName), field_real1d_ptr)
+ call mpas_log_write(trim(fieldName)//' retrieved')
+ call mpas_smart_dataset_recv_field_real(dataset, field_real1d_ptr, ierr)
+ elseif ( fieldInfo % nDims == 2 ) then
+ call mpas_pool_get_field(domain%blocklist%allFields, &
+ trim(fieldName), field_real2d_ptr)
+ call mpas_log_write(trim(fieldName)//' retrieved')
+ call mpas_smart_dataset_recv_field_real(dataset, field_real2d_ptr, ierr)
+ elseif ( fieldInfo % nDims == 3 ) then
+ call mpas_pool_get_field(domain%blocklist%allFields, &
+ trim(fieldName), field_real3d_ptr)
+ call mpas_log_write(trim(fieldName)//' retrieved')
+ call mpas_smart_dataset_recv_field_real(dataset, field_real3d_ptr, ierr)
+ elseif ( fieldInfo % nDims == 4 ) then
+ call mpas_pool_get_field(domain%blocklist%allFields, &
+ trim(fieldName), field_real4d_ptr)
+ call mpas_log_write(trim(fieldName)//' retrieved')
+ call mpas_smart_dataset_recv_field_real(dataset, field_real4d_ptr, ierr)
+ else
+ call mpas_log_write(trim(fieldName)// &
+ ' is not of a supported dimension')
+ endif
+ else
+ call mpas_log_write(trim(fieldName)//' is not real')
+ endif
+
+ end subroutine mpas_smart_dataset_recv_field
+
+! INTERFACE mpas_smart_field_client_send
+! TODO add optional argument to provide a different key
+ subroutine mpas_smart_field_client_send_1d(field_ptr, ierr)
+
+ type (field1dReal), pointer, intent(in) :: field_ptr
+ integer, intent(out), optional :: ierr
+
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+ real (kind=RKIND), dimension(:), allocatable :: field_temp
+ integer, dimension(1) :: field_dims
+
+ field_dims = field_ptr % dimSizes
+ !call mpas_pool_get_dimension(field_ptr % block % dimensions, &
+ ! trim(field_ptr % dimNames(1)), field_dims(1))
+ allocate(field_temp(field_dims(1)))
+ field_temp = field_ptr % array
+
+ err_client = client%put_tensor(trim(field_ptr % fieldName), &
+ field_temp, &
+ shape(field_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'FWK: Error put tensor:', trim(field_ptr % fieldName), err_client
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'FWK: Put tensor:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ endif
+ deallocate(field_temp)
+
+ end subroutine mpas_smart_field_client_send_1d
+
+ subroutine mpas_smart_field_client_send_2d(field_ptr, ierr)
+
+ type (field2dReal), pointer, intent(in) :: field_ptr
+ integer, intent(out), optional :: ierr
+
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+ real (kind=RKIND), dimension(:,:), allocatable :: field_temp
+ integer, dimension(2) :: field_dims
+
+ field_dims = field_ptr % dimSizes
+ allocate(field_temp(field_dims(1), field_dims(2)))
+ field_temp = field_ptr % array
+
+ err_client = client%put_tensor(trim(field_ptr % fieldName), &
+ field_temp, &
+ shape(field_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'Error put tensor:', &
+ trim(field_ptr % fieldName), err_client
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'Put tensor:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ endif
+ deallocate(field_temp)
+
+ end subroutine mpas_smart_field_client_send_2d
+
+ subroutine mpas_smart_field_client_send_3d(field_ptr, ierr)
+
+ type (field3dReal), pointer, intent(in) :: field_ptr
+ integer, intent(out), optional :: ierr
+
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+ real (kind=RKIND), dimension(:,:,:), allocatable :: field_temp
+ integer, dimension(3) :: field_dims
+
+ field_dims = field_ptr % dimSizes
+ allocate(field_temp(field_dims(1), field_dims(2), field_dims(3)))
+ field_temp = field_ptr % array
+
+ err_client = client%put_tensor(trim(field_ptr % fieldName), &
+ field_temp, &
+ shape(field_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'Error put tensor:', &
+ trim(field_ptr % fieldName), err_client
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'Put tensor:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ endif
+ deallocate(field_temp)
+
+ end subroutine mpas_smart_field_client_send_3d
+
+ subroutine mpas_smart_field_client_send_4d(field_ptr, ierr)
+
+ type (field4dReal), pointer, intent(in) :: field_ptr
+ integer, intent(out), optional :: ierr
+
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+ real (kind=RKIND), dimension(:,:,:,:), allocatable :: field_temp
+ integer, dimension(4) :: field_dims
+
+ field_dims = field_ptr % dimSizes
+ allocate(field_temp(field_dims(1), field_dims(2), field_dims(3), &
+ field_dims(4)))
+ field_temp = field_ptr % array
+
+ err_client = client%put_tensor(trim(field_ptr % fieldName), &
+ field_temp, &
+ shape(field_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'Error put tensor:', &
+ trim(field_ptr % fieldName), err_client
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'Put tensor:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ endif
+ deallocate(field_temp)
+
+ end subroutine mpas_smart_field_client_send_4d
+
+! INTERFACE mpas_smart_field_client_recv
+! TODO add optional argument to provide a different key
+ subroutine mpas_smart_field_client_recv_1d(field_ptr, ierr)
+
+ type (field1dReal), pointer, intent(in) :: field_ptr
+ integer, intent(out), optional :: ierr
+
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+ real (kind=RKIND), dimension(:), allocatable :: field_temp
+ integer, dimension(1) :: field_dims
+
+ field_dims = field_ptr % dimSizes
+ allocate(field_temp(field_dims(1)))
+
+ err_client = client%unpack_tensor(trim(field_ptr % fieldName), &
+ field_temp, &
+ shape(field_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'FWK: Error unpack tensor:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'FWK: Unpack tensor:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ endif
+ field_ptr % array = field_temp
+ deallocate(field_temp)
+
+ end subroutine mpas_smart_field_client_recv_1d
+
+ subroutine mpas_smart_field_client_recv_2d(field_ptr, ierr)
+
+ type (field2dReal), pointer, intent(in) :: field_ptr
+ integer, intent(out), optional :: ierr
+
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+ real (kind=RKIND), dimension(:,:), allocatable :: field_temp
+ integer, dimension(2) :: field_dims
+
+ field_dims = field_ptr % dimSizes
+ allocate(field_temp(field_dims(1), field_dims(2)))
+
+ err_client = client%unpack_tensor(trim(field_ptr % fieldName), &
+ field_temp, &
+ shape(field_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'Error unpack tensor:', &
+ trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'FWK: unpack tensor:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ endif
+ field_ptr % array = field_temp
+ deallocate(field_temp)
+
+ end subroutine mpas_smart_field_client_recv_2d
+
+ subroutine mpas_smart_field_client_recv_3d(field_ptr, ierr)
+
+ type (field3dReal), pointer, intent(in) :: field_ptr
+ integer, intent(out), optional :: ierr
+
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+ real (kind=RKIND), dimension(:,:,:), allocatable :: field_temp
+ integer, dimension(3) :: field_dims
+
+ field_dims = field_ptr % dimSizes
+ allocate(field_temp(field_dims(1), field_dims(2), field_dims(3)))
+
+ err_client = client%unpack_tensor(trim(field_ptr % fieldName), &
+ field_temp, &
+ shape(field_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'Error unpack tensor:', &
+ trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'FWK: unpack tensor:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ endif
+ field_ptr % array = field_temp
+ deallocate(field_temp)
+
+ end subroutine mpas_smart_field_client_recv_3d
+
+ subroutine mpas_smart_field_client_recv_4d(field_ptr, ierr)
+
+ type (field4dReal), pointer, intent(in) :: field_ptr
+ integer, intent(out), optional :: ierr
+
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+ real (kind=RKIND), dimension(:,:,:,:), allocatable :: field_temp
+ integer, dimension(4) :: field_dims
+
+ field_dims = field_ptr % dimSizes
+ allocate(field_temp(field_dims(1), field_dims(2), field_dims(3), &
+ field_dims(4)))
+
+ err_client = client%unpack_tensor(trim(field_ptr % fieldName), &
+ field_temp, &
+ shape(field_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'Error unpack tensor:', &
+ trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'Unpack tensor:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ endif
+ field_ptr % array = field_temp
+ deallocate(field_temp)
+
+ end subroutine mpas_smart_field_client_recv_4d
+
+! INTERFACE mpas_smart_dataset_add_field_real
+ subroutine mpas_smart_dataset_add_field_real_1d(dataset, field_ptr, ierr)
+
+ type(dataset_type), intent(in) :: dataset
+ type (field1dReal), pointer, intent(in) :: field_ptr
+ integer, intent(out), optional :: ierr
+
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+ real (kind=RKIND), dimension(:), allocatable :: field_temp
+ integer, dimension(1) :: field_dims
+
+ field_dims = field_ptr % dimSizes
+ allocate(field_temp(field_dims(1)))
+
+ err_client = dataset%add_tensor(trim(field_ptr % fieldName), &
+ field_temp, &
+ shape(field_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'FWK: Error dataset add tensor:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'FWK: Added tensor to dataset:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ endif
+ deallocate(field_temp)
+
+ end subroutine mpas_smart_dataset_add_field_real_1d
+
+ subroutine mpas_smart_dataset_add_field_real_2d(dataset, field_ptr, ierr)
+
+ type(dataset_type), intent(in) :: dataset
+ type (field2dReal), pointer, intent(in) :: field_ptr
+ integer, intent(out), optional :: ierr
+
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+ real (kind=RKIND), dimension(:,:), allocatable :: field_temp
+ integer, dimension(2) :: field_dims
+
+ field_dims = field_ptr % dimSizes
+ allocate(field_temp(field_dims(1),field_dims(2)))
+
+ err_client = dataset%add_tensor(trim(field_ptr % fieldName), &
+ field_temp, &
+ shape(field_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'FWK: Error dataset add tensor:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'FWK: Added tensor to dataset:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ endif
+ deallocate(field_temp)
+
+ end subroutine mpas_smart_dataset_add_field_real_2d
+
+ subroutine mpas_smart_dataset_add_field_real_3d(dataset, field_ptr, ierr)
+
+ type(dataset_type), intent(in) :: dataset
+ type (field3dReal), pointer, intent(in) :: field_ptr
+ integer, intent(out), optional :: ierr
+
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+ real (kind=RKIND), dimension(:,:,:), allocatable :: field_temp
+ integer, dimension(3) :: field_dims
+
+ field_dims = field_ptr % dimSizes
+ allocate(field_temp(field_dims(1),field_dims(2),field_dims(3)))
+
+ err_client = dataset%add_tensor(trim(field_ptr % fieldName), &
+ field_temp, &
+ shape(field_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'FWK: Error dataset add tensor:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'FWK: Added tensor to dataset:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ endif
+ deallocate(field_temp)
+
+ end subroutine mpas_smart_dataset_add_field_real_3d
+
+ subroutine mpas_smart_dataset_add_field_real_4d(dataset, field_ptr, ierr)
+
+ type(dataset_type), intent(in) :: dataset
+ type (field4dReal), pointer, intent(in) :: field_ptr
+ integer, intent(out), optional :: ierr
+
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+ real (kind=RKIND), dimension(:,:,:,:), allocatable :: field_temp
+ integer, dimension(4) :: field_dims
+
+ field_dims = field_ptr % dimSizes
+ allocate(field_temp(field_dims(1),field_dims(2),field_dims(3),field_dims(4)))
+
+ err_client = dataset%add_tensor(trim(field_ptr % fieldName), &
+ field_temp, &
+ shape(field_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'FWK: Error dataset add tensor:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'FWK: Added tensor to dataset:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ endif
+ deallocate(field_temp)
+
+ end subroutine mpas_smart_dataset_add_field_real_4d
+
+! INTERFACE mpas_smart_dataset_recv_field_real
+ subroutine mpas_smart_dataset_recv_field_real_1d(dataset, field_ptr, ierr)
+
+ type(dataset_type), intent(in) :: dataset
+ type (field1dReal), pointer, intent(in) :: field_ptr
+ integer, intent(out), optional :: ierr
+
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+ real (kind=RKIND), dimension(:), allocatable :: field_temp
+ integer, dimension(1) :: field_dims
+
+ field_dims = field_ptr % dimSizes
+ allocate(field_temp(field_dims(1)))
+
+ err_client = dataset%unpack_dataset_tensor(trim(field_ptr % fieldName), &
+ field_temp, &
+ shape(field_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'FWK: Error dataset unpack tensor:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'FWK: Added tensor to dataset:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ endif
+ deallocate(field_temp)
+
+ end subroutine mpas_smart_dataset_recv_field_real_1d
+
+ subroutine mpas_smart_dataset_recv_field_real_2d(dataset, field_ptr, ierr)
+
+ type(dataset_type), intent(in) :: dataset
+ type (field2dReal), pointer, intent(in) :: field_ptr
+ integer, intent(out), optional :: ierr
+
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+ real (kind=RKIND), dimension(:,:), allocatable :: field_temp
+ integer, dimension(2) :: field_dims
+
+ field_dims = field_ptr % dimSizes
+ allocate(field_temp(field_dims(1),field_dims(2)))
+
+ err_client = dataset%unpack_dataset_tensor(trim(field_ptr % fieldName), &
+ field_temp, &
+ shape(field_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'FWK: Error dataset unpack tensor:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'FWK: Added tensor to dataset:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ endif
+ deallocate(field_temp)
+
+ end subroutine mpas_smart_dataset_recv_field_real_2d
+
+ subroutine mpas_smart_dataset_recv_field_real_3d(dataset, field_ptr, ierr)
+
+ type(dataset_type), intent(in) :: dataset
+ type (field3dReal), pointer, intent(in) :: field_ptr
+ integer, intent(out), optional :: ierr
+
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+ real (kind=RKIND), dimension(:,:,:), allocatable :: field_temp
+ integer, dimension(3) :: field_dims
+
+ field_dims = field_ptr % dimSizes
+ allocate(field_temp(field_dims(1),field_dims(2),field_dims(3)))
+
+ err_client = dataset%unpack_dataset_tensor(trim(field_ptr % fieldName), &
+ field_temp, &
+ shape(field_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'FWK: Error dataset unpack tensor:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'FWK: Added tensor to dataset:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ endif
+ deallocate(field_temp)
+
+ end subroutine mpas_smart_dataset_recv_field_real_3d
+
+ subroutine mpas_smart_dataset_recv_field_real_4d(dataset, field_ptr, ierr)
+
+ type(dataset_type), intent(in) :: dataset
+ type (field4dReal), pointer, intent(in) :: field_ptr
+ integer, intent(out), optional :: ierr
+
+ character(len=StrKIND) :: log_string
+ integer(kind=enum_kind) :: err_client
+ real (kind=RKIND), dimension(:,:,:,:), allocatable :: field_temp
+ integer, dimension(4) :: field_dims
+
+ field_dims = field_ptr % dimSizes
+ allocate(field_temp(field_dims(1),field_dims(2),field_dims(3),field_dims(4)))
+
+ err_client = dataset%unpack_dataset_tensor(trim(field_ptr % fieldName), &
+ field_temp, &
+ shape(field_temp))
+ if (err_client /= SRNoError) then
+ WRITE(log_string,*) 'FWK: Error dataset unpack tensor:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ ierr = ior(ierr, 1)
+ else
+ WRITE(log_string,*) 'FWK: Added tensor to dataset:', trim(field_ptr % fieldName)
+ call mpas_log_write(trim(log_string))
+ endif
+ deallocate(field_temp)
+
+ end subroutine mpas_smart_dataset_recv_field_real_4d
+
+end module mpas_smart_routines
diff --git a/components/mpas-ocean/environ.sh b/components/mpas-ocean/environ.sh
new file mode 100644
index 000000000000..9ae7a8c23595
--- /dev/null
+++ b/components/mpas-ocean/environ.sh
@@ -0,0 +1,7 @@
+export SMARTREDIS_PATH=/global/cscratch1/sd/$USER/smartredis-v0.3.0/install/lib
+export LD_LIBRARY_PATH=${SMARTREDIS_PATH}:$LD_LIBRARY_PATH
+export SMARTREDIS_DEBUG_LEVEL=VERBOSE
+export SSDB=None
+
+
+source load_compass_env.sh
diff --git a/components/mpas-ocean/get_ssdb.py b/components/mpas-ocean/get_ssdb.py
new file mode 100644
index 000000000000..429d654e09e3
--- /dev/null
+++ b/components/mpas-ocean/get_ssdb.py
@@ -0,0 +1,14 @@
+import shutil, time, sys, os, subprocess, fileinput
+
+with open('/global/homes/c/cbegeman/E3SM-new/components/mpas-ocean/db_debug.log') as f:
+ lines = f.readlines()
+ for line in lines:
+ if 'SSDB' in line:
+ SSDB = line.split('=')[1]
+os.environ['SSDB'] = SSDB
+print(f'SSDB={os.environ.get("SSDB")}')
+
+with fileinput.FileInput(f'environ.sh', inplace=True,
+ backup='.bak') as f:
+ for line in f:
+ print(line.replace('export SSDB=None', f'export SSDB={SSDB}'), end='')
diff --git a/components/mpas-ocean/launch_db_for_mpaso.py b/components/mpas-ocean/launch_db_for_mpaso.py
new file mode 100644
index 000000000000..48d66cb684ef
--- /dev/null
+++ b/components/mpas-ocean/launch_db_for_mpaso.py
@@ -0,0 +1,48 @@
+from smartredis import Client
+from smartsim import Experiment
+from smartsim.database import Orchestrator
+from smartsim.log import get_logger, log_to_file
+import time
+import os
+
+BUILD_DIR="/global/homes/c/cbegeman/E3SM-new/components/mpas-ocean/"
+print('Create Experiment object')
+exp = Experiment("mpas-ocean_simulation", launcher="slurm")
+print('Create database')
+port = 6379
+db = exp.create_database(db_nodes=1,
+ batch=True,
+ port=port,
+ time="00:30:00",
+ account="e3sm",
+ partition="standard",
+ batch_args={"C":"haswell"})
+
+if os.path.exists('{}/db_debug.log'.format(BUILD_DIR)):
+ os.system('rm {}/db_debug.log'.format(BUILD_DIR))
+log_to_file('{}/db_debug.log'.format(BUILD_DIR))
+logger = get_logger('db_launcher')
+
+# define how simulation should be executed
+print('Set run settings')
+exp.generate(db, overwrite=True)
+print('Start experiment')
+exp.start(db)
+
+os.environ['SSDB'] = f"{db.hosts[0]}:{port}"
+logger.debug('SSDB={}'.format(os.environ.get('SSDB')))
+print(f"{db.hosts[0]}:{port}")
+
+print(exp.get_status(db))
+
+time.sleep(25*60)
+#client = Client(address=f"{db.hosts[0]}:{port}", cluster=False)
+#print('client initialized')
+#key_found = client.poll_key("send_array", 200, 10000)
+#print('key_found',key_found)
+#if key_found:
+# dummy_array = client.get_tensor("send_array").astype(real)
+# print('dummy_array=',dummy_array)
+#else:
+# print('key not found')
+exp.stop(db)
diff --git a/components/mpas-ocean/mpas_client_script.py b/components/mpas-ocean/mpas_client_script.py
new file mode 100644
index 000000000000..257e898aa41f
--- /dev/null
+++ b/components/mpas-ocean/mpas_client_script.py
@@ -0,0 +1,35 @@
+from smartredis import Client
+from smartsim import Experiment
+from smartsim.database import Orchestrator
+from smartsim.log import get_logger, log_to_file
+import time
+import os
+import numpy
+
+#with open('db_debug.log') as f:
+# lines = f.readlines()
+# for line in lines:
+# if 'SSDB' in line:
+# SSDB = line.split('=')[1]
+SSDB=os.environ.get("SSDB")
+print(f'SSDB in client script {SSDB}')
+client = Client(address=SSDB, cluster=False)
+
+#recv_array = 20*numpy.ones(1)
+#err = client.put_tensor("init_recv", recv_array)
+
+# Test smartsend client recv
+key_found = client.poll_key("ssh", 20, 10000)
+print('key_found',key_found)
+if key_found:
+ dummy_array = client.get_tensor("ssh")
+ print('smartsend =',dummy_array[0])
+else:
+ print('key not found')
+
+# Test dataset capabilities
+mpas_dataset = client.get_dataset('example_fortran_dataset')
+mpas_tensor = mpas_dataset.get_tensor('ssh')
+print(f'dataset_send tensor={mpas_tensor[0,0]}')
+config_mom_del2 = mpas_dataset.get_meta_scalars('config_mom_del2')
+print(f'dataset config_mom_del2={config_mom_del2}')
diff --git a/components/mpas-ocean/run_mpaso_and_script.sh b/components/mpas-ocean/run_mpaso_and_script.sh
new file mode 100644
index 000000000000..a3090f249e03
--- /dev/null
+++ b/components/mpas-ocean/run_mpaso_and_script.sh
@@ -0,0 +1,16 @@
+CASE_DIR=/global/cscratch1/sd/cbegeman/MPAS-Ocean-test-case-output/smartsim/ocean/baroclinic_channel/10km/default/
+MODEL_DIR=/global/homes/c/cbegeman/E3SM-new/components/mpas-ocean
+conda activate smartsim
+cp $MODEL_DIR/environ.sh $CASE_DIR/.
+cp $CASE_DIR/db_debug.log $MODEL_DIR/.
+cd $CASE_DIR
+python $MODEL_DIR/get_ssdb.py
+echo "completed get_ssdb"
+source $CASE_DIR/environ.sh
+echo $SSDB
+echo "running compass"
+compass run &
+
+echo "running client script"
+conda activate smartsim
+python $MODEL_DIR/mpas_client_script.py &
diff --git a/components/mpas-ocean/src/Makefile b/components/mpas-ocean/src/Makefile
index 822ed12d5409..6b5970446fe1 100644
--- a/components/mpas-ocean/src/Makefile
+++ b/components/mpas-ocean/src/Makefile
@@ -1,4 +1,4 @@
-.SUFFIXES: .F .c .o
+.SUFFIXES: .F .F90 .c .o
ifeq "$(EXCLUDE_INIT_MODE)" "true"
CPPLOCALFLAGS = -DEXCLUDE_INIT_MODE
@@ -9,6 +9,7 @@ FRAMEWORK_DIR = ../../../mpas-framework/src
OCEAN_SHARED_INCLUDES = -I$(FRAMEWORK_DIR)/framework -I$(FRAMEWORK_DIR)/external/esmf_time_f90 -I$(FRAMEWORK_DIR)/operators
OCEAN_SHARED_INCLUDES += -I$(PWD)/shared -I$(PWD)/analysis_members -I$(PWD)/mode_forward -I$(PWD)/mode_analysis
OCEAN_SHARED_INCLUDES += -I$(PWD)/BGC -I$(PWD)/MARBL/include -I$(PWD)/cvmix/src/shared -I$(PWD)/gotm/build -I$(PWD)/gotm/build/modules -I$(PWD)/SHTNS -I$(PWD)/ppr/src
+OCEAN_SHARED_INCLUDES += -I$(SMARTREDIS_PATH)/include
ifneq "$(EXCLUDE_INIT_MODE)" "true"
OCEAN_SHARED_INCLUDES += -I$(PWD)/mode_init
endif
diff --git a/components/mpas-ocean/src/Registry.xml b/components/mpas-ocean/src/Registry.xml
index 601d2d6184f0..ce361bed9353 100644
--- a/components/mpas-ocean/src/Registry.xml
+++ b/components/mpas-ocean/src/Registry.xml
@@ -164,6 +164,10 @@
possible_values="Any positive integer value greater than 0."
mode="forward;analysis;init"
/>
+
+
+
+
domain % blocklist
+ if (config_use_smartsim) then
+ call mpas_smart_client_init(client, ierr)
+ if (ierr /= 0) then
+ call mpas_log_write('Error initializing smartredis client', &
+ MPAS_LOG_CRIT)
+ endif
+
+ ! ---- Example: Send config option to client ----
+ ! configName = 'config_mom_del2'
+ ! call mpas_smart_config_send(domain, configName, ierr)
+ ! if (ierr /= 0) then
+ ! call mpas_log_write('Error: Smartsim put config at initialization')
+ ! endif
+
+ allocate(sendArrayReal1d(1), recvArrayReal1d(1))
+ allocate(sendArrayReal2d(1,1), recvArrayReal2d(1,1))
+ sendArrayReal1d(:) = 2.0_RKIND
+ recvArrayReal1d(:) = 0.0_RKIND
+ sendArrayReal2d(1,1) = 2.0_RKIND
+ recvArrayReal2d(1,1) = 0.0_RKIND
+ script_in_key = 'init_send_script'
+ script_out_key = 'init_recv_script'
+ inputs(1) = script_in_key
+ outputs(1) = script_out_key
+ allocate(sendArrayReal4d(1,1,28,28))
+ call random_number(sendArrayReal4d)
+ !sendArrayReal4d(:,:,:,:) = 2.0_RKIND
+ err_client = client%put_tensor(script_in_key, sendArrayReal4d, shape(sendArrayReal4d))
+ if (err_client /= SRNoError) then
+ write(log_string,*) 'Error put tensor for script:',err_client
+ call mpas_log_write(log_string)
+ else
+ call mpas_log_write('Put tensor for script set')
+ endif
+ !err_client = client%set_script_from_file(script_key, "CPU", script_file)
+ !if (err_client /= SRNoError) then
+ ! write(log_string,*) 'Error setting client script:',err_client
+ ! call mpas_log_write(log_string)
+ !else
+ ! call mpas_log_write('Client script set')
+ !endif
+ !err_client = client%run_script(script_key, "pre_process", inputs, outputs)
+ !if (err_client /= SRNoError) then
+ ! write(log_string,*) 'Error running script pre_process:',err_client
+ ! call mpas_log_write(log_string)
+ ! is_error = client%SR_error_parser(err_client)
+ !else
+ ! call mpas_log_write('Pre_process script run')
+ !endif
+ !err_client = client%run_script(script_key, "post_process", inputs, outputs)
+ !if (err_client /= SRNoError) then
+ ! write(log_string,*) 'Error running script post_process:',err_client
+ ! call mpas_log_write(log_string)
+ ! is_error = client%SR_error_parser(err_client)
+ !else
+ ! call mpas_log_write('Post_process script run')
+ !endif
+
+ datasetName = 'example_fortran_dataset'
+ call mpas_smart_dataset_init(datasetName, dataset, ierr)
+ fieldName = 'ssh'
+
+ ! Add a tensor to the dataset and verify that we can retrieve it
+ call mpas_smart_dataset_add_field(dataset, domain, fieldName, ierr)
+ if (ierr /= 0) then
+ call mpas_log_write('dataset%add_tensor failed')
+ endif
+ call mpas_smart_dataset_recv_field(dataset, domain, fieldName, ierr)
+ if (ierr /= 0) then
+ call mpas_log_write('dataset%unpack_dataset_tensor failed')
+ endif
+ configName = 'config_mom_del2'
+ call mpas_smart_dataset_config_send(dataset, domain, configName, ierr)
+ if (ierr /= 0) then
+ call mpas_log_write('dataset%add_meta_scalar failed')
+ endif
+ call mpas_smart_dataset_config_recv(dataset, domain, configName, ierr)
+ if (ierr /= 0) then
+ call mpas_log_write('dataset%get_meta_scalar failed')
+ endif
+ call mpas_smart_dataset_put(dataset, ierr)
+ if (err_client .ne. SRNoError) then
+ write(log_string,*) 'client%put_dataset failed:',err_client
+ call mpas_log_write(log_string)
+ else
+ call mpas_log_write('Dataset put')
+ endif
+
+ endif
+
!-----------------------------------------------------------------
! Initialize data from external file input
!-----------------------------------------------------------------
@@ -506,6 +624,28 @@ function ocn_forward_mode_init(domain, startTimeStamp) result(ierr)!{{{
MPAS_LOG_ERR, masterOnly=.true., flushNow=.true.)
return
endif
+ !call mpas_timer_start('smartsend_init')
+
+ !! Since we use diagnostics_variables module, we do not need to fetch variables from pools
+ !call mpas_log_write('Start smartsend at init')
+ !err_client = client%put_tensor("init_send_array", sendArrayReal1d, shape(sendArrayReal1d))
+ !if (err_client /= SRNoError) then
+ ! write(log_string,*) 'client%put_tensor failed with err:',err_client
+ ! call mpas_log_write(log_string)
+ !else
+ ! call mpas_log_write('client%put_tensor successful')!TODO test pointer
+ !endif
+ !err_client = client%unpack_tensor("init_recv_array", recvArrayReal0d, shape(recvArrayReal0d))
+ !if (err_client /= SRNoError) then
+ ! write(log_string,*) 'client%unpack_tensor failed with err:',err_client
+ ! call mpas_log_write(log_string)
+ !else
+ ! write(log_string,*) 'client%unpack_tensor succeeded:',recvArrayReal0d
+ ! call mpas_log_write(log_string)
+ !endif
+ !call mpas_log_write('End smartsend at init')
+
+ !call mpas_timer_stop('smartsend_init')
!--------------------------------------------------------------------
@@ -609,6 +749,11 @@ function ocn_forward_mode_run(domain) result(ierr)!{{{
type (MPAS_timeInterval_type) :: timeStep
+ logical :: validField
+ logical :: isActive
+ character(len=StrKind) :: fieldName
+ character(len=StrKIND) :: log_string
+
ierr = 0
! Eventually, dt should be domain specific
@@ -779,6 +924,32 @@ function ocn_forward_mode_run(domain) result(ierr)!{{{
call mpas_stream_mgr_write(domain % streamManager, streamID='restart', ierr=ierr)
call mpas_timer_stop('io_write')
+ !Note: these commands will get the field and not field%array
+ ! TODO LATER: Move variable names into a stream and ensure that the array dimensions of
+ ! the variable being sent to the database node match that of the source array
+ ! Loop through variable names in stream and get from allFields rather
+ ! than hard-code variables in diagnosticsPool
+ call mpas_timer_start('smartsim i/o')
+ call MPAS_stream_mgr_begin_iteration(domain%streamManager, &
+ 'smartsend', ierr)
+ do while (MPAS_stream_mgr_get_next_field(domain%streamManager, &
+ 'smartsend', fieldName))
+ call mpas_smart_field_send(domain, fieldName, ierr)
+ if (ierr /= 0.0_RKIND) then
+ call mpas_log_write('MPAS I/O error in smartsend stream')
+ endif
+ end do
+ call MPAS_stream_mgr_begin_iteration(domain%streamManager, &
+ 'smartrecv', ierr)
+ do while (MPAS_stream_mgr_get_next_field(domain%streamManager, &
+ 'smartrecv', fieldName))
+ call mpas_smart_field_recv(domain, fieldName, ierr)
+ if (ierr /= 0.0_RKIND) then
+ call mpas_log_write('MPAS I/O error in smartrecv stream')
+ endif
+ end do
+ call mpas_timer_stop('smartsim i/o')
+
call mpas_timer_start('reset_io_alarms')
call mpas_stream_mgr_reset_alarms(domain % streamManager, streamID='restart', ierr=ierr)
@@ -845,7 +1016,7 @@ end function ocn_forward_mode_run!}}}
function ocn_forward_mode_finalize(domain) result(iErr)!{{{
type (domain_type), intent(inout) :: domain
-
+ character(len=100) :: log_string
integer :: ierr
! destroy the ocean mesh structure
diff --git a/components/mpas-ocean/src/mode_forward/test_client_recv.txt b/components/mpas-ocean/src/mode_forward/test_client_recv.txt
new file mode 100644
index 000000000000..57a79087918b
--- /dev/null
+++ b/components/mpas-ocean/src/mode_forward/test_client_recv.txt
@@ -0,0 +1,2 @@
+def init_send(inp):
+ return [8.0]
diff --git a/components/mpas-ocean/test_client_recv.py b/components/mpas-ocean/test_client_recv.py
new file mode 100644
index 000000000000..dca6bf080b78
--- /dev/null
+++ b/components/mpas-ocean/test_client_recv.py
@@ -0,0 +1,4 @@
+def init_send(inputs):
+ #temp = inputs.float() * 2.0
+ temp = [2.0]
+ return temp
diff --git a/components/mpas-ocean/test_client_recv.txt b/components/mpas-ocean/test_client_recv.txt
new file mode 100644
index 000000000000..00e8b54e21b2
--- /dev/null
+++ b/components/mpas-ocean/test_client_recv.txt
@@ -0,0 +1,3 @@
+
+def init_send(inp):
+ return [8.0]