diff --git a/src/Makefile.in.ACME b/src/Makefile.in.ACME
index 3e5f6821a9..00b83569c6 100644
--- a/src/Makefile.in.ACME
+++ b/src/Makefile.in.ACME
@@ -41,7 +41,6 @@ RM = rm -f
CPP = cpp -P -traditional
FC=$(MPIFC)
CC=$(MPICC)
-CXX=$(MPICXX)
NETCDF=$(NETCDF_PATH)
PNETCDF=$(PNETCDF_PATH)
PIO=$(EXEROOT)/pio
@@ -71,7 +70,7 @@ all:
@echo $(CPPINCLUDES)
@echo $(FCINCLUDES)
( $(MAKE) mpas RM="$(RM)" CPP="$(CPP)" NETCDF="$(NETCDF)" PNETCDF="$(PNETCDF)" \
- PIO="$(PIO)" FC="$(FC)" CC="$(CC)" CXX="$(CXX)" SFC="$(SFC)" SCC="$(SCC)" \
+ PIO="$(PIO)" FC="$(FC)" CC="$(CC)" SFC="$(SFC)" SCC="$(SCC)" \
CPPFLAGS="$(CPPFLAGS)" CPPINCLUDES="$(CPPINCLUDES)" FCINCLUDES="$(FCINCLUDES)" \
FFLAGS="$(FFLAGS)" CFLAGS="$(CFLAGS)" LDFLAGS="$(LDFLAGS)" )
@@ -83,7 +82,7 @@ mpas: externals frame ops dycore drver
ar ru lib$(COMPONENT).a $(DRIVER)/*.o
externals:
- ( cd external; $(MAKE) FC="$(FC)" SFC="$(SFC)" CC="$(CC)" CXX="$(CXX)" SCC="$(SCC)" FFLAGS="$(FFLAGS)" CFLAGS="$(CFLAGS)" CPP="$(CPP)" NETCDF="$(NETCDF)" CORE="$(CORE)" ezxml-lib )
+ ( cd external; $(MAKE) FC="$(FC)" SFC="$(SFC)" CC="$(CC)" SCC="$(SCC)" FFLAGS="$(FFLAGS)" CFLAGS="$(CFLAGS)" CPP="$(CPP)" NETCDF="$(NETCDF)" CORE="$(CORE)" ezxml-lib )
drver: externals frame ops dycore
( cd $(DRIVER); $(MAKE) CPPFLAGS="$(CPPFLAGS)" CPPINCLUDES="$(CPPINCLUDES)" FREEFLAGS="$(FREEFLAGS)" all )
diff --git a/src/Makefile.in.CESM b/src/Makefile.in.CESM
index 3e5f6821a9..00b83569c6 100644
--- a/src/Makefile.in.CESM
+++ b/src/Makefile.in.CESM
@@ -41,7 +41,6 @@ RM = rm -f
CPP = cpp -P -traditional
FC=$(MPIFC)
CC=$(MPICC)
-CXX=$(MPICXX)
NETCDF=$(NETCDF_PATH)
PNETCDF=$(PNETCDF_PATH)
PIO=$(EXEROOT)/pio
@@ -71,7 +70,7 @@ all:
@echo $(CPPINCLUDES)
@echo $(FCINCLUDES)
( $(MAKE) mpas RM="$(RM)" CPP="$(CPP)" NETCDF="$(NETCDF)" PNETCDF="$(PNETCDF)" \
- PIO="$(PIO)" FC="$(FC)" CC="$(CC)" CXX="$(CXX)" SFC="$(SFC)" SCC="$(SCC)" \
+ PIO="$(PIO)" FC="$(FC)" CC="$(CC)" SFC="$(SFC)" SCC="$(SCC)" \
CPPFLAGS="$(CPPFLAGS)" CPPINCLUDES="$(CPPINCLUDES)" FCINCLUDES="$(FCINCLUDES)" \
FFLAGS="$(FFLAGS)" CFLAGS="$(CFLAGS)" LDFLAGS="$(LDFLAGS)" )
@@ -83,7 +82,7 @@ mpas: externals frame ops dycore drver
ar ru lib$(COMPONENT).a $(DRIVER)/*.o
externals:
- ( cd external; $(MAKE) FC="$(FC)" SFC="$(SFC)" CC="$(CC)" CXX="$(CXX)" SCC="$(SCC)" FFLAGS="$(FFLAGS)" CFLAGS="$(CFLAGS)" CPP="$(CPP)" NETCDF="$(NETCDF)" CORE="$(CORE)" ezxml-lib )
+ ( cd external; $(MAKE) FC="$(FC)" SFC="$(SFC)" CC="$(CC)" SCC="$(SCC)" FFLAGS="$(FFLAGS)" CFLAGS="$(CFLAGS)" CPP="$(CPP)" NETCDF="$(NETCDF)" CORE="$(CORE)" ezxml-lib )
drver: externals frame ops dycore
( cd $(DRIVER); $(MAKE) CPPFLAGS="$(CPPFLAGS)" CPPINCLUDES="$(CPPINCLUDES)" FREEFLAGS="$(FREEFLAGS)" all )
diff --git a/src/core_ocean/.gitignore b/src/core_ocean/.gitignore
index 91183f2924..e12616ecd7 100644
--- a/src/core_ocean/.gitignore
+++ b/src/core_ocean/.gitignore
@@ -1,6 +1,8 @@
# Ignore all cvmix code.
cvmix
.cvmix_all
+BGC
+.BGC_all
.*.zip
# Ignore processed registry files.
diff --git a/src/core_ocean/Makefile b/src/core_ocean/Makefile
index b5a10764ce..d0bd3b9203 100644
--- a/src/core_ocean/Makefile
+++ b/src/core_ocean/Makefile
@@ -2,11 +2,12 @@
OCEAN_SHARED_INCLUDES = -I$(PWD)/../framework -I$(PWD)/../external/esmf_time_f90 -I$(PWD)/../operators
-OCEAN_SHARED_INCLUDES += -I$(PWD)/shared -I$(PWD)/analysis_members -I$(PWD)/cvmix -I$(PWD)/mode_forward -I$(PWD)/mode_analysis
+OCEAN_SHARED_INCLUDES += -I$(PWD)/BGC -I$(PWD)/shared -I$(PWD)/analysis_members -I$(PWD)/cvmix -I$(PWD)/mode_forward -I$(PWD)/mode_analysis -I$(PWD)/mode_init
-all: shared libcvmix analysis_members
+all: shared libcvmix analysis_members libBGC
(cd mode_forward; $(MAKE) FCINCLUDES="$(FCINCLUDES) $(OCEAN_SHARED_INCLUDES)" all )
(cd mode_analysis; $(MAKE) FCINCLUDES="$(FCINCLUDES) $(OCEAN_SHARED_INCLUDES)" all )
+ (cd mode_init; $(MAKE) FCINCLUDES="$(FCINCLUDES) $(OCEAN_SHARED_INCLUDES)" all )
(cd driver; $(MAKE) FCINCLUDES="$(FCINCLUDES) $(OCEAN_SHARED_INCLUDES)" all )
if [ -e libdycore.a ]; then \
($(RM) libdycore.a) \
@@ -21,9 +22,11 @@ core_input_gen:
(cd default_inputs; $(NL_GEN) ../Registry_processed.xml namelist.ocean )
(cd default_inputs; $(NL_GEN) ../Registry_processed.xml namelist.ocean.forward mode=forward )
(cd default_inputs; $(NL_GEN) ../Registry_processed.xml namelist.ocean.analysis mode=analysis )
+ (cd default_inputs; $(NL_GEN) ../Registry_processed.xml namelist.ocean.init mode=init )
(cd default_inputs; $(ST_GEN) ../Registry_processed.xml streams.ocean stream_list.ocean. mutable )
(cd default_inputs; $(ST_GEN) ../Registry_processed.xml streams.ocean.forward stream_list.ocean.forward. mutable mode=forward )
(cd default_inputs; $(ST_GEN) ../Registry_processed.xml streams.ocean.analysis stream_list.ocean.analysis. mutable mode=analysis )
+ (cd default_inputs; $(ST_GEN) ../Registry_processed.xml streams.ocean.init stream_list.ocean.init. mutable mode=init )
gen_includes:
$(CPP) $(CPPFLAGS) $(CPPINCLUDES) Registry.xml > Registry_processed.xml
@@ -33,11 +36,22 @@ gen_includes:
post_build:
if [ ! -e $(ROOT_DIR)/default_inputs ]; then mkdir $(ROOT_DIR)/default_inputs; fi
cp default_inputs/* $(ROOT_DIR)/default_inputs/.
- ( cd $(ROOT_DIR)/default_inputs; for FILE in `ls -1`; do if [ ! -e ../$$FILE ]; then cp $$FILE ../.; fi; done )
+ ( cp $(ROOT_DIR)/default_inputs/namelist.ocean $(ROOT_DIR)/namelist.ocean )
+ ( cp $(ROOT_DIR)/default_inputs/namelist.ocean.forward $(ROOT_DIR)/namelist.ocean.forward )
+ ( cp $(ROOT_DIR)/default_inputs/namelist.ocean.analysis $(ROOT_DIR)/namelist.ocean.analysis )
+ ( cp $(ROOT_DIR)/default_inputs/namelist.ocean.init $(ROOT_DIR)/namelist.ocean.init )
+ ( cp $(ROOT_DIR)/default_inputs/streams.ocean $(ROOT_DIR)/streams.ocean )
+ ( cp $(ROOT_DIR)/default_inputs/streams.ocean.forward $(ROOT_DIR)/streams.ocean.forward )
+ ( cp $(ROOT_DIR)/default_inputs/streams.ocean.analysis $(ROOT_DIR)/streams.ocean.analysis )
+ ( cp $(ROOT_DIR)/default_inputs/streams.ocean.init $(ROOT_DIR)/streams.ocean.init )
cvmix_source: get_cvmix.sh
(chmod a+x get_cvmix.sh; ./get_cvmix.sh)
- (cd cvmix; make clean)
+ (cd cvmix)
+
+BGC_source: get_BGC.sh
+ (chmod a+x get_BGC.sh; ./get_BGC.sh)
+ (cd BGC)
libcvmix: cvmix_source
if [ -d cvmix ]; then \
@@ -46,7 +60,14 @@ libcvmix: cvmix_source
(exit 1) \
fi
-shared: libcvmix
+libBGC: BGC_source
+ if [ -d BGC ]; then \
+ (cd BGC; make all FC="$(FC)" FCFLAGS="$(FFLAGS)" FINCLUDES="$(FINCLUDES)") \
+ else \
+ (exit 1) \
+ fi
+
+shared: libcvmix libBGC
(cd shared; $(MAKE) FCINCLUDES="$(FCINCLUDES) $(OCEAN_SHARED_INCLUDES)")
analysis_members: libcvmix shared
@@ -56,8 +77,15 @@ clean:
if [ -d cvmix ]; then \
(cd cvmix; make clean) \
fi
+ if [ -d inc ]; then \
+ ($(RM) -r inc) \
+ fi
+ if [ -d BGC ]; then \
+ (cd BGC; make clean) \
+ fi
(cd mode_forward; $(MAKE) clean)
(cd mode_analysis; $(MAKE) clean)
+ (cd mode_init; $(MAKE) clean)
(cd driver; $(MAKE) clean)
(cd analysis_members; $(MAKE) clean)
(cd shared; $(MAKE) clean)
diff --git a/src/core_ocean/Registry.xml b/src/core_ocean/Registry.xml
index 72fbfa710f..998774ba07 100644
--- a/src/core_ocean/Registry.xml
+++ b/src/core_ocean/Registry.xml
@@ -5,9 +5,15 @@
+
+
@@ -20,6 +26,9 @@
+
@@ -38,21 +47,45 @@
-
+
+
+
+
+
+
+
+
-
+
@@ -90,15 +123,19 @@
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -151,10 +248,6 @@
description="Maximum thickness allowed. This is a factor times the resting thickness, i.e., maximum thickness = config_max_thickness_factor*$h^{rest}$."
possible_values="any positive real value, but typically 2-4."
/>
-
-
+
-
-
@@ -249,6 +338,10 @@
description="Coefficient for horizontal biharmonic operator on momentum."
possible_values="any positive real"
/>
+
-
@@ -417,7 +510,7 @@
description="Prandtl number to be used within the CVMix parameterization suite"
possible_values="Any non-negative real value."
/>
-
@@ -529,53 +622,155 @@
description="The thickness over which to average when computing surface-averaged velocity and buoyancy"
possible_values="Any positive real value, but typically should be between 1 and 20 meters"
/>
+
-
-
-
-
-
+
-
-
-
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
-
-
+
-
+
-
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
-
-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
@@ -921,15 +1317,20 @@
-
+
+
-
+
+
+
+
-
-
+
@@ -962,6 +1363,65 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
+
@@ -1093,15 +1526,18 @@
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
+
-
+
+
+
+
+
+
+
-
-
-
-
-
@@ -1174,7 +1607,7 @@
description="layer thickness"
/>
@@ -1187,6 +1620,12 @@
packages="thicknessFilter"
/>
+
+
+
+
+
+
+
+
-
-
@@ -1437,6 +1882,10 @@
+
-
-
-
-
-
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
@@ -1777,7 +2228,7 @@
+ />
-
+
@@ -1813,14 +2264,6 @@
description="CVMix/KPP: diagnosed surface friction velocity defined as square root of (mag(wind stress) / reference density)"
packages="forwardMode;analysisMode"
/>
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
-
-
-
-
-
+
+
+
-
-
@@ -2005,29 +2433,30 @@
constituent fields, depending on the forcing options selected.
********************************************************************* -->
-
-
-
-
-
-
-
+
+
+
+ />
-
-
-
-
-
+
+
-
-
-
-
-
-
@@ -2153,15 +2555,12 @@
packages="forwardMode;analysisMode"
/>
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
-
-
@@ -2218,90 +2703,90 @@
type="real" dimensions="nVertLevels nCells Time" units="kg m^{-3}"
description="Density computed by displacing SST and SSS to every vertical layer within the column"
/>
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
@@ -2396,7 +2881,254 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#include "mode_init/Registry.xml"
+#include "tracer_groups/Registry_tracers.xml"
#include "analysis_members/Registry_analysis_members.xml"
diff --git a/src/core_ocean/analysis_members/Makefile b/src/core_ocean/analysis_members/Makefile
index 1b6097cabb..123f73684b 100644
--- a/src/core_ocean/analysis_members/Makefile
+++ b/src/core_ocean/analysis_members/Makefile
@@ -10,7 +10,20 @@ MEMBERS = mpas_ocn_global_stats.o \
mpas_ocn_meridional_heat_transport.o \
mpas_ocn_test_compute_interval.o \
mpas_ocn_high_frequency_output.o \
- mpas_ocn_zonal_mean.o
+ mpas_ocn_zonal_mean.o \
+ mpas_ocn_lagrangian_particle_tracking_interpolations.o \
+ mpas_ocn_particle_list.o \
+ mpas_ocn_lagrangian_particle_tracking_reset.o \
+ mpas_ocn_lagrangian_particle_tracking.o \
+ mpas_ocn_eliassen_palm.o \
+ mpas_ocn_time_filters.o \
+ mpas_ocn_mixed_layer_depths.o \
+ mpas_ocn_pointwise_stats.o \
+ mpas_ocn_debug_diagnostics.o \
+ mpas_ocn_time_series_stats.o \
+ mpas_ocn_regional_stats.o \
+ mpas_ocn_rpn_calculator.o \
+ mpas_ocn_moc_streamfunction.o
all: $(OBJS)
@@ -18,6 +31,12 @@ mpas_ocn_analysis_driver.o: $(MEMBERS)
mpas_ocn_okubo_weiss.o: mpas_ocn_okubo_weiss_eigenvalues.o
+mpas_ocn_particle_list.o:
+
+mpas_ocn_lagrangian_particle_tracking_reset.o:
+
+mpas_ocn_lagrangian_particle_tracking.o: mpas_ocn_particle_list.o mpas_ocn_lagrangian_particle_tracking_interpolations.o mpas_ocn_lagrangian_particle_tracking_reset.o
+
clean:
$(RM) *.o *.i *.mod *.f90
@@ -25,9 +44,9 @@ clean:
$(RM) $@ $*.mod
ifeq "$(GEN_F90)" "true"
$(CPP) $(CPPFLAGS) $(CPPINCLUDES) $< > $*.f90
- $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES)
+ $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES)
else
- $(FC) $(CPPFLAGS) $(FFLAGS) -c $*.F $(CPPINCLUDES) $(FCINCLUDES)
+ $(FC) $(CPPFLAGS) $(FFLAGS) -c $*.F $(CPPINCLUDES) $(FCINCLUDES)
endif
.c.o:
diff --git a/src/core_ocean/analysis_members/Registry_TEMPLATE.xml b/src/core_ocean/analysis_members/Registry_TEMPLATE.xml
index 7781514365..e7ce072525 100644
--- a/src/core_ocean/analysis_members/Registry_TEMPLATE.xml
+++ b/src/core_ocean/analysis_members/Registry_TEMPLATE.xml
@@ -16,7 +16,7 @@
description="Timestamp determining how often analysis member computation should be performed."
possible_values="Any valid time stamp, 'dt', or 'output_interval'"
/>
-
@@ -50,8 +50,8 @@
packages="temPlateAMPKG"
clobber_mode="truncate"
runtime_format="single_file">
-
-
-
+
+
+
diff --git a/src/core_ocean/analysis_members/Registry_analysis_members.xml b/src/core_ocean/analysis_members/Registry_analysis_members.xml
index 8359f533a9..1575def308 100644
--- a/src/core_ocean/analysis_members/Registry_analysis_members.xml
+++ b/src/core_ocean/analysis_members/Registry_analysis_members.xml
@@ -7,3 +7,13 @@
#include "Registry_meridional_heat_transport.xml"
#include "Registry_test_compute_interval.xml"
#include "Registry_high_frequency_output.xml"
+#include "Registry_time_filters.xml"
+#include "Registry_lagrangian_particle_tracking.xml"
+#include "Registry_eliassen_palm.xml"
+#include "Registry_mixed_layer_depths.xml"
+#include "Registry_regional_stats.xml"
+#include "Registry_time_series_stats.xml"
+#include "Registry_pointwise_stats.xml"
+#include "Registry_debug_diagnostics.xml"
+#include "Registry_rpn_calculator.xml"
+#include "Registry_moc_streamfunction.xml"
diff --git a/src/core_ocean/analysis_members/Registry_debug_diagnostics.xml b/src/core_ocean/analysis_members/Registry_debug_diagnostics.xml
new file mode 100644
index 0000000000..67a5917de1
--- /dev/null
+++ b/src/core_ocean/analysis_members/Registry_debug_diagnostics.xml
@@ -0,0 +1,45 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/analysis_members/Registry_eliassen_palm.xml b/src/core_ocean/analysis_members/Registry_eliassen_palm.xml
new file mode 100644
index 0000000000..80bce671ad
--- /dev/null
+++ b/src/core_ocean/analysis_members/Registry_eliassen_palm.xml
@@ -0,0 +1,691 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/analysis_members/Registry_global_stats.xml b/src/core_ocean/analysis_members/Registry_global_stats.xml
index 2332939a3a..5c9abf3f5e 100644
--- a/src/core_ocean/analysis_members/Registry_global_stats.xml
+++ b/src/core_ocean/analysis_members/Registry_global_stats.xml
@@ -23,7 +23,7 @@
description="subdirectory to write eddy census text files"
possible_values="any valid directory name"
/>
-
@@ -32,6 +32,30 @@
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/analysis_members/Registry_high_frequency_output.xml b/src/core_ocean/analysis_members/Registry_high_frequency_output.xml
index fa992c2c54..6b4ab95b5a 100644
--- a/src/core_ocean/analysis_members/Registry_high_frequency_output.xml
+++ b/src/core_ocean/analysis_members/Registry_high_frequency_output.xml
@@ -7,7 +7,7 @@
description="Timestamp determining how often analysis member computation should be performed."
possible_values="Any valid time stamp, 'dt', or 'output_interval'"
/>
-
@@ -27,14 +27,26 @@
+
+
-
-
+
+
+
-
@@ -52,8 +64,10 @@
+
+
-
+
diff --git a/src/core_ocean/analysis_members/Registry_lagrangian_particle_tracking.xml b/src/core_ocean/analysis_members/Registry_lagrangian_particle_tracking.xml
new file mode 100644
index 0000000000..abc990274b
--- /dev/null
+++ b/src/core_ocean/analysis_members/Registry_lagrangian_particle_tracking.xml
@@ -0,0 +1,398 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/analysis_members/Registry_layer_volume_weighted_averages.xml b/src/core_ocean/analysis_members/Registry_layer_volume_weighted_averages.xml
index 4a3ba39a9e..9ea44bdddf 100644
--- a/src/core_ocean/analysis_members/Registry_layer_volume_weighted_averages.xml
+++ b/src/core_ocean/analysis_members/Registry_layer_volume_weighted_averages.xml
@@ -23,7 +23,7 @@
description="Logical flag determining if an analysis member output write occurs on start-up."
possible_values=".true. or .false."
/>
-
@@ -354,6 +354,7 @@
-
@@ -56,6 +56,7 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/analysis_members/Registry_moc_streamfunction.xml b/src/core_ocean/analysis_members/Registry_moc_streamfunction.xml
new file mode 100644
index 0000000000..cc12f90dc9
--- /dev/null
+++ b/src/core_ocean/analysis_members/Registry_moc_streamfunction.xml
@@ -0,0 +1,108 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/analysis_members/Registry_okubo_weiss.xml b/src/core_ocean/analysis_members/Registry_okubo_weiss.xml
index 951136698d..e0819dda81 100644
--- a/src/core_ocean/analysis_members/Registry_okubo_weiss.xml
+++ b/src/core_ocean/analysis_members/Registry_okubo_weiss.xml
@@ -27,7 +27,7 @@
description="Time stamp for frequency of computation of the okubo weiss analysis member."
possible_values="Any time stamp, 'dt', or 'output_interval'"
/>
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/analysis_members/Registry_regional_stats.xml b/src/core_ocean/analysis_members/Registry_regional_stats.xml
new file mode 100644
index 0000000000..c1facf150f
--- /dev/null
+++ b/src/core_ocean/analysis_members/Registry_regional_stats.xml
@@ -0,0 +1,173 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/analysis_members/Registry_rpn_calculator.xml b/src/core_ocean/analysis_members/Registry_rpn_calculator.xml
new file mode 100644
index 0000000000..7dbbb73eea
--- /dev/null
+++ b/src/core_ocean/analysis_members/Registry_rpn_calculator.xml
@@ -0,0 +1,156 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/analysis_members/Registry_surface_area_weighted_averages.xml b/src/core_ocean/analysis_members/Registry_surface_area_weighted_averages.xml
index 77112b2d73..25954e058f 100644
--- a/src/core_ocean/analysis_members/Registry_surface_area_weighted_averages.xml
+++ b/src/core_ocean/analysis_members/Registry_surface_area_weighted_averages.xml
@@ -23,7 +23,7 @@
description="Time interval the determines how frequently the surface area weighted averages analysis member should be computed."
possible_values="Any valid time stamp, 'dt', or 'output_interval'"
/>
-
@@ -348,6 +348,7 @@
-
diff --git a/src/core_ocean/analysis_members/Registry_time_filters.xml b/src/core_ocean/analysis_members/Registry_time_filters.xml
new file mode 100644
index 0000000000..55f5288935
--- /dev/null
+++ b/src/core_ocean/analysis_members/Registry_time_filters.xml
@@ -0,0 +1,117 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/analysis_members/Registry_time_series_stats.xml b/src/core_ocean/analysis_members/Registry_time_series_stats.xml
new file mode 100644
index 0000000000..eefbd81ca9
--- /dev/null
+++ b/src/core_ocean/analysis_members/Registry_time_series_stats.xml
@@ -0,0 +1,159 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/analysis_members/Registry_water_mass_census.xml b/src/core_ocean/analysis_members/Registry_water_mass_census.xml
index 277da0089d..d13c53b2b7 100644
--- a/src/core_ocean/analysis_members/Registry_water_mass_census.xml
+++ b/src/core_ocean/analysis_members/Registry_water_mass_census.xml
@@ -24,7 +24,7 @@
description="Timestamp determining how often analysis member computation should be performed."
possible_values="Any valid time stamp, 'dt', or 'output_interval'"
/>
-
@@ -90,6 +90,7 @@
-
diff --git a/src/core_ocean/analysis_members/mpas_ocn_TEMPLATE.F b/src/core_ocean/analysis_members/mpas_ocn_TEMPLATE.F
index 898d67edd3..30a0007abc 100644
--- a/src/core_ocean/analysis_members/mpas_ocn_TEMPLATE.F
+++ b/src/core_ocean/analysis_members/mpas_ocn_TEMPLATE.F
@@ -20,11 +20,11 @@
!> cp Registry_ocn_TEMPLATE.xml Registry_ocn_your_new_name.xml
!>
!> 2. In those two new files, replace the following text:
-!> tempLate, TEM_PLATE, FILL_IN_AUTHOR, FILL_IN_DATE
-!> Typically tempLate uses camel case (variable names), like yourNewName,
+!> temPlate, TEM_PLATE, FILL_IN_AUTHOR, FILL_IN_DATE
+!> Typically temPlate uses camel case (variable names), like yourNewName,
!> while TEM_PLATE uses underscores (subroutine names), like your_new_name.
!> note: do not replace 'filename_template' in Registry_ocn_yourNewName.xml
-!>
+!>
!> 3. Add a #include line for your registry to
!> Registry_analysis_members.xml
!>
@@ -36,10 +36,10 @@
!> - Adding a compute if test can subroutine call
!> - Adding a restart if test can subroutine call
!> - Adding a finalize if test can subroutine call
-!>
+!>
!> 5. In src/core_ocean/analysis_members/Makefile, add your
!> new analysis member to the list of members. See another analysis member
-!> in that file for an example.
+!> in that file for an example.
!> NOTE: If your analysis member depends on other files, add a dependency
!> line for the member and list them there. See okubo weiss for an example.
!>
@@ -237,7 +237,7 @@ subroutine ocn_compute_TEM_PLATE(domain, timeLevel, err)!{{{
end do
! mpi gather/scatter calls may be placed here.
- ! Here are some examples. See mpas_oac_global_stats.F for further details.
+ ! Here are some examples. See mpas_ocn_global_stats.F for further details.
! call mpas_dmpar_sum_real_array(dminfo, nVariables, sumSquares(1:nVariables), reductions(1:nVariables))
! call mpas_dmpar_min_real_array(dminfo, nMins, mins(1:nMins), reductions(1:nMins))
! call mpas_dmpar_max_real_array(dminfo, nMaxes, maxes(1:nMaxes), reductions(1:nMaxes))
diff --git a/src/core_ocean/analysis_members/mpas_ocn_analysis_driver.F b/src/core_ocean/analysis_members/mpas_ocn_analysis_driver.F
index 5503c7144d..dbeb57bc2c 100644
--- a/src/core_ocean/analysis_members/mpas_ocn_analysis_driver.F
+++ b/src/core_ocean/analysis_members/mpas_ocn_analysis_driver.F
@@ -33,8 +33,18 @@ module ocn_analysis_driver
use ocn_okubo_weiss
use ocn_water_mass_census
use ocn_meridional_heat_transport
+ use ocn_moc_streamfunction
use ocn_test_compute_interval
use ocn_high_frequency_output
+ use ocn_time_filters
+ use ocn_lagrangian_particle_tracking
+ use ocn_eliassen_palm
+ use ocn_mixed_layer_depths
+ use ocn_time_series_stats
+ use ocn_pointwise_stats
+ use ocn_debug_diagnostics
+ use ocn_regional_stats
+ use ocn_rpn_calculator
! use ocn_TEM_PLATE
implicit none
@@ -54,6 +64,7 @@ module ocn_analysis_driver
!--------------------------------------------------------------------
public :: ocn_analysis_setup_packages, &
+ ocn_analysis_bootstrap, &
ocn_analysis_init, &
ocn_analysis_compute_startup, &
ocn_analysis_compute, &
@@ -68,8 +79,10 @@ module ocn_analysis_driver
!--------------------------------------------------------------------
+ character (len=*), parameter :: initReadTimerPrefix = 'init_read_'
character (len=*), parameter :: initTimerPrefix = 'init_'
character (len=*), parameter :: computeTimerPrefix = 'compute_'
+ character (len=*), parameter :: computeStartupTimerPrefix = 'compute_startup_'
character (len=*), parameter :: writeTimerPrefix = 'write_'
character (len=*), parameter :: alarmTimerPrefix = 'reset_alarm_'
character (len=*), parameter :: restartTimerPrefix = 'restart_'
@@ -94,7 +107,7 @@ module ocn_analysis_driver
!
!-----------------------------------------------------------------------
- subroutine ocn_analysis_setup_packages(configPool, packagePool, err)!{{{
+ subroutine ocn_analysis_setup_packages(configPool, packagePool, iocontext, err)!{{{
!-----------------------------------------------------------------
!
@@ -102,8 +115,9 @@ subroutine ocn_analysis_setup_packages(configPool, packagePool, err)!{{{
!
!-----------------------------------------------------------------
- type (mpas_pool_type), intent(in) :: configPool
- type (mpas_pool_type), intent(in) :: packagePool
+ type (mpas_pool_type), intent(inout) :: configPool
+ type (mpas_pool_type), intent(inout) :: packagePool
+ type (mpas_io_context_type), intent(inout) :: iocontext
!-----------------------------------------------------------------
!
@@ -145,6 +159,16 @@ subroutine ocn_analysis_setup_packages(configPool, packagePool, err)!{{{
call mpas_pool_add_config(analysisMemberList, 'waterMassCensus', 1)
call mpas_pool_add_config(analysisMemberList, 'zonalMean', 1)
call mpas_pool_add_config(analysisMemberList, 'highFrequencyOutput', 1)
+ call mpas_pool_add_config(analysisMemberList, 'timeFilters', 1)
+ call mpas_pool_add_config(analysisMemberList, 'lagrPartTrack', 1)
+ call mpas_pool_add_config(analysisMemberList, 'eliassenPalm', 1)
+ call mpas_pool_add_config(analysisMemberList, 'mixedLayerDepths', 1)
+ call mpas_pool_add_config(analysisMemberList, 'rpnCalculator', 1)
+ call mpas_pool_add_config(analysisMemberList, 'regionalStats', 1)
+ call mpas_pool_add_config(analysisMemberList, 'timeSeriesStats', 1)
+ call mpas_pool_add_config(analysisMemberList, 'pointwiseStats', 1)
+ call mpas_pool_add_config(analysisMemberList, 'debugDiagnostics', 1)
+ call mpas_pool_add_config(analysisMemberList, 'mocStreamfunction', 1)
! call mpas_pool_add_config(analysisMemberList, 'temPlate', 1)
! DON'T EDIT BELOW HERE
@@ -165,6 +189,166 @@ subroutine ocn_analysis_setup_packages(configPool, packagePool, err)!{{{
end subroutine ocn_analysis_setup_packages!}}}
+!***********************************************************************
+!
+! routine ocn_analysis_bootstrap
+!
+!> \brief Bootstrap analysis members (pre-init configuration)
+!> \author Doug Jacobsen
+!> \date 10/08/2015
+!> \details
+!> This routine will read either a restart or an input stream for each analysis member.
+!> The stream names that will be read are controlled via the analysis member's
+!> - config_AM_${AM}_restart_stream
+!> - config_AM_${AM}_input_stream
+!> namelist options.
+!>
+!> If the AM doesn't specify either of these, it will be ignored. If the AM
+!> specifies only the restart stream, it will only be read if the config_do_restart flag
+!> for the model is set to true. If the AM specifies both, the restart_stream will be read if
+!> config_do_restart is true, and the input_stream will be read if config_do_restart is false.
+!>
+!> After this call, alarms on both streams are reset.
+!>
+!> Additionally, if a bootstrap subroutine has been defined properly for the
+!> analysis member, it will be called here.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_analysis_bootstrap(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: err_tmp
+
+ character (len=StrKIND) :: configName, alarmName, restartStreamName, inputStreamName, timerName
+ logical, pointer :: config_AM_enable, config_do_restart
+ character (len=StrKIND), pointer :: config_AM_restart_stream, config_AM_input_stream
+ integer :: nameLength
+ type (mpas_pool_iterator_type) :: poolItr
+
+ logical :: streamFound
+ character (len=StrKIND) :: referenceTimeString, outputIntervalString
+ type (MPAS_Time_Type) :: referenceTime
+ type (MPAS_TimeInterval_type) :: alarmTimeStep
+
+ integer :: poolErrorLevel
+
+ err = 0
+
+ poolErrorLevel = mpas_pool_get_error_level()
+ call mpas_pool_set_error_level(MPAS_POOL_SILENT)
+
+ call mpas_timer_start('analysis_bootstrap', .false.)
+
+ call mpas_pool_get_config(domain % configs, 'config_do_restart', config_do_restart)
+
+ call mpas_pool_begin_iteration(analysisMemberList)
+ do while ( mpas_pool_get_next_member(analysisMemberList, poolItr) )
+ nameLength = len_trim(poolItr % memberName)
+ configName = 'config_AM_' // poolItr % memberName(1:nameLength) // '_enable'
+
+ call mpas_pool_get_config(domain % configs, configName, config_AM_enable)
+
+ if ( config_AM_enable ) then
+ timerName = trim(initReadTimerPrefix) // poolItr % memberName(1:nameLength)
+ call mpas_timer_start(timerName, .false.)
+
+ call ocn_bootstrap_analysis_members(domain, poolItr % memberName(1:nameLength), ierr=err)
+
+ configName = 'config_AM_' // poolItr % memberName(1:nameLength) // '_restart_stream'
+ nullify(config_AM_restart_stream)
+ call mpas_pool_get_config(domain % configs, configName, config_AM_restart_stream)
+
+ configName = 'config_AM_' // poolItr % memberName(1:nameLength) // '_input_stream'
+ nullify(config_AM_input_stream)
+ call mpas_pool_get_config(domain % configs, configName, config_AM_input_stream)
+
+ ! Verify the restart stream exists
+ if ( associated(config_AM_restart_stream) ) then
+ if ( trim(config_AM_restart_stream) == 'none' ) then
+ ! If the stream is set to 'none' nullify the config, so it doesn't get read in
+ nullify(config_AM_restart_stream)
+ else if ( .not. mpas_stream_mgr_stream_exists(domain % streamManager, config_AM_restart_stream) ) then
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: Stream named ''' // trim(config_AM_restart_stream) // &
+ ''' does not exist in config for analysis member ''' // &
+ trim(poolItr % memberName(1:nameLength)) // '''')
+ end if
+ end if
+
+ ! Verify the input stream exists
+ if ( associated(config_AM_input_stream) ) then
+ if ( trim(config_AM_input_stream) == 'none' ) then
+ ! If the stream is set to 'none' nullify the config, so it doesn't get read in
+ nullify(config_AM_input_stream)
+ else if ( .not. mpas_stream_mgr_stream_exists(domain % streamManager, config_AM_input_stream) ) then
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: Stream named ''' // trim(config_AM_input_stream) // &
+ ''' does not exist in config for analysis member ''' // &
+ trim(poolItr % memberName(1:nameLength)) // '''')
+ end if
+ end if
+
+ ! Handle reading of streams that exist.
+ if ( associated(config_AM_restart_stream) .and. associated(config_AM_input_stream) ) then
+
+ if ( config_do_restart ) then
+ call mpas_stream_mgr_read(domain % streamManager, streamID=config_AM_restart_stream, ierr=err)
+ else
+ call mpas_stream_mgr_read(domain % streamManager, streamID=config_AM_input_stream, ierr=err)
+ end if
+ call mpas_stream_mgr_reset_alarms(domain % streamManager, streamID=config_AM_restart_stream, &
+ direction=MPAS_STREAM_INPUT, ierr=err)
+ call mpas_stream_mgr_reset_alarms(domain % streamManager, streamID=config_AM_input_stream, &
+ direction=MPAS_STREAM_INPUT, ierr=err)
+ else if ( associated(config_AM_restart_stream) ) then
+ if ( config_do_restart ) then
+ call mpas_stream_mgr_read(domain % streamManager, streamID=config_AM_restart_stream, ierr=err)
+ end if
+ call mpas_stream_mgr_reset_alarms(domain % streamManager, streamID=config_AM_restart_stream, &
+ direction=MPAS_STREAM_INPUT, ierr=err)
+ else if ( associated(config_AM_input_stream) ) then
+ if ( .not. config_do_restart ) then
+ call mpas_stream_mgr_read(domain % streamManager, streamID=config_AM_input_stream, ierr=err)
+ end if
+ call mpas_stream_mgr_reset_alarms(domain % streamManager, streamID=config_AM_input_stream, &
+ direction=MPAS_STREAM_INPUT, ierr=err)
+ end if
+ call mpas_timer_stop(timerName)
+ end if
+ end do
+
+ call mpas_timer_stop('analysis_bootstrap')
+
+ call mpas_pool_set_error_level(poolErrorLevel)
+
+ end subroutine ocn_analysis_bootstrap!}}}
+
!***********************************************************************
!
! routine ocn_analysis_init
@@ -212,13 +396,13 @@ subroutine ocn_analysis_init(domain, err)!{{{
character (len=StrKIND) :: configName, alarmName, streamName, timerName
logical, pointer :: config_AM_enable
- character (len=StrKIND), pointer :: config_AM_compute_interval, config_AM_stream_name
+ character (len=StrKIND), pointer :: config_AM_compute_interval, config_AM_output_stream, config_start_time
integer :: nameLength
type (mpas_pool_iterator_type) :: poolItr
logical :: streamFound
character (len=StrKIND) :: referenceTimeString, outputIntervalString
- type (MPAS_Time_Type) :: referenceTime
+ type (MPAS_Time_Type) :: referenceTime
type (MPAS_TimeInterval_type) :: alarmTimeStep
err = 0
@@ -240,8 +424,8 @@ subroutine ocn_analysis_init(domain, err)!{{{
configName = 'config_AM_' // poolItr % memberName(1:nameLength) // '_compute_interval'
call mpas_pool_get_config(domain % configs, configName, config_AM_compute_interval)
- configName = 'config_AM_' // poolItr % memberName(1:nameLength) // '_stream_name'
- call mpas_pool_get_config(domain % configs, configName, config_AM_stream_name)
+ configName = 'config_AM_' // poolItr % memberName(1:nameLength) // '_output_stream'
+ call mpas_pool_get_config(domain % configs, configName, config_AM_output_stream)
if ( config_AM_compute_interval == 'dt' ) then
alarmTimeStep = mpas_get_clock_timestep(domain % clock, err_tmp)
@@ -249,30 +433,55 @@ subroutine ocn_analysis_init(domain, err)!{{{
end if
! Verify stream exists before trying to use output_interval
- if ( config_AM_stream_name /= 'none' ) then
+ if ( config_AM_output_stream /= 'none' ) then
streamFound = .false.
-
+
call mpas_stream_mgr_begin_iteration(domain % streamManager)
do while ( mpas_stream_mgr_get_next_stream(domain % streamManager, streamName) )
- if ( trim(streamName) == trim(config_AM_stream_name) ) then
+ if ( trim(streamName) == trim(config_AM_output_stream) ) then
streamFound = .true.
end if
end do
-
+
if ( .not. streamFound ) then
- call mpas_dmpar_global_abort('ERROR: Stream ' // trim(config_AM_stream_name) // ' does not exist. Exiting...')
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: Stream ' // trim(config_AM_output_stream) // &
+ ' does not exist. Exiting...')
end if
end if
-
- if ( config_AM_compute_interval /= 'output_interval' .and. config_AM_stream_name /= 'none') then
+ if ( config_AM_compute_interval == 'output_interval' .and. config_AM_output_stream == 'none') then
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: Analysis member has compute_interval of ''output_interval'' ' // &
+ 'without an output stream.')
+ end if
+
+ if ( config_AM_compute_interval /= 'output_interval' ) then
alarmName = poolItr % memberName(1:nameLength) // computeAlarmSuffix
call mpas_set_timeInterval(alarmTimeStep, timeString=config_AM_compute_interval, ierr=err_tmp)
- call MPAS_stream_mgr_get_property(domain % streamManager, config_AM_stream_name, MPAS_STREAM_PROPERTY_REF_TIME, referenceTimeString, err_tmp)
- call mpas_set_time(referenceTime, dateTimeString=referenceTimeString, ierr=err_tmp)
+ if ( config_AM_output_stream /= 'none' ) then
+ call MPAS_stream_mgr_get_property(domain % streamManager, config_AM_output_stream, &
+ MPAS_STREAM_PROPERTY_REF_TIME, referenceTimeString, err_tmp)
+ call mpas_set_time(referenceTime, dateTimeString=referenceTimeString, ierr=err_tmp)
+ else
+ call mpas_pool_get_config(domain % configs, 'config_start_time', config_start_time)
+
+ ! TODO FIXME I'm not sure what it's supposed to be
+ ! but 'file' is causing the code to fail
+ if (trim(config_start_time) == 'file') then
+ ! FIXME big kludge
+ call mpas_set_time(referenceTime, &
+ dateTimeString='0000-01-01_00:00:00', ierr=err_tmp)
+ else
+ ! FIXME this is what it was without the if-else
+ ! I suppose it's supposed to actually read it from
+ ! the file first
+ call mpas_set_time(referenceTime, dateTimeString=config_start_time, ierr=err_tmp)
+ end if
+
+ end if
call mpas_add_clock_alarm(domain % clock, alarmName, referenceTime, alarmTimeStep, ierr=err_tmp)
call mpas_reset_clock_alarm(domain % clock, alarmName, ierr=err_tmp)
end if
+
call mpas_timer_stop(timerName)
end if
end do
@@ -327,14 +536,14 @@ subroutine ocn_analysis_compute_startup(domain, err)!{{{
integer :: timeLevel, err_tmp
character (len=StrKIND) :: configName, timerName
- character (len=StrKIND), pointer :: config_AM_stream_name
+ character (len=StrKIND), pointer :: config_AM_output_stream
logical, pointer :: config_AM_enable, config_AM_write_on_startup, config_AM_compute_on_startup
type (mpas_pool_iterator_type) :: poolItr
integer :: nameLength
err = 0
- call mpas_timer_start('analysis_compute', .false.)
+ call mpas_timer_start('analysis_compute_startup', .false.)
timeLevel=1
@@ -351,29 +560,29 @@ subroutine ocn_analysis_compute_startup(domain, err)!{{{
call mpas_pool_get_config(domain % configs, configName, config_AM_write_on_startup)
if ( config_AM_compute_on_startup ) then
- timerName = trim(computeTimerPrefix) // poolItr % memberName(1:nameLength)
+ timerName = trim(computeStartupTimerPrefix) // poolItr % memberName(1:nameLength)
call mpas_timer_start(timerName, .false.)
call ocn_compute_analysis_members(domain, timeLevel, poolItr % memberName, err_tmp)
call mpas_timer_stop(timerName)
err = ior(err, err_tmp)
+ end if
- if ( config_AM_write_on_startup ) then
- configName = 'config_AM_' // poolItr % memberName(1:nameLength) // '_stream_name'
- call mpas_pool_get_config(domain % configs, configName, config_AM_stream_name)
- if ( config_AM_stream_name /= 'none' ) then
- call mpas_stream_mgr_write(domain % streamManager, streamID=config_AM_stream_name, forceWriteNow=.true., ierr=err_tmp)
- end if
+ if ( config_AM_write_on_startup ) then
+ configName = 'config_AM_' // poolItr % memberName(1:nameLength) // '_output_stream'
+ call mpas_pool_get_config(domain % configs, configName, config_AM_output_stream)
+ if ( config_AM_output_stream /= 'none' ) then
+ call mpas_stream_mgr_write(domain % streamManager, streamID=config_AM_output_stream, &
+ forceWriteNow=.true., ierr=err_tmp)
end if
- else
- if ( config_AM_write_on_startup ) then
+ if (.not. config_AM_compute_on_startup) then
write(stderrUnit, *) ' *** WARNING: write_on_startup called without compute_on_startup for analysis member: ' &
- // poolItr % memberName(1:nameLength) // '. Skipping output...'
+ // poolItr % memberName(1:nameLength) // '.'
end if
end if
end if
end do
- call mpas_timer_stop('analysis_compute')
+ call mpas_timer_stop('analysis_compute_startup')
end subroutine ocn_analysis_compute_startup!}}}
@@ -423,7 +632,7 @@ subroutine ocn_analysis_compute(domain, err)!{{{
integer :: timeLevel, err_tmp
character (len=StrKIND) :: configName, alarmName, timerName
- character (len=StrKIND), pointer :: config_AM_stream_name, config_AM_compute_interval
+ character (len=StrKIND), pointer :: config_AM_output_stream, config_AM_compute_interval
logical, pointer :: config_AM_enable
type (mpas_pool_iterator_type) :: poolItr
integer :: nameLength
@@ -443,16 +652,17 @@ subroutine ocn_analysis_compute(domain, err)!{{{
if ( config_AM_enable ) then
configName = 'config_AM_' // poolItr % memberName(1:nameLength) // '_compute_interval'
call mpas_pool_get_config(domain % configs, configName, config_AM_compute_interval)
- configName = 'config_AM_' // poolItr % memberName(1:nameLength) // '_stream_name'
- call mpas_pool_get_config(domain % configs, configName, config_AM_stream_name)
+ configName = 'config_AM_' // poolItr % memberName(1:nameLength) // '_output_stream'
+ call mpas_pool_get_config(domain % configs, configName, config_AM_output_stream)
! Build name of alarm for analysis member
alarmName = poolItr % memberName(1:nameLength) // computeAlarmSuffix
timerName = trim(computeTimerPrefix) // poolItr % memberName(1:nameLength)
! Compute analysis member just before output
- if ( config_AM_compute_interval == 'output_interval' .and. config_AM_stream_name /= 'none') then
- if ( mpas_stream_mgr_ringing_alarms(domain % streamManager, streamID=config_AM_stream_name, direction=MPAS_STREAM_OUTPUT, ierr=err_tmp) ) then
+ if ( config_AM_compute_interval == 'output_interval' .and. config_AM_output_stream /= 'none') then
+ if ( mpas_stream_mgr_ringing_alarms(domain % streamManager, streamID=config_AM_output_stream, &
+ direction=MPAS_STREAM_OUTPUT, ierr=err_tmp) ) then
call mpas_timer_start(timerName, .false.)
call ocn_compute_analysis_members(domain, timeLevel, poolItr % memberName, err_tmp)
call mpas_timer_stop(timerName)
@@ -591,7 +801,7 @@ subroutine ocn_analysis_write(domain, err)!{{{
integer :: err_tmp
character (len=StrKIND) :: configName, timerName
- character (len=StrKIND), pointer :: config_AM_stream_name
+ character (len=StrKIND), pointer :: config_AM_output_stream
logical, pointer :: config_AM_enable
type (mpas_pool_iterator_type) :: poolItr
integer :: nameLength
@@ -607,16 +817,16 @@ subroutine ocn_analysis_write(domain, err)!{{{
call mpas_pool_get_config(domain % configs, configName, config_AM_enable)
if ( config_AM_enable ) then
- configName = 'config_AM_' // poolItr % memberName(1:nameLength) // '_stream_name'
- call mpas_pool_get_config(domain % configs, configName, config_AM_stream_name)
- if ( config_AM_stream_name /= 'none' ) then
+ configName = 'config_AM_' // poolItr % memberName(1:nameLength) // '_output_stream'
+ call mpas_pool_get_config(domain % configs, configName, config_AM_output_stream)
+ if ( config_AM_output_stream /= 'none' ) then
timerName = trim(writeTimerPrefix) // poolItr % memberName(1:nameLength)
call mpas_timer_start(timerName, .false.)
- call mpas_stream_mgr_write(domain % streamManager, streamID=config_AM_stream_name, ierr=err_tmp)
+ call mpas_stream_mgr_write(domain % streamManager, streamID=config_AM_output_stream, ierr=err_tmp)
call mpas_timer_stop(timerName)
timerName = trim(alarmTimerPrefix) // poolItr % memberName(1:nameLength)
call mpas_timer_start(timerName, .false.)
- call mpas_stream_mgr_reset_alarms(domain % streamManager, streamID=config_AM_stream_name, ierr=err_tmp)
+ call mpas_stream_mgr_reset_alarms(domain % streamManager, streamID=config_AM_output_stream, ierr=err_tmp)
call mpas_timer_stop(timerName)
end if
end if
@@ -700,6 +910,43 @@ subroutine ocn_analysis_finalize(domain, err)!{{{
end subroutine ocn_analysis_finalize!}}}
+!***********************************************************************
+!
+! routine ocn_bootstrap_analysis_members
+!
+!> \brief Analysis member initialization driver
+!> \author Doug Jacobsen
+!> \date 07/01/2015
+!> \details
+!> This private routine calls the correct init routine for each analysis member.
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_bootstrap_analysis_members(domain, analysisMemberName, iErr)!{{{
+ type (domain_type), intent(inout) :: domain !< Input: Domain information
+ character (len=*), intent(in) :: analysisMemberName !< Input: Name of analysis member
+ integer, intent(out) :: iErr !< Output: Error code
+
+ integer :: nameLength, err_tmp
+
+ iErr = 0
+ err_tmp = 0
+
+ nameLength = len_trim(analysisMemberName)
+
+ !if ( analysisMemberName(1:nameLength) == 'testComputeInterval' ) then
+ ! call ocn_bootstrap_test_compute_interval(domain, err_tmp)
+ if ( analysisMemberName(1:nameLength) == 'timeSeriesStats' ) then
+ call ocn_bootstrap_time_series_stats(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'pointwiseStats' ) then
+ call ocn_bootstrap_pointwise_stats(domain, err_tmp)
+! else if ( analysisMemberName(1:nameLength) == 'temPlate' ) then
+! call ocn_init_TEM_PLATE(domain, err_tmp)
+ end if
+
+ iErr = ior(iErr, err_tmp)
+
+ end subroutine ocn_bootstrap_analysis_members!}}}
+
!***********************************************************************
!
! routine ocn_init_analysis_members
@@ -738,10 +985,33 @@ subroutine ocn_init_analysis_members(domain, analysisMemberName, iErr)!{{{
call ocn_init_water_mass_census(domain, err_tmp)
else if ( analysisMemberName(1:nameLength) == 'zonalMean' ) then
call ocn_init_zonal_mean(domain, err_tmp)
- else if ( analysisMemberName(1:nameLength) == 'highFrequencyOutput' ) then
- call ocn_init_high_frequency_output(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'highFrequencyOutput' ) then
+ call ocn_init_high_frequency_output(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'timeFilters' ) then
+ call ocn_init_time_filters(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'lagrPartTrack' ) then
+ call ocn_init_lagrangian_particle_tracking(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'eliassenPalm' ) then
+ call ocn_init_eliassen_palm(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'mixedLayerDepths' ) then
+ call ocn_init_mixed_layer_depths(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'pointwiseStats' ) then
+ call ocn_init_pointwise_stats(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'debugDiagnostics' ) then
+ call ocn_init_debug_diagnostics(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'mocStreamfunction' ) then
+ call ocn_init_moc_streamfunction(domain, err_tmp)
! else if ( analysisMemberName(1:nameLength) == 'temPlate' ) then
! call ocn_init_TEM_PLATE(domain, err_tmp)
+ ! rpn is third to last
+ else if ( analysisMemberName(1:nameLength) == 'rpnCalculator' ) then
+ call ocn_init_rpn_calculator(domain, err_tmp)
+ ! regional is second to last
+ else if ( analysisMemberName(1:nameLength) == 'regionalStats' ) then
+ call ocn_init_regional_stats(domain, err_tmp)
+ ! time is last
+ else if ( analysisMemberName(1:nameLength) == 'timeSeriesStats' ) then
+ call ocn_init_time_series_stats(domain, err_tmp)
end if
iErr = ior(iErr, err_tmp)
@@ -787,10 +1057,33 @@ subroutine ocn_compute_analysis_members(domain, timeLevel, analysisMemberName, i
call ocn_compute_water_mass_census(domain, timeLevel, err_tmp)
else if ( analysisMemberName(1:nameLength) == 'zonalMean' ) then
call ocn_compute_zonal_mean(domain, timeLevel, err_tmp)
- else if ( analysisMemberName(1:nameLength) == 'highFrequencyOutput' ) then
- call ocn_compute_high_frequency_output(domain, timeLevel, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'highFrequencyOutput' ) then
+ call ocn_compute_high_frequency_output(domain, timeLevel, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'timeFilters' ) then
+ call ocn_compute_time_filters(domain, timeLevel, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'lagrPartTrack' ) then
+ call ocn_compute_lagrangian_particle_tracking(domain, timeLevel, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'eliassenPalm' ) then
+ call ocn_compute_eliassen_palm(domain, timeLevel, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'mixedLayerDepths' ) then
+ call ocn_compute_mixed_layer_depths(domain, timeLevel, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'pointwiseStats' ) then
+ call ocn_compute_pointwise_stats(domain, timeLevel, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'debugDiagnostics' ) then
+ call ocn_compute_debug_diagnostics(domain, timeLevel, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'mocStreamfunction' ) then
+ call ocn_compute_moc_streamfunction(domain, timeLevel, err_tmp)
! else if ( analysisMemberName(1:nameLength) == 'temPlate' ) then
! call ocn_compute_TEM_PLATE(domain, timeLevel, err_tmp)
+ ! rpn is third to last
+ else if ( analysisMemberName(1:nameLength) == 'rpnCalculator' ) then
+ call ocn_compute_rpn_calculator(domain, timeLevel, err_tmp)
+ ! regional is second to last
+ else if ( analysisMemberName(1:nameLength) == 'regionalStats' ) then
+ call ocn_compute_regional_stats(domain, timeLevel, err_tmp)
+ ! time is last
+ else if ( analysisMemberName(1:nameLength) == 'timeSeriesStats' ) then
+ call ocn_compute_time_series_stats(domain, timeLevel, err_tmp)
end if
iErr = ior(iErr, err_tmp)
@@ -835,10 +1128,33 @@ subroutine ocn_restart_analysis_members(domain, analysisMemberName, iErr)!{{{
call ocn_restart_water_mass_census(domain, err_tmp)
else if ( analysisMemberName(1:nameLength) == 'zonalMean' ) then
call ocn_restart_zonal_mean(domain, err_tmp)
- else if ( analysisMemberName(1:nameLength) == 'highFrequencyOutput' ) then
- call ocn_restart_high_frequency_output(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'highFrequencyOutput' ) then
+ call ocn_restart_high_frequency_output(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'timeFilters' ) then
+ call ocn_restart_time_filters(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'lagrPartTrack' ) then
+ call ocn_restart_lagrangian_particle_tracking(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'eliassenPalm' ) then
+ call ocn_restart_eliassen_palm(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'mixedLayerDepths' ) then
+ call ocn_restart_mixed_layer_depths(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'pointwiseStats' ) then
+ call ocn_restart_pointwise_stats(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'debugDiagnostics' ) then
+ call ocn_restart_debug_diagnostics(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'mocStreamfunction' ) then
+ call ocn_restart_moc_streamfunction(domain, err_tmp)
! else if ( analysisMemberName(1:nameLength) == 'temPlate' ) then
! call ocn_restart_TEM_PLATE(domain, err_tmp)
+ ! rpn is third to last
+ else if ( analysisMemberName(1:nameLength) == 'rpnCalculator' ) then
+ call ocn_restart_rpn_calculator(domain, err_tmp)
+ ! regional is second to last
+ else if ( analysisMemberName(1:nameLength) == 'regionalStats' ) then
+ call ocn_restart_regional_stats(domain, err_tmp)
+ ! time is last
+ else if ( analysisMemberName(1:nameLength) == 'timeSeriesStats' ) then
+ call ocn_restart_time_series_stats(domain, err_tmp)
end if
iErr = ior(iErr, err_tmp)
@@ -883,10 +1199,33 @@ subroutine ocn_finalize_analysis_members(domain, analysisMemberName, iErr)!{{{
call ocn_finalize_water_mass_census(domain, err_tmp)
else if ( analysisMemberName(1:nameLength) == 'zonalMean' ) then
call ocn_finalize_zonal_mean(domain, err_tmp)
- else if ( analysisMemberName(1:nameLength) == 'highFrequencyOutput' ) then
- call ocn_finalize_high_frequency_output(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'highFrequencyOutput' ) then
+ call ocn_finalize_high_frequency_output(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'timeFilters' ) then
+ call ocn_finalize_time_filters(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'lagrPartTrack' ) then
+ call ocn_finalize_lagrangian_particle_tracking(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'eliassenPalm' ) then
+ call ocn_finalize_eliassen_palm(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'mixedLayerDepths' ) then
+ call ocn_finalize_mixed_layer_depths(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'pointwiseStats' ) then
+ call ocn_finalize_pointwise_stats(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'debugDiagnostics' ) then
+ call ocn_finalize_debug_diagnostics(domain, err_tmp)
+ else if ( analysisMemberName(1:nameLength) == 'mocStreamfunction' ) then
+ call ocn_finalize_moc_streamfunction(domain, err_tmp)
! else if ( analysisMemberName(1:nameLength) == 'temPlate' ) then
! call ocn_finalize_TEM_PLATE(domain, err_tmp)
+ ! rpn is third to last
+ else if ( analysisMemberName(1:nameLength) == 'rpnCalculator' ) then
+ call ocn_finalize_rpn_calculator(domain, err_tmp)
+ ! regional is second to last
+ else if ( analysisMemberName(1:nameLength) == 'regionalStats' ) then
+ call ocn_finalize_regional_stats(domain, err_tmp)
+ ! time is last
+ else if ( analysisMemberName(1:nameLength) == 'timeSeriesStats' ) then
+ call ocn_finalize_time_series_stats(domain, err_tmp)
end if
iErr = ior(iErr, err_tmp)
diff --git a/src/core_ocean/analysis_members/mpas_ocn_debug_diagnostics.F b/src/core_ocean/analysis_members/mpas_ocn_debug_diagnostics.F
new file mode 100644
index 0000000000..4baaa0674c
--- /dev/null
+++ b/src/core_ocean/analysis_members/mpas_ocn_debug_diagnostics.F
@@ -0,0 +1,510 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_debug_diagnostics
+!
+!> \brief MPAS ocean analysis mode member: debug_diagnostics
+!> \author Mark Petersen
+!> \date March 2016
+!> \details
+!> MPAS ocean analysis mode member: debug_diagnostics
+!> Compute diagnostics used for debugging.
+!>
+!-----------------------------------------------------------------------
+
+module ocn_debug_diagnostics
+
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_dmpar
+ use mpas_timekeeping
+ use mpas_stream_manager
+
+ use ocn_constants
+ use ocn_diagnostics_routines
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_debug_diagnostics, &
+ ocn_compute_debug_diagnostics, &
+ ocn_restart_debug_diagnostics, &
+ ocn_finalize_debug_diagnostics
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_debug_diagnostics
+!
+!> \brief Initialize MPAS-Ocean analysis member
+!> \author Mark Petersen
+!> \date March 2016
+!> \details
+!> This routine conducts all initializations required for the
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_debug_diagnostics(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ end subroutine ocn_init_debug_diagnostics!}}}
+
+!***********************************************************************
+!
+! routine ocn_compute_debug_diagnostics
+!
+!> \brief Compute MPAS-Ocean analysis member
+!> \author Mark Petersen
+!> \date March 2016
+!> \details
+!> This routine conducts all computation required for this
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_compute_debug_diagnostics(domain, timeLevel, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(in) :: timeLevel
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mpas_pool_type), pointer :: debugDiagnosticsAMPool
+ type (dm_info) :: dminfo
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: scratchPool
+ type (mpas_pool_type), pointer :: diagnosticsPool
+ !type (mpas_pool_type), pointer :: debugDiagnosticsAM
+
+ ! Here are some example variables which may be needed for your analysis member
+ integer :: iEdge, c1, c2, k
+ integer, pointer :: nEdges
+ integer, dimension(:), pointer :: maxLevelEdgeTop
+ integer, dimension(:,:), pointer :: cellsOnEdge
+
+ real (kind=RKIND) :: dzVert1, dzVert2, dzEdgeK, dzEdgeKp1, rx1, localMaxRx1
+ real (kind=RKIND), pointer :: globalRx1Max
+ real (kind=RKIND), dimension(:), pointer :: rx1MaxCell
+ real (kind=RKIND), dimension(:,:), pointer :: zMid
+
+ logical, pointer :: config_AM_debugDiagnostics_check_state
+
+ err = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_AM_debugDiagnostics_check_state', &
+ config_AM_debugDiagnostics_check_state)
+
+ localMaxRx1 = 0.0_RKIND
+
+ dminfo = domain % dminfo
+
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
+ !call mpas_pool_get_subpool(block % structs, 'debugDiagnosticsAM', debugDiagnosticsAMPool)
+
+ if ( config_AM_debugDiagnostics_check_state ) then
+ call ocn_test_ocean_state(dminfo, meshPool, diagnosticsPool, statePool)
+ end if
+
+ ! Here are some example variables which may be needed for your analysis member
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+ call mpas_pool_get_array(meshPool, 'maxLevelEdgeTop', maxLevelEdgeTop)
+ call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
+
+ call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
+
+ !-----------------------------------------------------------------
+ !
+ ! Compute Haney number, rx1
+ !
+ !-----------------------------------------------------------------
+
+ call mpas_pool_get_array(diagnosticsPool, 'rx1MaxCell', rx1MaxCell)
+ call mpas_pool_get_array(diagnosticsPool, 'globalRx1Max', globalRx1Max)
+
+ ! These could be included for edge or cell fields with depth:
+ ! call mpas_pool_get_array(diagnosticsPool, 'rx1Edge', rx1Edge)
+ ! call mpas_pool_get_array(diagnosticsPool, 'rx1Cell', rx1Cell)
+ ! call mpas_pool_get_array(diagnosticsPool, 'rx1MaxEdge', rx1MaxEdge)
+ ! rx1Edge(:,:) = 0.0_RKIND
+ ! rx1Cell(:,:) = 0.0_RKIND
+ ! rx1MaxEdge(:) = 0.0_RKIND
+
+ rx1MaxCell(:) = 0.0_RKIND
+ do iEdge = 1,nEdges
+ c1 = cellsOnEdge(1,iEdge)
+ c2 = cellsOnEdge(2,iEdge)
+ do k = 1,maxLevelEdgeTop(iEdge)-1
+ dzVert1 = zMid(k,c1)-zMid(k+1,c1)
+ dzVert2 = zMid(k,c2)-zMid(k+1,c2)
+ dzEdgeK = zMid(k,c2)-zMid(k,c1)
+ dzEdgeKp1 = zMid(k+1,c2)-zMid(k+1,c1)
+
+ rx1 = abs(dzEdgeK+dzEdgeKp1)/(dzVert1+dzVert2)
+
+ rx1MaxCell(c1) = max(rx1MaxCell(c1),rx1)
+ rx1MaxCell(c2) = max(rx1MaxCell(c2),rx1)
+
+ ! These could be included for edge or cell fields with depth:
+ ! rx1Edge(k,iEdge) = rx1
+ ! rx1Cell(k,c1) = max(rx1Cell(k,c1),rx1)
+ ! rx1Cell(k,c2) = max(rx1Cell(k,c2),rx1)
+ ! rx1MaxEdge(iEdge) = max(rx1MaxEdge(iEdge),rx1)
+ end do
+ end do
+
+ localMaxRx1 = max(localMaxRx1,maxval(rx1MaxCell))
+
+ block => block % next
+ end do
+ call mpas_dmpar_max_real(dminfo, localMaxRx1, globalRx1Max)
+
+ end subroutine ocn_compute_debug_diagnostics!}}}
+
+!***********************************************************************
+!
+! routine ocn_restart_debug_diagnostics
+!
+!> \brief Save restart for MPAS-Ocean analysis member
+!> \author Mark Petersen
+!> \date March 2016
+!> \details
+!> This routine conducts computation required to save a restart state
+!> for the MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_restart_debug_diagnostics(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ end subroutine ocn_restart_debug_diagnostics!}}}
+
+!***********************************************************************
+!
+! routine ocn_finalize_debug_diagnostics
+!
+!> \brief Finalize MPAS-Ocean analysis member
+!> \author Mark Petersen
+!> \date March 2016
+!> \details
+!> This routine conducts all finalizations required for this
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_finalize_debug_diagnostics(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ end subroutine ocn_finalize_debug_diagnostics!}}}
+
+ subroutine ocn_test_ocean_state(dminfo, meshPool, diagnosticsPool, statePool)!{{{
+
+ type (dm_info) :: dminfo
+ type (mpas_pool_type), pointer :: statePool, meshPool, diagnosticsPool, tracersPool
+ character (len=StrKIND), pointer :: xtime
+ real (kind=RKIND), dimension(:), pointer :: latCell, lonCell
+ real (kind=RKIND), dimension(:,:), pointer :: normalVelocity
+ real (kind=RKIND), dimension(:,:), pointer :: kineticEnergyCell
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
+ integer, dimension(:), pointer :: maxLevelCell
+ integer, dimension(:), pointer :: indexToCellID
+ integer, pointer :: indexTemperature
+ integer, pointer :: indexSalinity
+ integer, pointer :: nCellsSolve
+ real (kind=RKIND) :: nanCheck, workValue, workLat, workLon
+ integer :: workGlobalID(2), errorUnit, mpiRank, iCell, k
+ logical :: errorFlag
+ character(len=StrKIND) :: charMPIRank, charFilename
+
+ !get all pointers that might be needed
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_array(meshPool, 'lonCell', lonCell)
+ call mpas_pool_get_array(meshPool, 'latCell', latCell)
+ call mpas_pool_get_array(meshPool, 'indexToCellID', indexToCellID)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(diagnosticsPool, 'xtime', xtime)
+ call mpas_pool_get_array(diagnosticsPool, 'kineticEnergyCell', kineticEnergyCell)
+ call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, 2)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 2)
+
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', indexTemperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', indexSalinity)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 2)
+
+ !assume that no abnormal values exist
+ errorFlag = .false.
+
+ !now step through tests to see if abnormal values do exist
+ !if so, reset errorFlag to be true
+
+ ! test for abnormal values
+ do iCell=1,nCellsSolve
+ do k=1,maxLevelCell(iCell)
+ if(kineticEnergyCell(k,iCell).gt.4.0_RKIND) errorFlag=.true.
+ if(activeTracers(indexTemperature,k,iCell).lt.-1.9_RKIND) errorFlag=.true.
+ if(activeTracers(indexTemperature,k,iCell).gt.33.0_RKIND) errorFlag=.true.
+ if(activeTracers(indexSalinity,k,iCell).lt.0.0_RKIND) errorFlag=.true.
+ if(layerThickness(k,iCell).lt.1.0e-2_RKIND) errorFlag=.true.
+ enddo
+ enddo
+
+ !if an errorFlag exists, then
+ ! 1) open a file
+ ! 2) step through tests again and write the file
+ ! 3) close file
+
+ if(errorFlag) then
+
+ !find an open unit
+ call mpas_new_unit(errorUnit)
+ mpiRank = dminfo % my_proc_id
+ charFilename = 'mpas_ocean_state_test_'
+ if( mpiRank.le. 9) write(charMPIRank,'(I1)') mpiRank
+ if(mpiRank.gt. 9 .and. mpiRank.le. 99) write(charMPIRank,'(I2)') mpiRank
+ if(mpiRank.gt. 99 .and. mpiRank.le. 999) write(charMPIRank,'(I3)') mpiRank
+ if(mpiRank.gt. 999 .and. mpiRank.le. 9999) write(charMPIRank,'(I4)') mpiRank
+ if(mpiRank.gt. 9999 .and. mpiRank.le. 99999) write(charMPIRank,'(I5)') mpiRank
+ if(mpiRank.gt.99999 .and. mpiRank.le.999999) write(charMPIRank,'(I6)') mpiRank
+ charFilename = trim(charFilename) // trim(charMPIRank)
+ open(unit=errorUnit, file=charFilename, form='formatted', status='unknown', position='append')
+
+ !write time
+ write(errorUnit,'(a80)') trim(xtime)
+
+ !test to see if cell kinetic energy is greater than 4.0 m2/s2
+ do iCell=1,nCellsSolve
+ do k=1,maxLevelCell(iCell)
+ if(kineticEnergyCell(k,iCell).gt.4.0_RKIND) then
+ workValue = kineticEnergyCell(k,iCell)
+ workGlobalID(1) = k
+ workGlobalID(2) = indexToCellID(iCell)
+ workLat = latCell(iCell)
+ workLon = lonCell(iCell)
+ write(errorUnit, 10) 'KE= ', workValue, 'cell= ', workGlobalID(2), &
+ 'k= ',workGlobalID(1), 'lat = ', workLat, 'lon= ', workLon
+ 10 format(a4,e10.3, 3x,a6,i8, 3x,a3,i4, 3x,a6,f6.2, 3x,a6,f6.2)
+ endif
+ enddo
+ enddo
+
+ !test to see if cell temperature is less than -1.9C
+ do iCell=1,nCellsSolve
+ do k=1,maxLevelCell(iCell)
+ if(activeTracers(indexTemperature,k,iCell).lt.-1.9_RKIND) then
+ workValue = activeTracers(indexTemperature,k,iCell)
+ workGlobalID(1) = k
+ workGlobalID(2) = indexToCellID(iCell)
+ workLat = latCell(iCell)
+ workLon = lonCell(iCell)
+ write(errorUnit, 10) 'T= ', workValue, 'cell= ', workGlobalID(2), &
+ 'k= ',workGlobalID(1), 'lat = ', workLat, 'lon= ', workLon
+ endif
+ enddo
+ enddo
+
+ !test to see if cell temperature is greater than 33.0
+ do iCell=1,nCellsSolve
+ do k=1,maxLevelCell(iCell)
+ if(activeTracers(indexTemperature,k,iCell).gt.33.0_RKIND) then
+ workValue = activeTracers(indexTemperature,k,iCell)
+ workGlobalID(1) = k
+ workGlobalID(2) = indexToCellID(iCell)
+ workLat = latCell(iCell)
+ workLon = lonCell(iCell)
+ write(errorUnit, 10) 'T= ', workValue, 'cell= ', workGlobalID(2), &
+ 'k= ',workGlobalID(1), 'lat = ', workLat, 'lon= ', workLon
+ endif
+ enddo
+ enddo
+
+ !test to see if cell salinity is less than 0
+ do iCell=1,nCellsSolve
+ do k=1,maxLevelCell(iCell)
+ if(activeTracers(indexSalinity,k,iCell).lt.0.0_RKIND) then
+ workValue = activeTracers(indexSalinity,k,iCell)
+ workGlobalID(1) = k
+ workGlobalID(2) = indexToCellID(iCell)
+ workLat = latCell(iCell)
+ workLon = lonCell(iCell)
+ write(errorUnit, 10) 'S= ', workValue, 'cell= ', workGlobalID(2), &
+ 'k= ',workGlobalID(1), 'lat = ', workLat, 'lon= ', workLon
+ endif
+ enddo
+ enddo
+
+ !test to see if cell thickness is less than 1.0e-2
+ do iCell=1,nCellsSolve
+ do k=1,maxLevelCell(iCell)
+ if(layerThickness(k,iCell).lt.1.0e-2_RKIND) then
+ workValue = layerThickness(k,iCell)
+ workGlobalID(1) = k
+ workGlobalID(2) = indexToCellID(iCell)
+ workLat = latCell(iCell)
+ workLon = lonCell(iCell)
+ write(errorUnit, 10) 'S= ', workValue, 'cell= ', workGlobalID(2), &
+ 'k= ',workGlobalID(1), 'lat = ', workLat, 'lon= ', workLon
+ endif
+ enddo
+ enddo
+
+ write(errorUnit,*) ''
+
+ !close unit
+ close(errorUnit)
+ call mpas_release_unit(errorUnit)
+
+ endif ! if(errorFlag)
+
+ end subroutine ocn_test_ocean_state!}}}
+
+end module ocn_debug_diagnostics
+
+! vim: foldmethod=marker
diff --git a/src/core_ocean/analysis_members/mpas_ocn_eliassen_palm.F b/src/core_ocean/analysis_members/mpas_ocn_eliassen_palm.F
new file mode 100644
index 0000000000..eab89c26f5
--- /dev/null
+++ b/src/core_ocean/analysis_members/mpas_ocn_eliassen_palm.F
@@ -0,0 +1,2888 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_eliassen_palm
+!
+!> \brief MPAS ocean analysis core member: Eliassen-Palm Flux Tensor
+!> \author Juan A. Saenz, Todd Ringler
+!> \date May 2015
+!> \details
+!> This module contains the routines for computing the Eliassen and Palm Flux Tensor
+!> in buoyancy coordinates, and related quantities.
+!
+!-----------------------------------------------------------------------
+
+module ocn_eliassen_palm
+
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_dmpar
+ use mpas_timekeeping
+ use mpas_stream_manager
+
+ use mpas_pool_routines
+ use mpas_constants
+ use ocn_constants
+ use ocn_diagnostics_routines
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_eliassen_palm, &
+ ocn_compute_eliassen_palm, &
+ ocn_restart_eliassen_palm, &
+ ocn_finalize_eliassen_palm
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ real (kind=RKIND), parameter :: epsilonEPFT=1.0e-15_RKIND
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_eliassen_palm
+!
+!> \brief Initialize MPAS-Ocean analysis member
+!> \author Juan A. Saenz, Todd Ringler
+!> \date May 2015
+!> \details
+!> This routine conducts all initializations required for the
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_eliassen_palm(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+ integer :: err_tmp
+ integer :: k
+ real (KIND=RKIND) :: deltaBuoyancy, deltaDensity
+
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: amEPFTPool
+
+ integer :: nBuoyancyLayers
+ real (kind=RKIND), dimension(:), pointer :: potentialDensityMidRef
+ real (kind=RKIND), dimension(:), pointer :: potentialDensityTopRef
+ real (kind=RKIND), dimension(:), pointer :: buoyancyMidRef
+ real (kind=RKIND), dimension(:), pointer :: buoyancyInterfaceRef
+
+ logical, pointer :: amEPFTActive
+ logical, pointer :: config_AM_eliassenPalm_compute_on_startup
+ integer, pointer :: config_AM_eliassenPalm_nBuoyancyLayers
+ real (kind=RKIND), pointer :: config_AM_eliassenPalm_rhomax_buoycoor
+ real (kind=RKIND), pointer :: config_AM_eliassenPalm_rhomin_buoycoor
+
+ integer, pointer :: nSamplesEA
+
+ real (kind=RKIND), dimension(:,:), pointer :: buoyancyMaskEA
+ real (kind=RKIND), dimension(:,:), pointer :: sigmaEA
+ real (kind=RKIND), dimension(:,:), pointer :: heightMidBuoyCoorEA
+ real (kind=RKIND), dimension(:,:), pointer :: montgPotBuoyCoorEA
+ real (kind=RKIND), dimension(:,:), pointer :: montgPotGradZonalEA
+ real (kind=RKIND), dimension(:,:), pointer :: montgPotGradMeridEA
+ real (kind=RKIND), dimension(:,:), pointer :: heightMidBuoyCoorSqEA
+ real (kind=RKIND), dimension(:,:), pointer :: heightMGradZonalEA
+ real (kind=RKIND), dimension(:,:), pointer :: heightMGradMeridEA
+ real (kind=RKIND), dimension(:,:), pointer :: usigmaEA
+ real (kind=RKIND), dimension(:,:), pointer :: vsigmaEA
+ real (kind=RKIND), dimension(:,:), pointer :: varpisigmaEA
+ real (kind=RKIND), dimension(:,:), pointer :: uusigmaEA
+ real (kind=RKIND), dimension(:,:), pointer :: vvsigmaEA
+ real (kind=RKIND), dimension(:,:), pointer :: uvsigmaEA
+ real (kind=RKIND), dimension(:,:), pointer :: uvarpisigmaEA
+ real (kind=RKIND), dimension(:,:), pointer :: vvarpisigmaEA
+
+ err = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_AM_eliassenPalm_compute_on_startup', &
+ config_AM_eliassenPalm_compute_on_startup)
+ call mpas_pool_get_config(domain % configs, 'config_AM_eliassenPalm_nBuoyancyLayers', &
+ config_AM_eliassenPalm_nBuoyancyLayers)
+ call mpas_pool_get_config(domain % configs, 'config_AM_eliassenPalm_rhomax_buoycoor', &
+ config_AM_eliassenPalm_rhomax_buoycoor)
+ call mpas_pool_get_config(domain % configs, 'config_AM_eliassenPalm_rhomin_buoycoor', &
+ config_AM_eliassenPalm_rhomin_buoycoor)
+
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_pool_get_subpool(block % structs, 'eliassenPalmAM', amEPFTPool)
+
+ !-----------------------------------------------------------------
+ ! set up pointers
+ !-----------------------------------------------------------------
+ call mpas_pool_get_array(amEPFTPool, 'potentialDensityMidRef', potentialDensityMidRef)
+ call mpas_pool_get_array(amEPFTPool, 'potentialDensityTopRef', potentialDensityTopRef)
+ call mpas_pool_get_array(amEPFTPool, 'buoyancyMidRef', buoyancyMidRef)
+ call mpas_pool_get_array(amEPFTPool, 'buoyancyInterfaceRef', buoyancyInterfaceRef)
+
+ !-----------------------------------------------------------------
+ ! compute buoyancy and density increment of each layer
+ ! at present we use layer interfaces that are evenly-spaced in buoyancy space
+ !-----------------------------------------------------------------
+ nBuoyancyLayers = config_AM_eliassenPalm_nBuoyancyLayers
+ deltaDensity = (config_AM_eliassenPalm_rhomax_buoycoor &
+ - config_AM_eliassenPalm_rhomin_buoycoor) / config_AM_eliassenPalm_nBuoyancyLayers
+ deltaBuoyancy = -gravity * deltaDensity / rho_sw
+
+ !-----------------------------------------------------------------
+ ! compute density/bouyancy at top of each layer
+ !-----------------------------------------------------------------
+ do k = 1, nBuoyancyLayers
+ potentialDensityTopRef(k) = config_AM_eliassenPalm_rhomin_buoycoor + deltaDensity * (k-1)
+ buoyancyInterfaceRef(k) = -gravity &
+ * (config_AM_eliassenPalm_rhomin_buoycoor - rho_sw) / rho_sw &
+ + deltaBuoyancy * (k-1)
+ end do
+ k=nBuoyancyLayers
+ buoyancyInterfaceRef(k+1) = buoyancyInterfaceRef(k) + deltaBuoyancy
+
+ !-----------------------------------------------------------------
+ ! compute density/bouyancy for each layer
+ !-----------------------------------------------------------------
+ do k = 1, nBuoyancyLayers-1
+ potentialDensityMidRef(k) = 0.5_RKIND*(potentialDensityTopRef(k) + potentialDensityTopRef(k+1))
+ buoyancyMidRef(k) = 0.5_RKIND*(buoyancyInterfaceRef(k) + buoyancyInterfaceRef(k+1))
+ end do
+ k=nBuoyancyLayers
+ potentialDensityMidRef(k) = 0.5*(potentialDensityTopRef(k) + config_AM_eliassenPalm_rhomax_buoycoor)
+ buoyancyMidRef(k) = 0.5_RKIND*(buoyancyInterfaceRef(k) + buoyancyInterfaceRef(k+1))
+
+ block => block % next
+
+ end do
+
+
+ end subroutine ocn_init_eliassen_palm!}}}
+
+!***********************************************************************
+!
+! routine ocn_compute_eliassen_palm
+!
+!> \brief Compute Eliassen-Palm flux tensor
+!> \author Juan A. Saenz, Todd Ringler
+!> \date May 2015
+!> \details
+!> This routine conducts all computations required for the EPFT analysis member.
+!> Each time this AM is called, the instananeous ocean state is interpolated
+!> onto the target buoyancy values. The state is then accumulated into the
+!> ensemble average variable arrays (varEA). Based on the current
+!> estimate of the ensemble average, thickness-weight velocities are estimated
+!> along with the computation of the Eliassen-Palm flux tensor.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_compute_eliassen_palm(domain, timeLevel, err)!{{{
+
+ use mpas_vector_reconstruction
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(in) :: timeLevel
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ ! define types that live inside of domain
+ !-----------------------------------------------------------------
+ type (dm_info) :: dminfo
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: am_epftPool
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: scratchPool
+ type (mpas_pool_type), pointer :: forcingPool
+ type (mpas_pool_type), pointer :: diagnosticsPool
+
+ !-----------------------------------------------------------------
+ ! define pointers to namelist config variables local to the EPFT module
+ !-----------------------------------------------------------------
+ logical, pointer :: config_AM_eliassenPalm_debug
+ real (kind=RKIND), pointer :: config_AM_eliassenPalm_rhomin_buoycoor
+ real (kind=RKIND), pointer :: config_AM_eliassenPalm_rhomax_buoycoor
+
+ !-----------------------------------------------------------------
+ ! define local scalars holding length of dimensions
+ !-----------------------------------------------------------------
+ integer, pointer :: nVertLevels, nBuoyancyLayers, nBuoyancyLayersP1
+ integer, pointer :: nEdges, nCells, nCellsSolve ! nCellsSolve does not include halo
+
+ !-----------------------------------------------------------------
+ ! define buoyancy coordinates and fields related to the vertical direction
+ !-----------------------------------------------------------------
+ integer, dimension(:), pointer :: maxLevelCell
+ real(KIND=RKIND), dimension(:), pointer :: potentialDensityMidRef
+ real(KIND=RKIND), dimension(:), pointer :: potentialDensityTopRef
+ real(KIND=RKIND), dimension(:), pointer :: buoyancyMidRef
+ real(KIND=RKIND), dimension(:), pointer :: buoyancyInterfaceRef
+ real(KIND=RKIND), dimension(:), pointer :: bottomDepth
+
+ !-----------------------------------------------------------------
+ ! define mesh variables
+ !-----------------------------------------------------------------
+ real(KIND=RKIND), dimension(:), pointer :: fCell
+ integer, dimension(:,:), pointer :: cellMask
+
+ !-----------------------------------------------------------------
+ ! define fields related to the Ensemble Average (EA)
+ !-----------------------------------------------------------------
+ integer, pointer :: nSamplesEA
+ real(KIND=RKIND), dimension(:,:), pointer :: buoyancyMaskEA
+ real(KIND=RKIND), dimension(:,:), pointer :: sigmaEA
+ real(KIND=RKIND), dimension(:,:), pointer :: heightMidBuoyCoorEA
+ real(KIND=RKIND), dimension(:,:), pointer :: montgPotGradZonalEA
+ real(KIND=RKIND), dimension(:,:), pointer :: montgPotGradMeridEA
+ real(KIND=RKIND), dimension(:,:), pointer :: heightMidBuoyCoorSqEA
+ real(KIND=RKIND), dimension(:,:), pointer :: montgPotBuoyCoorEA
+ real(KIND=RKIND), dimension(:,:), pointer :: heightMGradZonalEA
+ real(KIND=RKIND), dimension(:,:), pointer :: heightMGradMeridEA
+ real(KIND=RKIND), dimension(:,:), pointer :: usigmaEA
+ real(KIND=RKIND), dimension(:,:), pointer :: vsigmaEA
+ real(KIND=RKIND), dimension(:,:), pointer :: varpisigmaEA
+ real(KIND=RKIND), dimension(:,:), pointer :: uusigmaEA
+ real(KIND=RKIND), dimension(:,:), pointer :: vvsigmaEA
+ real(KIND=RKIND), dimension(:,:), pointer :: uvsigmaEA
+ real(KIND=RKIND), dimension(:,:), pointer :: uvarpisigmaEA
+ real(KIND=RKIND), dimension(:,:), pointer :: vvarpisigmaEA
+
+ !-----------------------------------------------------------------
+ ! define the Thickness-Weighted Average (TWA) velocity
+ !-----------------------------------------------------------------
+ real(KIND=RKIND), dimension(:,:), pointer :: uTWA
+ real(KIND=RKIND), dimension(:,:), pointer :: vTWA
+ real(KIND=RKIND), dimension(:,:), pointer :: varpiTWA
+ real(KIND=RKIND), dimension(:,:), pointer :: duTWAdz
+ real(KIND=RKIND), dimension(:,:), pointer :: dvTWAdz
+
+ !-----------------------------------------------------------------
+ ! define Ertel's potential vorticity and related fields
+ !-----------------------------------------------------------------
+ real(KIND=RKIND), dimension(:,:), pointer :: ErtelPV
+ real(KIND=RKIND), dimension(:,:), pointer :: ErtelPVGradZonal
+ real(KIND=RKIND), dimension(:,:), pointer :: ErtelPVGradMerid
+ real(KIND=RKIND), dimension(:,:), pointer :: ErtelPVTendency
+ real(KIND=RKIND), dimension(:,:,:), pointer :: ErtelPVFlux
+ real(KIND=RKIND), dimension(:,:), pointer :: ErtelPVFlux1
+ real(KIND=RKIND), dimension(:,:), pointer :: ErtelPVFlux2
+
+ !-----------------------------------------------------------------
+ ! define the Eliassen-Palm flux tensor and related fields
+ !-----------------------------------------------------------------
+ real(KIND=RKIND), dimension(:,:,:,:), pointer :: EPFT
+ real(KIND=RKIND), dimension(:,:,:), pointer :: divEPFT
+ real(KIND=RKIND), dimension(:,:), pointer :: divEPFT1
+ real(KIND=RKIND), dimension(:,:), pointer :: divEPFT2
+ real(KIND=RKIND), dimension(:,:), pointer :: divEPFTshear1
+ real(KIND=RKIND), dimension(:,:), pointer :: divEPFTshear2
+ real(KIND=RKIND), dimension(:,:), pointer :: divEPFTdrag1
+ real(KIND=RKIND), dimension(:,:), pointer :: divEPFTdrag2
+ real(KIND=RKIND), dimension(:,:), pointer :: uuTWACorr
+ real(KIND=RKIND), dimension(:,:), pointer :: vvTWACorr
+ real(KIND=RKIND), dimension(:,:), pointer :: uvTWACorr
+ real(KIND=RKIND), dimension(:,:), pointer :: epeTWA
+ real(KIND=RKIND), dimension(:,:), pointer :: eddyFormDragZonal
+ real(KIND=RKIND), dimension(:,:), pointer :: eddyFormDragMerid
+
+ !-----------------------------------------------------------------
+ ! define scratch fields used as work variables and for testing
+ !-----------------------------------------------------------------
+ type(field1DInteger), pointer :: firstLayerBuoyCoorField
+ type(field1DInteger), pointer :: lastLayerBuoyCoorField
+ type(field2DReal), pointer :: heightMidBuoyCoorField
+ type(field2DReal), pointer :: heightTopBuoyCoorField
+ type(field2DReal), pointer :: heightInterfaceBuoyCoorField
+ type(field2DReal), pointer :: sigmaField
+ type(field2DReal), pointer :: montgPotBuoyCoorField
+ type(field2DReal), pointer :: montgPotNormalGradOnEdgeField
+ type(field2DReal), pointer :: uMidBuoyCoorField
+ type(field2DReal), pointer :: vMidBuoyCoorField
+ type(field2DReal), pointer :: densityMidBuoyCoorField
+ type(field2DReal), pointer :: densityTopBuoyCoorField
+ type(field2DReal), pointer :: buoyancyMaskField
+ type(field2DReal), pointer :: montgPotGradXField
+ type(field2DReal), pointer :: montgPotGradYField
+ type(field2DReal), pointer :: montgPotGradZField
+ type(field2DReal), pointer :: montgPotGradZonalField
+ type(field2DReal), pointer :: montgPotGradMeridField
+ type(field2DReal), pointer :: wrk3DnVertLevelsP1Field
+ type(field2DReal), pointer :: wrk3DnVertLevelsField
+ type(field2DReal), pointer :: wrk3DBuoyCoorField
+ type(field2DReal), pointer :: ErtelPVNormalGradOnEdgeField
+ type(field2DReal), pointer :: ErtelPVGradXField
+ type(field2DReal), pointer :: ErtelPVGradYField
+ type(field2DReal), pointer :: ErtelPVGradZField
+ type(field3DReal), pointer :: wrkVectorField
+ type(field4DReal), pointer :: wrkTensorField
+
+ type(field2DReal), pointer :: array1_3DField
+ type(field2DReal), pointer :: array2_3DField
+ type(field2DReal), pointer :: array3_3DField
+ type(field2DReal), pointer :: array1_3DbuoyField
+ type(field2DReal), pointer :: array2_3DbuoyField
+ type(field2DReal), pointer :: PVMidBuoyCoorField
+ type(field2DReal), pointer :: PVMidBuoyCoorEAField
+ type(field2DReal), pointer :: uMidBuoyCoorEAField
+ type(field2DReal), pointer :: vMidBuoyCoorEAField
+ type(field2DReal), pointer :: uPVMidBuoyCoorEAField
+ type(field2DReal), pointer :: vPVMidBuoyCoorEAField
+ type(field3DReal), pointer :: PVFluxTestField
+
+ !-----------------------------------------------------------------
+ ! define pointers to scratch fields
+ !-----------------------------------------------------------------
+ integer, dimension(:), pointer :: firstLayerBuoyCoor
+ integer, dimension(:), pointer :: lastLayerBuoyCoor
+ real(KIND=RKIND), dimension(:,:), pointer :: heightMidBuoyCoor
+ real(KIND=RKIND), dimension(:,:), pointer :: heightTopBuoyCoor
+ real(KIND=RKIND), dimension(:,:), pointer :: heightInterfaceBuoyCoor
+ real(KIND=RKIND), dimension(:,:), pointer :: sigma
+ real(KIND=RKIND), dimension(:,:), pointer :: montgPotBuoyCoor
+ real(KIND=RKIND), dimension(:,:), pointer :: montgPotNormalGradOnEdge
+ real(KIND=RKIND), dimension(:,:), pointer :: uMidBuoyCoor
+ real(KIND=RKIND), dimension(:,:), pointer :: vMidBuoyCoor
+ real(KIND=RKIND), dimension(:,:), pointer :: densityMidBuoyCoor
+ real(KIND=RKIND), dimension(:,:), pointer :: densityTopBuoyCoor
+ real(KIND=RKIND), dimension(:,:), pointer :: buoyancyMask
+ real(KIND=RKIND), dimension(:,:), pointer :: montgPotGradX
+ real(KIND=RKIND), dimension(:,:), pointer :: montgPotGradY
+ real(KIND=RKIND), dimension(:,:), pointer :: montgPotGradZ
+ real(KIND=RKIND), dimension(:,:), pointer :: montgPotGradZonal
+ real(KIND=RKIND), dimension(:,:), pointer :: montgPotGradMerid
+ real(KIND=RKIND), dimension(:,:), pointer :: wrk3DnVertLevelsP1
+ real(KIND=RKIND), dimension(:,:), pointer :: wrk3DnVertLevels
+ real(KIND=RKIND), dimension(:,:), pointer :: wrk3DBuoyCoor
+ real(KIND=RKIND), dimension(:,:), pointer :: ErtelPVNormalGradOnEdge
+ real(KIND=RKIND), dimension(:,:), pointer :: ErtelPVGradX
+ real(KIND=RKIND), dimension(:,:), pointer :: ErtelPVGradY
+ real(KIND=RKIND), dimension(:,:), pointer :: ErtelPVGradZ
+ real(KIND=RKIND), dimension(:,:,:), pointer :: wrkVector
+ real(KIND=RKIND), dimension(:,:,:,:), pointer :: wrkTensor
+
+ real(KIND=RKIND), dimension(:,:), pointer :: array1_3D
+ real(KIND=RKIND), dimension(:,:), pointer :: array2_3D
+ real(KIND=RKIND), dimension(:,:), pointer :: array3_3D
+ real(KIND=RKIND), dimension(:,:), pointer :: array1_3Dbuoy
+ real(KIND=RKIND), dimension(:,:), pointer :: array2_3Dbuoy
+ real(KIND=RKIND), dimension(:,:), pointer :: PVMidBuoyCoor
+ real(KIND=RKIND), dimension(:,:), pointer :: PVMidBuoyCoorEA
+ real(KIND=RKIND), dimension(:,:), pointer :: uMidBuoyCoorEA
+ real(KIND=RKIND), dimension(:,:), pointer :: vMidBuoyCoorEA
+ real(KIND=RKIND), dimension(:,:), pointer :: uPVMidBuoyCoorEA
+ real(KIND=RKIND), dimension(:,:), pointer :: vPVMidBuoyCoorEA
+ real(KIND=RKIND), dimension(:,:,:), pointer :: PVFluxTest
+
+ !-----------------------------------------------------------------
+ ! define some arrays in z-coordinates, obtained from diagnostics and forcing
+ !-----------------------------------------------------------------
+ real(KIND=RKIND), dimension(:), pointer :: seaSurfacePressure
+ real(KIND=RKIND), dimension(:,:), pointer :: zMid
+ real(KIND=RKIND), dimension(:,:), pointer :: zTop
+ real(KIND=RKIND), dimension(:,:), pointer :: density
+ real(KIND=RKIND), dimension(:,:), pointer :: potentialDensity
+ real(KIND=RKIND), dimension(:,:), pointer :: pressure
+ real(KIND=RKIND), dimension(:,:), pointer :: velocityZonal
+ real(KIND=RKIND), dimension(:,:), pointer :: velocityMeridional
+ real(KIND=RKIND), dimension(:,:), pointer :: relativeVorticityCell ! jas used for testing
+ !real(KIND=RKIND), dimension(:,:), pointer :: wCellCenter
+
+ !-----------------------------------------------------------------
+ ! define local test variables
+ !-----------------------------------------------------------------
+ ! jas to do : move these to scratch in Registry_epft
+ integer :: nCellsCum
+ real(KIND=RKIND) :: RMSlocal1, RMSglobal1
+ real(KIND=RKIND) :: RMSlocal2, RMSglobal2
+ real(KIND=RKIND) :: RMSPVFlux1local, RMSPVFlux1global
+ real(KIND=RKIND) :: RMSPVFlux2local, RMSPVFlux2global
+
+ !-----------------------------------------------------------------
+ ! define local work variables
+ !-----------------------------------------------------------------
+ integer :: nCellsGlobal, k, i
+
+ err = 0
+
+ nCellsCum = 0
+ RMSlocal1 = 0.0_RKIND
+ RMSlocal2 = 0.0_RKIND
+ RMSglobal1 = 0.0_RKIND
+ RMSglobal2 = 0.0_RKIND
+ RMSPVFlux1local = 0.0_RKIND
+ RMSPVFlux2local = 0.0_RKIND
+ RMSPVFlux1global = 0.0_RKIND
+ RMSPVFlux2global = 0.0_RKIND
+
+ dminfo = domain % dminfo
+
+ !--------------------------------------------------
+ ! get config variables
+ !--------------------------------------------------
+ call mpas_pool_get_config(domain % configs, 'config_AM_eliassenPalm_debug', &
+ config_AM_eliassenPalm_debug)
+ call mpas_pool_get_config(domain % configs, 'config_AM_eliassenPalm_rhomin_buoycoor', &
+ config_AM_eliassenPalm_rhomin_buoycoor)
+ call mpas_pool_get_config(domain % configs, 'config_AM_eliassenPalm_rhomax_buoycoor', &
+ config_AM_eliassenPalm_rhomax_buoycoor)
+
+ if(config_AM_eliassenPalm_debug) then
+ write(stderrUnit, *) ' '
+ write(stderrUnit, *) 'starting ocn_compute_epft'
+ write(stderrUnit, *) ' '
+ end if
+
+ block => domain % blocklist
+ do while (associated(block))
+
+ !--------------------------------------------------
+ ! assign pointers for each pool
+ !--------------------------------------------------
+ call mpas_pool_get_subpool(block % structs, 'eliassenPalmAM', am_epftPool)
+ call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block % structs, 'eliassenPalmAMPKGScratch', scratchPool)
+ call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool)
+ call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
+
+ !--------------------------------------------------
+ ! assign pointers for mesh-related variables
+ !--------------------------------------------------
+ call mpas_pool_get_dimension(block % dimensions, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+ call mpas_pool_get_dimension(block % dimensions, 'nCells', nCells)
+ call mpas_pool_get_dimension(block % dimensions, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'fCell', fCell)
+ call mpas_pool_get_array(meshPool, 'cellMask', cellMask) ! used for tests
+
+
+ !--------------------------------------------------
+ ! get scratch field pointers
+ !--------------------------------------------------
+ call mpas_pool_get_field(scratchPool, 'firstLayerBuoyCoor', firstLayerBuoyCoorField)
+ call mpas_pool_get_field(scratchPool, 'lastLayerBuoyCoor', lastLayerBuoyCoorField)
+ call mpas_pool_get_field(scratchPool, 'heightMidBuoyCoor', heightMidBuoyCoorField)
+ call mpas_pool_get_field(scratchPool, 'heightTopBuoyCoor', heightTopBuoyCoorField)
+ call mpas_pool_get_field(scratchPool, 'heightInterfaceBuoyCoor', heightInterfaceBuoyCoorField)
+ call mpas_pool_get_field(scratchPool, 'sigma', sigmaField)
+ call mpas_pool_get_field(scratchPool, 'montgPotBuoyCoor', montgPotBuoyCoorField)
+ call mpas_pool_get_field(scratchPool, 'montgPotNormalGradOnEdge', montgPotNormalGradOnEdgeField)
+ call mpas_pool_get_field(scratchPool, 'uMidBuoyCoor', uMidBuoyCoorField)
+ call mpas_pool_get_field(scratchPool, 'vMidBuoyCoor', vMidBuoyCoorField)
+ call mpas_pool_get_field(scratchPool, 'densityMidBuoyCoor', densityMidBuoyCoorField)
+ call mpas_pool_get_field(scratchPool, 'densityTopBuoyCoor', densityTopBuoyCoorField)
+ call mpas_pool_get_field(scratchPool, 'buoyancyMask', buoyancyMaskField)
+ call mpas_pool_get_field(scratchPool, 'montgPotGradX', montgPotGradXField)
+ call mpas_pool_get_field(scratchPool, 'montgPotGradY', montgPotGradYField)
+ call mpas_pool_get_field(scratchPool, 'montgPotGradZ', montgPotGradZField)
+ call mpas_pool_get_field(scratchPool, 'montgPotGradZonal', montgPotGradZonalField)
+ call mpas_pool_get_field(scratchPool, 'montgPotGradMerid', montgPotGradMeridField)
+ call mpas_pool_get_field(scratchPool, 'wrk3DnVertLevelsP1', wrk3DnVertLevelsP1Field)
+ call mpas_pool_get_field(scratchPool, 'wrk3DnVertLevels', wrk3DnVertLevelsField)
+ call mpas_pool_get_field(scratchPool, 'wrk3DBuoyCoor', wrk3DBuoyCoorField)
+ call mpas_pool_get_field(scratchPool, 'ErtelPVNormalGradOnEdge', ErtelPVNormalGradOnEdgeField)
+ call mpas_pool_get_field(scratchPool, 'ErtelPVGradX', ErtelPVGradXField)
+ call mpas_pool_get_field(scratchPool, 'ErtelPVGradY', ErtelPVGradYField)
+ call mpas_pool_get_field(scratchPool, 'ErtelPVGradZ', ErtelPVGradZField)
+ call mpas_pool_get_field(scratchPool, 'wrkVector', wrkVectorField)
+ call mpas_pool_get_field(scratchPool, 'wrkTensor', wrkTensorField)
+
+ call mpas_pool_get_field(scratchPool, 'array1_3D', array1_3DField)
+ call mpas_pool_get_field(scratchPool, 'array2_3D', array2_3DField)
+ call mpas_pool_get_field(scratchPool, 'array3_3D', array3_3DField)
+ call mpas_pool_get_field(scratchPool, 'array1_3Dbuoy', array1_3DbuoyField)
+ call mpas_pool_get_field(scratchPool, 'array2_3Dbuoy', array2_3DbuoyField)
+ call mpas_pool_get_field(scratchPool, 'PVMidBuoyCoor', PVMidBuoyCoorField)
+ call mpas_pool_get_field(scratchPool, 'PVMidBuoyCoorEA', PVMidBuoyCoorEAField)
+ call mpas_pool_get_field(scratchPool, 'uMidBuoyCoorEA', uMidBuoyCoorEAField)
+ call mpas_pool_get_field(scratchPool, 'vMidBuoyCoorEA', vMidBuoyCoorEAField)
+ call mpas_pool_get_field(scratchPool, 'uPVMidBuoyCoorEA', uPVMidBuoyCoorEAField)
+ call mpas_pool_get_field(scratchPool, 'vPVMidBuoyCoorEA', vPVMidBuoyCoorEAField)
+ call mpas_pool_get_field(scratchPool, 'PVFluxTest', PVFluxTestField)
+
+ !--------------------------------------------------
+ ! allocate scratch field variables
+ !--------------------------------------------------
+ call mpas_allocate_scratch_field(firstLayerBuoyCoorField, .true.)
+ call mpas_allocate_scratch_field(lastLayerBuoyCoorField, .true.)
+ call mpas_allocate_scratch_field(heightMidBuoyCoorField, .true.)
+ call mpas_allocate_scratch_field(heightTopBuoyCoorField, .true.)
+ call mpas_allocate_scratch_field(heightInterfaceBuoyCoorField, .true.)
+ call mpas_allocate_scratch_field(sigmaField, .true.)
+ call mpas_allocate_scratch_field(montgPotBuoyCoorField, .true.)
+ call mpas_allocate_scratch_field(montgPotNormalGradOnEdgeField, .true.)
+ call mpas_allocate_scratch_field(uMidBuoyCoorField, .true.)
+ call mpas_allocate_scratch_field(vMidBuoyCoorField, .true.)
+ call mpas_allocate_scratch_field(densityMidBuoyCoorField, .true.)
+ call mpas_allocate_scratch_field(densityTopBuoyCoorField, .true.)
+ call mpas_allocate_scratch_field(buoyancyMaskField, .true.)
+ call mpas_allocate_scratch_field(montgPotGradXField, .true.)
+ call mpas_allocate_scratch_field(montgPotGradYField, .true.)
+ call mpas_allocate_scratch_field(montgPotGradZField, .true.)
+ call mpas_allocate_scratch_field(montgPotGradZonalField, .true.)
+ call mpas_allocate_scratch_field(montgPotGradMeridField, .true.)
+ call mpas_allocate_scratch_field(wrk3DnVertLevelsP1Field, .true.)
+ call mpas_allocate_scratch_field(wrk3DnVertLevelsField, .true.)
+ call mpas_allocate_scratch_field(wrk3DBuoyCoorField, .true.)
+ call mpas_allocate_scratch_field(ErtelPVNormalGradOnEdgeField, .true.)
+ call mpas_allocate_scratch_field(ErtelPVGradXField, .true.)
+ call mpas_allocate_scratch_field(ErtelPVGradYField, .true.)
+ call mpas_allocate_scratch_field(ErtelPVGradZField, .true.)
+ call mpas_allocate_scratch_field(wrkVectorField, .true.)
+ call mpas_allocate_scratch_field(wrkTensorField, .true.)
+
+ call mpas_allocate_scratch_field(array1_3DField, .true.)
+ call mpas_allocate_scratch_field(array2_3DField, .true.)
+ call mpas_allocate_scratch_field(array3_3DField, .true.)
+ call mpas_allocate_scratch_field(array1_3DbuoyField, .true.)
+ call mpas_allocate_scratch_field(array2_3DbuoyField, .true.)
+ call mpas_allocate_scratch_field(PVMidBuoyCoorField, .true.)
+ call mpas_allocate_scratch_field(PVMidBuoyCoorEAField, .true.)
+ call mpas_allocate_scratch_field(uMidBuoyCoorEAField, .true.)
+ call mpas_allocate_scratch_field(vMidBuoyCoorEAField, .true.)
+ call mpas_allocate_scratch_field(uPVMidBuoyCoorEAField, .true.)
+ call mpas_allocate_scratch_field(vPVMidBuoyCoorEAField, .true.)
+ call mpas_allocate_scratch_field(PVFluxTestField, .true.)
+
+ !--------------------------------------------------
+ ! assign pointers for scratch and test variables
+ !--------------------------------------------------
+ firstLayerBuoyCoor => firstLayerBuoyCoorField % array
+ lastLayerBuoyCoor => lastLayerBuoyCoorField % array
+ heightMidBuoyCoor => heightMidBuoyCoorField % array
+ heightTopBuoyCoor => heightTopBuoyCoorField % array
+ heightInterfaceBuoyCoor => heightInterfaceBuoyCoorField % array
+ sigma => sigmaField % array
+ montgPotBuoyCoor => montgPotBuoyCoorField % array
+ montgPotNormalGradOnEdge=> montgPotNormalGradOnEdgeField % array
+ uMidBuoyCoor => uMidBuoyCoorField % array
+ vMidBuoyCoor => vMidBuoyCoorField % array
+ densityMidBuoyCoor => densityMidBuoyCoorField % array
+ densityTopBuoyCoor => densityTopBuoyCoorField % array
+ buoyancyMask => buoyancyMaskField % array
+ montgPotGradX => montgPotGradXField % array
+ montgPotGradY => montgPotGradYField % array
+ montgPotGradZ => montgPotGradZField % array
+ montgPotGradZonal => montgPotGradZonalField % array
+ montgPotGradMerid => montgPotGradMeridField % array
+ wrk3DnVertLevelsP1 => wrk3DnVertLevelsP1Field % array
+ wrk3DnVertLevels => wrk3DnVertLevelsField % array
+ wrk3DBuoyCoor => wrk3DBuoyCoorField % array
+ ErtelPVNormalGradOnEdge => ErtelPVNormalGradOnEdgeField % array
+ ErtelPVGradX => ErtelPVGradXField % array
+ ErtelPVGradY => ErtelPVGradYField % array
+ ErtelPVGradZ => ErtelPVGradZField % array
+ wrkVector => wrkVectorField % array
+ wrkTensor => wrkTensorField % array
+
+ array1_3D => array1_3DField % array
+ array2_3D => array2_3DField % array
+ array3_3D => array3_3DField % array
+ array1_3Dbuoy => array1_3DbuoyField % array
+ array2_3Dbuoy => array2_3DbuoyField % array
+ PVMidBuoyCoor => PVMidBuoyCoorField % array
+ PVMidBuoyCoorEA => PVMidBuoyCoorEAField % array
+ uMidBuoyCoorEA => uMidBuoyCoorEAField % array
+ vMidBuoyCoorEA => vMidBuoyCoorEAField % array
+ uPVMidBuoyCoorEA => uPVMidBuoyCoorEAField % array
+ vPVMidBuoyCoorEA => vPVMidBuoyCoorEAField % array
+ PVFluxTest => PVFluxTestField % array
+
+ !--------------------------------------------------
+ ! assign pointers used from forcing pool
+ !--------------------------------------------------
+ call mpas_pool_get_array(forcingPool, 'seaSurfacePressure', seaSurfacePressure)
+
+ !--------------------------------------------------
+ ! get diagnostic variables
+ !--------------------------------------------------
+ call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
+ call mpas_pool_get_array(diagnosticsPool, 'zTop', zTop)
+ call mpas_pool_get_array(diagnosticsPool, 'density', density)
+ call mpas_pool_get_array(diagnosticsPool, 'potentialDensity', potentialDensity)
+ call mpas_pool_get_array(diagnosticsPool, 'pressure', pressure)
+ call mpas_pool_get_array(diagnosticsPool, 'velocityZonal', velocityZonal)
+ call mpas_pool_get_array(diagnosticsPool, 'velocityMeridional', velocityMeridional)
+
+ !--------------------------------------------------
+ ! variables that define the vertical coordinate system in density/buoyancy space
+ !--------------------------------------------------
+ call mpas_pool_get_dimension(block % dimensions, 'nBuoyancyLayers', nBuoyancyLayers)
+ call mpas_pool_get_dimension(block % dimensions, 'nBuoyancyLayersP1', nBuoyancyLayersP1)
+ call mpas_pool_get_array(am_epftPool, 'potentialDensityMidRef', potentialDensityMidRef)
+ call mpas_pool_get_array(am_epftPool, 'potentialDensityTopRef', potentialDensityTopRef)
+ call mpas_pool_get_array(am_epftPool, 'buoyancyMidRef', buoyancyMidRef)
+ call mpas_pool_get_array(am_epftPool, 'buoyancyInterfaceRef', buoyancyInterfaceRef)
+
+ !--------------------------------------------------
+ ! assign pointers for ensemble average (EA) and thickness-weighted averaged state
+ !--------------------------------------------------
+ call mpas_pool_get_array(am_epftPool, 'nSamplesEA', nSamplesEA)
+ call mpas_pool_get_array(am_epftPool, 'buoyancyMaskEA', buoyancyMaskEA)
+ call mpas_pool_get_array(am_epftPool, 'sigmaEA', sigmaEA)
+ call mpas_pool_get_array(am_epftPool, 'heightMidBuoyCoorEA', heightMidBuoyCoorEA)
+ call mpas_pool_get_array(am_epftPool, 'heightMidBuoyCoorSqEA', heightMidBuoyCoorSqEA)
+ call mpas_pool_get_array(am_epftPool, 'montgPotBuoyCoorEA', montgPotBuoyCoorEA)
+ call mpas_pool_get_array(am_epftPool, 'montgPotGradZonalEA', montgPotGradZonalEA)
+ call mpas_pool_get_array(am_epftPool, 'montgPotGradMeridEA', montgPotGradMeridEA)
+ call mpas_pool_get_array(am_epftPool, 'heightMGradZonalEA', HeightMGradZonalEA)
+ call mpas_pool_get_array(am_epftPool, 'heightMGradMeridEA', HeightMGradMeridEA)
+ call mpas_pool_get_array(am_epftPool, 'usigmaEA', usigmaEA)
+ call mpas_pool_get_array(am_epftPool, 'vsigmaEA', vsigmaEA)
+ call mpas_pool_get_array(am_epftPool, 'varpisigmaEA', varpisigmaEA)
+ call mpas_pool_get_array(am_epftPool, 'uusigmaEA', uusigmaEA)
+ call mpas_pool_get_array(am_epftPool, 'vvsigmaEA', vvsigmaEA)
+ call mpas_pool_get_array(am_epftPool, 'uvsigmaEA', uvsigmaEA)
+ call mpas_pool_get_array(am_epftPool, 'uvarpisigmaEA', uvarpisigmaEA)
+ call mpas_pool_get_array(am_epftPool, 'vvarpisigmaEA', vvarpisigmaEA)
+
+ !--------------------------------------------------
+ ! assign pointers for thickness-weighted averaged state
+ !--------------------------------------------------
+ call mpas_pool_get_array(am_epftPool, 'uTWA', uTWA)
+ call mpas_pool_get_array(am_epftPool, 'vTWA', vTWA)
+ call mpas_pool_get_array(am_epftPool, 'varpiTWA', varpiTWA)
+ call mpas_pool_get_array(am_epftPool, 'duTWAdz', duTWAdz)
+ call mpas_pool_get_array(am_epftPool, 'dvTWAdz', dvTWAdz)
+
+ !--------------------------------------------------
+ ! Eliassen-Palm Flux Tensor and related products
+ !--------------------------------------------------
+ call mpas_pool_get_array(am_epftPool, 'EPFT', EPFT)
+ call mpas_pool_get_array(am_epftPool, 'divEPFT', divEPFT)
+ call mpas_pool_get_array(am_epftPool, 'divEPFT1', divEPFT1)
+ call mpas_pool_get_array(am_epftPool, 'divEPFT2', divEPFT2)
+ call mpas_pool_get_array(am_epftPool, 'divEPFTshear1', divEPFTshear1)
+ call mpas_pool_get_array(am_epftPool, 'divEPFTshear2', divEPFTshear2)
+ call mpas_pool_get_array(am_epftPool, 'divEPFTdrag1', divEPFTdrag1)
+ call mpas_pool_get_array(am_epftPool, 'divEPFTdrag2', divEPFTdrag2)
+ call mpas_pool_get_array(am_epftPool, 'uuTWACorr', uuTWACorr)
+ call mpas_pool_get_array(am_epftPool, 'vvTWACorr', vvTWACorr)
+ call mpas_pool_get_array(am_epftPool, 'uvTWACorr', uvTWACorr)
+ call mpas_pool_get_array(am_epftPool, 'epeTWA', epeTWA)
+ call mpas_pool_get_array(am_epftPool, 'eddyFormDragZonal', eddyFormDragZonal)
+ call mpas_pool_get_array(am_epftPool, 'eddyFormDragMerid', eddyFormDragMerid)
+
+ call mpas_pool_get_array(am_epftPool, 'ErtelPVFlux' , ErtelPVFlux)
+ call mpas_pool_get_array(am_epftPool, 'ErtelPVFlux1', ErtelPVFlux1)
+ call mpas_pool_get_array(am_epftPool, 'ErtelPVFlux2', ErtelPVFlux2)
+ call mpas_pool_get_array(am_epftPool, 'ErtelPVTendency', ErtelPVTendency)
+ call mpas_pool_get_array(am_epftPool, 'ErtelPV', ErtelPV)
+ call mpas_pool_get_array(am_epftPool, 'ErtelPVGradZonal', ErtelPVGradZonal)
+ call mpas_pool_get_array(am_epftPool, 'ErtelPVGradMerid', ErtelPVGradMerid)
+
+ !--------------------------------------------------
+ ! Get variables associated to diabatic processes
+ !--------------------------------------------------
+ !jas issue diabatic terms
+ ! diabaticHeating(nVertLevels,nCells)! "vertical velocity" in buoyancy space
+ !wCellCenter = 0.0
+ ! Get diabaticTimeTendency of a buoyancy surface, omega with funny hat, if any.
+ !call any existing MPAS-O subroutines for this
+
+
+ !-------------------------------------------------------------
+ ! begin computation
+ !-------------------------------------------------------------
+
+ !-------------------------------------------------------------
+ ! compute firstLayerBuoyCoor and lastLayerBuoyCoor
+ ! firstLayerBuoyCoor == top buoyancy coordinate to exist in each column
+ ! lastLayerBuoyCoor == bottom buoyancy coordinate to exist in each column
+ ! buoyancyMask == 1.0 between layers firstLayerBuoyCoor and lastLayerBuoyCoor
+ !-------------------------------------------------------------
+ call get_masks_in_buoyancy_coordinates(nVertLevels, nCells, nBuoyancyLayers, &
+ maxLevelCell, potentialDensity, potentialDensityMidRef, &
+ firstLayerBuoyCoor, lastLayerBuoyCoor, buoyancyMask)
+
+ !-------------------------------------------------------------
+ ! TEST for general consistency
+ !-------------------------------------------------------------
+ if(config_AM_eliassenPalm_debug) then
+ print *, ' '
+ print *, 'timeLevel:', timeLevel
+ print *, 'nBuoyancyLayers:', timeLevel
+ print *, ' '
+ print *, 'config_AM_eliassenPalm_rhomin_buoycoor, config_AM_eliassenPalm_rhomax_buoycoor'
+ print *, config_AM_eliassenPalm_rhomin_buoycoor, config_AM_eliassenPalm_rhomax_buoycoor
+ print *, '(config_AM_eliassenPalm_rhomax_buoycoor - config_AM_eliassenPalm_rhomin_buoycoor)/nBuoyancyLayers'
+ print *, (config_AM_eliassenPalm_rhomax_buoycoor - config_AM_eliassenPalm_rhomin_buoycoor)/nBuoyancyLayers
+ print *, 'potentialDensityTopRef (nBuoyancyLayers)'
+ print *, potentialDensityTopRef
+ print *, 'potentialDensityTopRef(2:nBuoyancyLayers)-potentialDensityTopRef(:nBuoyancyLayers-1)'
+ print *, potentialDensityTopRef(2:nBuoyancyLayers)-potentialDensityTopRef(:nBuoyancyLayers-1)
+ print *, 'potentialDensityMidRef (nBuoyancyLayers)'
+ print *, potentialDensityMidRef
+ print *, 'potentialDensityMidRef(2:nBuoyancyLayers)-potentialDensityMidRef(:nBuoyancyLayers-1)'
+ print *, potentialDensityMidRef(2:nBuoyancyLayers)-potentialDensityMidRef(:nBuoyancyLayers-1)
+ print *, 'nCells,nBuoyancyLayers', nCells,nBuoyancyLayers
+ print *, 'nCells*nBuoyancyLayers', nCells*nBuoyancyLayers
+ print *, 'No. valid cells in buoyancy coords sum(buoyancyMask)', sum(buoyancyMask)
+ print *, 'nCells*nVertLevels', nCells*nVertLevels
+ print *, 'sum(cellMask)', sum(cellMask)
+ print *, 'minval(potentialDensity), maxval(potentialDensity)'
+ print *, minval(potentialDensity), maxval(potentialDensity)
+ print *, 'minval(density), maxval(density)'
+ print *, minval(density), maxval(density)
+ endif
+
+ !-------------------------------------------------------------
+ ! INTERPOLATION TEST 1
+ ! stratified, horizontally uniform
+ ! Interpolating from z, rho to z, rho
+ !-------------------------------------------------------------
+ if(config_AM_eliassenPalm_debug) then
+ do i = 1, nCells
+ array1_3D(:,i) = -zMid(:,nCells/2)
+ array2_3D(:,i) = potentialDensity(:,nCells/2)
+ end do
+ print *, ' '
+ print *, 'TEST1: Testing interpolatoin function'
+ print *, 'Interpolating from (z, rho) to (z, rho)'
+ print *, 'call linear_interp_1d_field_along_column(nVertLevels, nCells, ' &
+ // 'nVertLevels, maxLevelCell, array1_3D, array2_3D, array1_3D(:,1), array3_3D)'
+
+ print *, 'sum(array1_3D)/nCells + sum(zMid(:,nCells/2))'
+ print *, sum(array1_3D)/nCells + sum(zMid(:,nCells/2))
+ print *, 'sum(array1_3D)/nCells - sum(array1_3D(:,1))'
+ print *, sum(array1_3D)/nCells - sum(array1_3D(:,1))
+
+ call linear_interp_1d_field_along_column(nVertLevels, nCells, nVertLevels, &
+ maxLevelCell, array1_3D, array2_3D, array1_3D(:,1), array3_3D)
+ print *, 'array1_3D(:,1)'
+ print *, array1_3D(:,1)
+ print *, 'zMid(:,nCells/2)'
+ print *, zMid(:,nCells/2)
+ print *, 'array2_3D(:,1)'
+ print *, array2_3D(:,1)
+ print *, 'array3_3D(:,1)'
+ print *, array3_3D(:,1)
+ print *, 'array2_3D(:,1)-array3_3D(:,1)'
+ print *, array2_3D(:,1)-array3_3D(:,1)
+
+ do i = 1,nCells
+ do k = 1, maxLevelCell(i)
+ RMSlocal1 = RMSlocal1 + &
+ ((array3_3D(k,i) - array2_3D(k,i)))**2
+ !((array3_3D(k,i) - array2_3D(k,i))/array2_3D(k,i))**2
+ end do
+ end do
+ endif
+
+ !-------------------------------------------------------------
+ ! INTERPOLATION TEST 2
+ ! Define a stratification where potential density varies linearly with depth.
+ ! Using reference potential density that varies linearly with index.
+ ! Interpolate z from that potential density to reference potential density.
+ ! Compare to expected values.
+ !-------------------------------------------------------------
+ if(config_AM_eliassenPalm_debug) then
+ do i = 1,nCells
+ do k = 1, nVertLevels
+ array1_3D(k,i) = config_AM_eliassenPalm_rhomin_buoycoor*1.02_RKIND + &
+ (zMid(k,i)-zMid(1,i)) * &
+ (config_AM_eliassenPalm_rhomax_buoycoor*0.98_RKIND &
+ - config_AM_eliassenPalm_rhomin_buoycoor*1.02_RKIND) / &
+ (zMid(nVertLevels,i) - zMid(1,i))
+ array2_3D(k,i) = config_AM_eliassenPalm_rhomin_buoycoor*1.02_RKIND + &
+ (zTop(k,i)-zMid(1,i)) * &
+ (config_AM_eliassenPalm_rhomax_buoycoor*0.98_RKIND &
+ - config_AM_eliassenPalm_rhomin_buoycoor*1.02_RKIND) / &
+ (zMid(nVertLevels,i) - zMid(1,i))
+ end do
+ end do
+ call linear_interp_1d_field_along_column(nVertLevels, nCells, nBuoyancyLayers, &
+ maxLevelCell, array1_3D, zMid, potentialDensityMidRef, array1_3Dbuoy)
+
+ do i = 1,nCells
+ do k = 1, nBuoyancyLayers
+ array2_3Dbuoy(k,i) = zMid(1,i) + &
+ (potentialDensityMidRef(k) - config_AM_eliassenPalm_rhomin_buoycoor*1.02_RKIND) * &
+ (zMid(nVertLevels,i) - zMid(1,i)) / &
+ (config_AM_eliassenPalm_rhomax_buoycoor*0.98_RKIND &
+ - config_AM_eliassenPalm_rhomin_buoycoor*1.02_RKIND)
+ end do
+ end do
+ do i = 1,nCells
+ do k = 1, nBuoyancyLayers
+ RMSlocal2 = RMSlocal2 + &
+ ((array1_3Dbuoy(k,i) - array2_3Dbuoy(k,i))/array2_3Dbuoy(k,i))**2
+ end do
+ end do
+ print *, ' '
+ print *, 'TEST2: Testing interpolation function'
+ print *, 'interpolating a linear function'
+ print *, 'array1_3Dbuoy(:,nCells/2)'
+ print *, array1_3Dbuoy(:,nCells/2)
+ print *, 'array2_3Dbuoy(:,nCells/2)'
+ print *, array2_3Dbuoy(:,nCells/2)
+ print *, 'array1_3Dbuoy(:,nCells/2) - array2_3Dbuoy(:,nCells/2)'
+ print *, array1_3Dbuoy(:,nCells/2) - array2_3Dbuoy(:,nCells/2)
+ endif
+
+
+ !-------------------------------------------------------------
+ ! check to see if at any point in the domain:
+ ! potentialDensity < potentialDensityTopRef(1)
+ ! potentialDensity > potentialDensityTopRef(nBuoyancyLayersP1)
+ ! either case means that buoyancy coordinate does not span the fluid domain
+ !-------------------------------------------------------------
+ call check_potentialDensityRef_range(nVertLevels, nCells, maxLevelCell, potentialDensity)
+
+ !-------------------------------------------------------------
+ ! interpolate state variable from z-space into buoyancy-space
+ !-------------------------------------------------------------
+ call linear_interp_1d_field_along_column(nVertLevels, nCells, nBuoyancyLayers, &
+ maxLevelCell, potentialDensity, zMid, &
+ potentialDensityMidRef, heightMidBuoyCoor)
+
+ call linear_interp_1d_field_along_column(nVertLevels, nCells, nBuoyancyLayers, &
+ maxLevelCell, potentialDensity, zMid, &
+ potentialDensityTopRef, heightTopBuoyCoor)
+
+ call linear_interp_1d_field_along_column(nVertLevels, nCells, nBuoyancyLayers, &
+ maxLevelCell, potentialDensity, velocityZonal, &
+ potentialDensityMidRef, uMidBuoyCoor)
+
+ call linear_interp_1d_field_along_column(nVertLevels, nCells, nBuoyancyLayers, &
+ maxLevelCell, potentialDensity, velocityMeridional, &
+ potentialDensityMidRef, vMidBuoyCoor)
+
+ call linear_interp_1d_field_along_column(nVertLevels, nCells, nBuoyancyLayers, &
+ maxLevelCell, potentialDensity, density, &
+ potentialDensityMidRef, densityMidBuoyCoor)
+
+ call linear_interp_1d_field_along_column(nVertLevels, nCells, nBuoyancyLayers, &
+ maxLevelCell, potentialDensity, density, &
+ potentialDensityTopRef, densityTopBuoyCoor)
+
+ ! Diabatic terms
+ !call linear_interp_1d_field_along_column(nVertLevels, nCells, nBuoyancyLayers, &
+ ! maxLevelCell, potentialDensity, wCellCenter, potentialDensityTopRef, wMidBuoyCoor)
+
+ !-------------------------------------------------------------
+ ! fill in data above firstLayerBuoyCoor and below lastLayerBuoyCoor
+ !-------------------------------------------------------------
+ do i = 1, nCells
+ do k = 1, firstLayerBuoyCoor(i)-1
+ heightMidBuoyCoor(k,i) = zTop(1,i)
+ heightTopBuoyCoor(k,i) = zTop(1,i)
+ uMidBuoyCoor(k,i) = velocityZonal(1,i)
+ vMidBuoyCoor(k,i) = velocityMeridional(1,i)
+ densityMidBuoyCoor(k,i) = density(1,i)
+ densityTopBuoyCoor(k,i) = density(1,i)
+ ! diabatic
+ !wMidBuoyCoor(k,i) = wCellCenter(1,i)
+ end do
+ do k = lastLayerBuoyCoor(i) + 1, nBuoyancyLayers
+ heightMidBuoyCoor(k,i) = -bottomDepth(i)
+ heightTopBuoyCoor(k,i) = -bottomDepth(i)
+ uMidBuoyCoor(k,i) = velocityZonal(maxLevelCell(i),i)
+ vMidBuoyCoor(k,i) = velocityMeridional(maxLevelCell(i),i)
+ densityMidBuoyCoor(k,i) = density(maxLevelCell(i),i)
+ densityTopBuoyCoor(k,i) = density(maxLevelCell(i),i)
+ ! diabatic
+ !wMidBuoyCoor(k,i) = wCellCenter(maxLevelCell(i),i)
+ end do
+ heightInterfaceBuoyCoor(1:nBuoyancyLayers,i) = heightTopBuoyCoor(1:nBuoyancyLayers,i)
+ heightInterfaceBuoyCoor(nBuoyancyLayers+1,i) = -bottomDepth(i)
+ end do
+
+ !-------------------------------------------------------------
+ ! compute sigma, aka "layer thickness", units of s^2
+ !-------------------------------------------------------------
+ call computeSigma(nCells, nBuoyancyLayers, &
+ heightInterfaceBuoyCoor, buoyancyInterfaceRef, sigma)
+
+ !-------------------------------------------------------------
+ ! using data interpolated to buoyancy space, compute Montgomery potential
+ !-------------------------------------------------------------
+ call computeMontgomeryPotential(nBuoyancyLayers, nCells, seaSurfacePressure, &
+ densityMidBuoyCoor, potentialDensityMidRef, heightInterfaceBuoyCoor, montgPotBuoyCoor)
+
+ !-------------------------------------------------------------
+ ! compute the normal derivative of Montgomery potential at cell edges
+ !-------------------------------------------------------------
+ call computeNormalGradientOnEdge(nBuoyancyLayers, nCells, nEdges, &
+ meshPool, montgPotBuoyCoor, montgPotNormalGradOnEdge)
+
+ !-------------------------------------------------------------
+ ! reconstruct full gradient vector at cell centers
+ !-------------------------------------------------------------
+ call mpas_reconstruct(meshPool, montgPotNormalGradOnEdge, &
+ montgPotGradX, montgPotGradY, montgPotGradZ, &
+ montgPotGradZonal, montgPotGradMerid, includeHalos=.true.)
+
+ !-------------------------------------------------------------
+ ! Increment first-order running ensemble average fields
+ !-------------------------------------------------------------
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, buoyancyMask, buoyancyMaskEA)
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, sigma, sigmaEA)
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, heightMidBuoyCoor, heightMidBuoyCoorEA)
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, montgPotBuoyCoor, montgPotBuoyCoorEA)
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, montgPotGradZonal, montgPotGradZonalEA)
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, montgPotGradMerid, montgPotGradMeridEA)
+
+ !-------------------------------------------------------------
+ ! Increment second-order running ensemble average fields
+ !-------------------------------------------------------------
+ wrk3DBuoyCoor = heightMidBuoyCoor * heightMidBuoyCoor
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, wrk3DBuoyCoor, heightMidBuoyCoorSqEA)
+
+ wrk3DBuoyCoor = heightMidBuoyCoor * montgPotGradZonal
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, wrk3DBuoyCoor, heightMGradZonalEA)
+
+ wrk3DBuoyCoor = heightMidBuoyCoor * montgPotGradMerid
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, wrk3DBuoyCoor, heightMGradMeridEA)
+
+ wrk3DBuoyCoor = uMidBuoyCoor * sigma
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, wrk3DBuoyCoor, usigmaEA)
+
+ wrk3DBuoyCoor = vMidBuoyCoor * sigma
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, wrk3DBuoyCoor, vsigmaEA)
+
+ ! Diabatic terms
+ !wrk3DBuoyCoor = wMidBuoyCoor * sigma
+ !call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, wrk3DBuoyCoor, varpisigmaEA)
+ varpisigmaEA = 0.0_RKIND
+
+ !-------------------------------------------------------------
+ ! Increment third-order running ensemble average fields
+ !-------------------------------------------------------------
+ wrk3DBuoyCoor = uMidBuoyCoor * uMidBuoyCoor * sigma
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, wrk3DBuoyCoor, uusigmaEA)
+
+ wrk3DBuoyCoor = vMidBuoyCoor * vMidBuoyCoor * sigma
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, wrk3DBuoyCoor, vvsigmaEA)
+
+ wrk3DBuoyCoor = uMidBuoyCoor * vMidBuoyCoor * sigma
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, wrk3DBuoyCoor, uvsigmaEA)
+
+ ! Diabatic terms
+ !wrk3DBuoyCoor = uMidBuoyCoor * wMidBuoyCoor * sigma
+ !call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, wrk3DBuoyCoor, uvarpisigmaEA)
+ uvarpisigmaEA = 0.0_RKIND
+
+ ! Diabatic terms
+ !wrk3DBuoyCoor = vMidBuoyCoor * wMidBuoyCoor* sigma
+ !call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, wrk3DBuoyCoor, vvarpisigmaEA)
+ vvarpisigmaEA = 0.0_RKIND
+
+ !-------------------------------------------------------------
+ ! update number of samples in ensemble average
+ !-------------------------------------------------------------
+ nSamplesEA = nSamplesEA + 1
+
+ !-------------------------------------------------------------
+ ! compute the thickness-weighted average velocity
+ ! based on current estimate of ensemble-average state
+ !-------------------------------------------------------------
+ call calculateTWA(nBuoyancyLayers, nCells, nBuoyancyLayers, sigmaEA, usigmaEA, uTWA)
+ call calculateTWA(nBuoyancyLayers, nCells, nBuoyancyLayers, sigmaEA, vsigmaEA, vTWA)
+ ! Diabatic terms
+ !call calculateTWA(nBuoyancyLayers, nCells, nBuoyancyLayers, sigmaEA, varpisigmaEA, varpiTWA)
+ varpiTWA = 0.0_RKIND
+
+ !-------------------------------------------------------------
+ ! compute the Eliassen-Palm flux tensor
+ ! based on current estimate of ensemble-average state
+ !-------------------------------------------------------------
+ call calculateEPFTfromTWA(nBuoyancyLayers, nCells, &
+ sigmaEA, heightMidBuoyCoorEA, &
+ heightMidBuoyCoorSqEA, montgPotGradZonalEA, montgPotGradMeridEA, &
+ heightMGradZonalEA, heightMGradMeridEA, uTWA, vTWA, varpiTWA, &
+ uusigmaEA, vvsigmaEA, uvsigmaEA, uvarpisigmaEA, vvarpisigmaEA, EPFT)
+
+ !-------------------------------------------------------------
+ ! Calculate eddy correlations
+ !-------------------------------------------------------------
+ call calculateCorrelationfromTWA(nBuoyancyLayers, nCells, &
+ sigmaEA, uTWA, uTWA, uuSigmaEA, uuTWACorr)
+ call calculateCorrelationfromTWA(nBuoyancyLayers, nCells, &
+ sigmaEA, vTWA, vTWA, vvSigmaEA, vvTWACorr)
+ call calculateCorrelationfromTWA(nBuoyancyLayers, nCells, &
+ sigmaEA, uTWA, vTWA, uvSigmaEA, uvTWACorr)
+ call calculateEPEfromTWA(nBuoyancyLayers, nCells, &
+ sigmaEA, heightMidBuoyCoorEA, heightMidBuoyCoorSqEA, epeTWA)
+ call calculateEddyFormDragFromTWA(nBuoyancyLayers, nCells, sigmaEA, &
+ heightMidBuoyCoorEA, montgPotGradZonalEA, heightMGradZonalEA, eddyFormDragZonal)
+ call calculateEddyFormDragFromTWA(nBuoyancyLayers, nCells, sigmaEA, &
+ heightMidBuoyCoorEA, montgPotGradMeridEA, heightMGradMeridEA, eddyFormDragMerid)
+
+ !-------------------------------------------------------------
+ ! compute the total force from the EPFT: div(EPFT)
+ !-------------------------------------------------------------
+ call calculateDivEPFT(config_AM_eliassenPalm_debug, &
+ domain % on_a_sphere, rho_sw, nBuoyancyLayers, nCells, nEdges, &
+ meshPool, buoyancyMidRef, sigmaEA, buoyancyMaskEA, EPFT, divEPFT)
+ ! decompose the vector into its components for output
+ divEPFT1 = divEPFT(1,:,:)
+ divEPFT2 = divEPFT(2,:,:)
+
+ !-------------------------------------------------------------
+ ! compute the force from horizontal shear component of the EPFT
+ !-------------------------------------------------------------
+ wrkTensor = 0.0_RKIND
+ wrkTensor(1:2,1:2,:,:) = EPFT(1:2,1:2,:,:)
+ call calculateDivEPFT(config_AM_eliassenPalm_debug, &
+ domain % on_a_sphere, rho_sw, nBuoyancyLayers, nCells, nEdges, &
+ meshPool, buoyancyMidRef, sigmaEA, buoyancyMaskEA, wrkTensor, wrkVector)
+ divEPFTshear1 = wrkVector(1,:,:)
+ divEPFTshear2 = wrkVector(2,:,:)
+
+ !-------------------------------------------------------------
+ ! compute the force from vertical form drag component of the EPFT
+ !-------------------------------------------------------------
+ wrkTensor = 0.0_RKIND
+ wrkTensor(3,1:2,:,:) = EPFT(3,1:2,:,:)
+ call calculateDivEPFT(config_AM_eliassenPalm_debug, &
+ domain % on_a_sphere, rho_sw, nBuoyancyLayers, nCells, nEdges, &
+ meshPool, buoyancyMidRef, sigmaEA, buoyancyMaskEA, wrkTensor, wrkVector)
+ divEPFTdrag1 = wrkVector(1,:,:)
+ divEPFTdrag2 = wrkVector(2,:,:)
+
+ !-------------------------------------------------------------
+ ! transform div(EPFT) into a flux of Ertel PV
+ !-------------------------------------------------------------
+ call calculateErtelPVFlux(nCells, nBuoyancyLayers, sigmaEA, divEPFT, ErtelPVFlux)
+ ErtelPVFlux1 = ErtelPVFlux(1,:,:)
+ ErtelPVFlux2 = ErtelPVFlux(2,:,:)
+
+ !-------------------------------------------------------------
+ ! compute Ertel PV tendency from Ertel PV fluxes, div(ErtelPVFlux)
+ !-------------------------------------------------------------
+ call calculateErtelPVTendencyFromPVFlux(config_AM_eliassenPalm_debug, &
+ domain % on_a_sphere, nBuoyancyLayers, nCells, nEdges, &
+ meshPool, sigmaEA, ErtelPVFlux, ErtelPVTendency)
+
+ !-------------------------------------------------------------
+ ! compute Ertel PV based on EA and TWA fields
+ !-------------------------------------------------------------
+ call computeErtelPV(nCells, nBuoyancyLayers, nEdges, meshPool, &
+ fCell, uTWA, vTWA, sigmaEA, ErtelPV)
+
+ !-------------------------------------------------------------
+ ! compute the normal derivative of EPV at cell edges
+ !-------------------------------------------------------------
+ call computeNormalGradientOnEdge(nBuoyancyLayers, nCells, nEdges, &
+ meshPool, ErtelPV, ErtelPVNormalGradOnEdge)
+
+ !-------------------------------------------------------------
+ ! reconstruct full gradient vector at cell centers
+ !-------------------------------------------------------------
+ call mpas_reconstruct(meshPool, ErtelPVNormalGradOnEdge, &
+ ErtelPVGradX, ErtelPVGradY, ErtelPVGradZ, ErtelPVGradZonal, ErtelPVGradMerid, includeHalos=.true.)
+
+ !-------------------------------------------------------------
+ ! compute the vertical derivative of uTWA
+ !-------------------------------------------------------------
+ call computeVerticalDerivative(nCells, nBuoyancyLayers, &
+ firstLayerBuoyCoor, lastLayerBuoyCoor, heightMidBuoyCoor, uTWA, duTWAdz)
+
+ !-------------------------------------------------------------
+ ! compute the vertical derivative of vTWA
+ !-------------------------------------------------------------
+ call computeVerticalDerivative(nCells, nBuoyancyLayers, &
+ firstLayerBuoyCoor, lastLayerBuoyCoor, heightMidBuoyCoor, vTWA, dvTWAdz)
+
+ !-------------------------------------------------------------
+ ! Compute the geometric decomposition in terms of angles and
+ ! eccentricities using the entries of EPFT.
+ ! (not yet implemented)
+ !-------------------------------------------------------------
+ !call eddyGeomDecompEPFT(EPFT, ...)
+
+
+
+ !-------------------------------------------------------------
+ ! TEST:
+ ! calculate potential vorticity fluxes using curl of u
+ !-------------------------------------------------------------
+ if(config_AM_eliassenPalm_debug) then
+
+ call mpas_pool_get_array(diagnosticsPool, 'relativeVorticityCell', relativeVorticityCell)
+
+ ! store relVortMidBuoyCoor in array1_3Dbuoy
+ call linear_interp_1d_field_along_column(nVertLevels, nCells, nBuoyancyLayers, &
+ maxLevelCell, potentialDensity, relativeVorticityCell, &
+ potentialDensityMidRef, array1_3Dbuoy)
+
+ do i = 1,nCells
+ do k=firstLayerBuoyCoor(i), lastLayerBuoyCoor(i)
+ PVMidBuoyCoor(k,i) = (fCell(i) + array1_3Dbuoy(k,i) ) / sigma(k,i)
+ end do
+ end do
+
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, &
+ uMidBuoyCoor, uMidBuoyCoorEA)
+
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, &
+ vMidBuoyCoor, vMidBuoyCoorEA)
+
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, &
+ PVMidBuoyCoor, PVMidBuoyCoorEA)
+
+ wrk3DBuoyCoor = uMidBuoyCoor * PVMidBuoyCoor
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, &
+ wrk3DBuoyCoor, uPVMidBuoyCoorEA)
+
+ wrk3DBuoyCoor = vMidBuoyCoor * PVMidBuoyCoor
+ call updateEnsembleAverage(nBuoyancyLayers, nCells, nSamplesEA, &
+ wrk3DBuoyCoor, vPVMidBuoyCoorEA)
+
+ PVFluxTest(1,:,:) = uPVMidBuoyCoorEA - uMidBuoyCoorEA * PVMidBuoyCoorEA
+ PVFluxTest(2,:,:) = vPVMidBuoyCoorEA - vMidBuoyCoorEA * PVMidBuoyCoorEA
+
+ do i = 1,nCells
+ do k = firstLayerBuoyCoor(i), lastLayerBuoyCoor(i)
+ RMSPVFlux1Local = RMSPVFlux1local + &
+ ( ErtelPVFlux(1,k,i) - PVFLuxTest(1,k,i) )**2
+ RMSPVFlux2Local = RMSPVFlux2local + &
+ ( ErtelPVFlux(2,k,i) - PVFLuxTest(2,k,i) )**2
+ end do
+ end do
+
+ end if
+
+
+ !-------------------------------------------------------------
+ ! deallocate scratch space and test space variables
+ !-------------------------------------------------------------
+ call mpas_deallocate_scratch_field(firstLayerBuoyCoorField, .true.)
+ call mpas_deallocate_scratch_field(lastLayerBuoyCoorField, .true.)
+ call mpas_deallocate_scratch_field(heightMidBuoyCoorField, .true.)
+ call mpas_deallocate_scratch_field(heightTopBuoyCoorField, .true.)
+ call mpas_deallocate_scratch_field(heightInterfaceBuoyCoorField, .true.)
+ call mpas_deallocate_scratch_field(sigmaField, .true.)
+ call mpas_deallocate_scratch_field(montgPotBuoyCoorField, .true.)
+ call mpas_deallocate_scratch_field(montgPotNormalGradOnEdgeField, .true.)
+ call mpas_deallocate_scratch_field(uMidBuoyCoorField, .true.)
+ call mpas_deallocate_scratch_field(vMidBuoyCoorField, .true.)
+ call mpas_deallocate_scratch_field(densityMidBuoyCoorField, .true.)
+ call mpas_deallocate_scratch_field(densityTopBuoyCoorField, .true.)
+ call mpas_deallocate_scratch_field(buoyancyMaskField, .true.)
+ call mpas_deallocate_scratch_field(montgPotGradXField, .true.)
+ call mpas_deallocate_scratch_field(montgPotGradYField, .true.)
+ call mpas_deallocate_scratch_field(montgPotGradZField, .true.)
+ call mpas_deallocate_scratch_field(montgPotGradZonalField, .true.)
+ call mpas_deallocate_scratch_field(montgPotGradMeridField, .true.)
+ call mpas_deallocate_scratch_field(wrk3DnVertLevelsP1Field, .true.)
+ call mpas_deallocate_scratch_field(wrk3DnVertLevelsField, .true.)
+ call mpas_deallocate_scratch_field(wrk3DBuoyCoorField, .true.)
+ call mpas_deallocate_scratch_field(ErtelPVNormalGradOnEdgeField, .true.)
+ call mpas_deallocate_scratch_field(ErtelPVGradXField, .true.)
+ call mpas_deallocate_scratch_field(ErtelPVGradYField, .true.)
+ call mpas_deallocate_scratch_field(ErtelPVGradZField, .true.)
+ call mpas_deallocate_scratch_field(wrkVectorField, .true.)
+ call mpas_deallocate_scratch_field(wrkTensorField, .true.)
+
+ call mpas_deallocate_scratch_field(array1_3DField, .true.)
+ call mpas_deallocate_scratch_field(array2_3DField, .true.)
+ call mpas_deallocate_scratch_field(array3_3DField, .true.)
+ call mpas_deallocate_scratch_field(array1_3DbuoyField, .true.)
+ call mpas_deallocate_scratch_field(array2_3DbuoyField, .true.)
+ call mpas_deallocate_scratch_field(PVMidBuoyCoorField, .true.)
+ call mpas_deallocate_scratch_field(PVMidBuoyCoorEAField, .true.)
+ call mpas_deallocate_scratch_field(uMidBuoyCoorEAField, .true.)
+ call mpas_deallocate_scratch_field(vMidBuoyCoorEAField, .true.)
+ call mpas_deallocate_scratch_field(uPVMidBuoyCoorEAField, .true.)
+ call mpas_deallocate_scratch_field(vPVMidBuoyCoorEAField, .true.)
+ call mpas_deallocate_scratch_field(PVFluxTestField, .true.)
+
+ !-------------------------------------------------------------
+ ! update test variables
+ !-------------------------------------------------------------
+ nCellsCum = nCellsCum + nCells
+
+ !-------------------------------------------------------------
+ ! move to the next block
+ !-------------------------------------------------------------
+ block => block % next
+
+ end do
+
+ !-------------------------------------------------------------
+ ! TESTS: tallying up tests across processors.
+ !-------------------------------------------------------------
+ if(config_AM_eliassenPalm_debug) then
+ RMSglobal1 = 1.0e+36_RKIND
+ call mpas_dmpar_sum_int(dminfo, nCellsCum, nCellsGlobal)
+ call mpas_dmpar_sum_real(dminfo, RMSlocal1, RMSglobal1)
+ call mpas_dmpar_sum_real(dminfo, RMSlocal2, RMSglobal2)
+
+ if (dminfo % my_proc_id == IO_NODE) then
+ print *, ' '
+ print *, 'RKIND=', RKIND
+ print *, 'rms relative error interp test1:',sqrt(RMSglobal1/nCellsGlobal)
+ print *, 'rms relative error interp test2:',sqrt(RMSglobal2/nCellsGlobal)
+
+ print *, ' '
+ endif
+
+ call mpas_dmpar_sum_real(dminfo, sum(abs(ErtelPVFlux(1,:,:))), RMSglobal1)
+ call mpas_dmpar_max_real(dminfo, maxval(abs(ErtelPVFlux(1,:,:))), RMSglobal2)
+ if (dminfo % my_proc_id == IO_NODE) then
+ print *, 'Checking ErtelPVFlux'
+ print *, 'Global sum(abs(ErtelPVFlux(1,:,:))) = ', RMSglobal1
+ print *, 'Global max(abs(ErtelPVFlux(1,:,:))) = ', RMSglobal2
+ endif
+
+ call mpas_dmpar_sum_real(dminfo, sum(abs(ErtelPVFlux(2,:,:))), RMSglobal1)
+ call mpas_dmpar_max_real(dminfo, maxval(abs(ErtelPVFlux(2,:,:))), RMSglobal2)
+ if (dminfo % my_proc_id == IO_NODE) then
+ print *, 'Global sum(abs(ErtelPVFlux(2,:,:))) = ', RMSglobal1
+ print *, 'Global max(abs(ErtelPVFlux(2,:,:))) = ', RMSglobal2
+ endif
+
+ call mpas_dmpar_sum_real(dminfo, sum(abs(ErtelPVFlux(3,:,:))), RMSglobal1)
+ call mpas_dmpar_max_real(dminfo, maxval(abs(ErtelPVFlux(3,:,:))), RMSglobal2)
+ if (dminfo % my_proc_id == IO_NODE) then
+ print *, 'Global sum(abs(ErtelPVFlux(3,:,:))) = ', RMSglobal1
+ print *, 'Global max(abs(ErtelPVFlux(3,:,:))) = ', RMSglobal2
+ endif
+
+ call mpas_dmpar_sum_real(dminfo, RMSPVFlux1Local, RMSPVFlux1global)
+ call mpas_dmpar_sum_real(dminfo, RMSPVFlux2Local, RMSPVFlux2global)
+ if (dminfo % my_proc_id == IO_NODE) then
+ print *, 'rms relative error test PVFlux1:',sqrt(RMSPVFlux1global/nCellsGlobal)
+ print *, 'rms relative error test PVFlux2:',sqrt(RMSPVFLux2global/nCellsGlobal)
+
+ print *, ' '
+ endif
+
+ endif
+
+ if(config_AM_eliassenPalm_debug) then
+ write(stderrUnit, *) ' '
+ write(stderrUnit, *) 'exiting ocn_compute_epft'
+ write(stderrUnit, *) ' '
+ end if
+
+ end subroutine ocn_compute_eliassen_palm!}}}
+
+!***********************************************************************
+!
+! routine ocn_restart_eliassen_palm
+!
+!> \brief Save restart for MPAS-Ocean analysis member
+!> \author FILL_IN_AUTHOR
+!> \date FILL_IN_DATE
+!> \details
+!> This routine conducts computation required to save a restart state
+!> for the MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_restart_eliassen_palm(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ end subroutine ocn_restart_eliassen_palm!}}}
+
+!***********************************************************************
+!
+! routine ocn_finalize_eliassen_palm
+!
+!> \brief Finalize MPAS-Ocean analysis member
+!> \author Juan A. Saenz
+!> \date May 2015
+!> \details
+!> This routine conducts all finalizations required for this
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_finalize_eliassen_palm(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ end subroutine ocn_finalize_eliassen_palm!}}}
+
+
+
+!***********************************************************************
+! Local routines start here
+!***********************************************************************
+
+
+!***********************************************************************
+!
+! subroutine get_masks_in_buoyancy_coordinates
+!
+!> \brief Get masks in buoyancy coordinates
+!> \author Juan A. Saenz, Todd Ringler
+!> \date May 2015
+!> \details
+!> firstLayerBuoyCoor(iCell): the index of the smallest reference density that
+!> is >= the smallest actual density in a column.
+!> lastLayerBuoyCoor(iCell): the index of the largest reference density that is <= the
+!> largest actual density in a column.
+!> Set masks in buoyancy coordinates:
+!> mask = 1: cell is a valid ocean cell
+!> mask = 0: cell is not a valid ocean cell
+!> Required: potentialDensityMidRef monotonically increases with index value
+!
+!-----------------------------------------------------------------------
+ subroutine get_masks_in_buoyancy_coordinates(nVertLevels, nCells, nBuoyancyLayers, &
+ maxLevelCell, potentialDensity, potentialDensityMidRef, &
+ firstLayerBuoyCoor, lastLayerBuoyCoor, buoyancyMask)!{{{
+
+ !-----------------------------------------------------------------
+ ! intent(in)
+ !-----------------------------------------------------------------
+ integer, intent(in) :: nVertLevels, nCells, nBuoyancyLayers
+ integer, dimension(nCells), intent(in) :: maxLevelCell
+ real (kind=RKIND), dimension(nVertLevels, nCells), intent(in) :: potentialDensity
+ real (kind=RKIND), dimension(nBuoyancyLayers), intent(in) :: potentialDensityMidRef
+
+ !-----------------------------------------------------------------
+ ! intent(out)
+ !-----------------------------------------------------------------
+ integer, dimension(nCells), intent(out) :: firstLayerBuoyCoor
+ integer, dimension(nCells), intent(out) :: lastLayerBuoyCoor
+ real (kind=RKIND), dimension(nBuoyancyLayers, nCells), intent(out) :: buoyancyMask
+
+ !-----------------------------------------------------------------
+ ! Local variables
+ !-----------------------------------------------------------------
+ integer :: iCell, maxLevel, kB, kBBottom, kBTop
+
+ !-----------------------------------------------------------------
+ ! initialize fields assuming no density layers exist
+ !-----------------------------------------------------------------
+ firstLayerBuoyCoor = nBuoyancyLayers
+ lastLayerBuoyCoor = 1
+ buoyancyMask = 0.0_RKIND
+
+ !-----------------------------------------------------------------
+ ! loop over all cells
+ ! when searching from the top down
+ ! find first target density greater than density in top model layer
+ ! when searching from the bottom up
+ ! find first target density less than density in bottom model layer
+ !-----------------------------------------------------------------
+ do iCell = 1, nCells
+
+ ! find the bottom model layer for this cell
+ maxLevel = maxLevelCell(iCell)
+
+ ! search top down
+ do kB = 1, nBuoyancyLayers
+ if (potentialDensityMidRef(kB) >= potentialDensity(1,iCell) ) then
+ firstLayerBuoyCoor(iCell) = kB
+ exit
+ endif
+ enddo
+
+ ! search bottom up
+ do kB = nBuoyancyLayers, 1, -1
+ if (potentialDensityMidRef(kB) <= potentialDensity(maxLevel,iCell) ) then
+ lastLayerBuoyCoor(iCell) = kB
+ exit
+ endif
+ enddo
+
+ ! set mask to 1 inside the range
+ do kB = firstLayerBuoyCoor(iCell), lastLayerBuoyCoor(iCell)
+ buoyancyMask(kB,iCell) = 1.0_RKIND
+ enddo
+
+ enddo
+
+ end subroutine get_masks_in_buoyancy_coordinates!}}}
+
+
+!***********************************************************************
+!
+! subroutine check_potentialDensityRef_range
+!
+!> \brief Check if the range of values in potentialDensityTopRef contains current state
+!> \author Juan A. Saenz, Todd Ringler
+!> \date May 2015
+!> \details
+!> Check if the range of values in potentialDensityTopRef contains all values in
+!> potentialDensity of the current state.
+!> If not, print a warning.
+!
+!-----------------------------------------------------------------------
+ subroutine check_potentialDensityRef_range(nVertLevels, nCells, maxLevelCell, &
+ potentialDensity)!{{{
+ !-----------------------------------------------------------------
+ ! intent(in)
+ !-----------------------------------------------------------------
+ integer, intent(in) :: nVertLevels, nCells
+ integer, dimension(nCells), intent(in) :: maxLevelCell
+ real (kind=RKIND), dimension(nVertLevels, nCells), intent(in) :: potentialDensity
+
+ !-----------------------------------------------------------------
+ ! Local variables
+ !-----------------------------------------------------------------
+ integer :: k, iCell, iCellMinBound, iCellMaxBound
+ logical :: printWarning
+
+ real (kind=RKIND), pointer :: config_AM_eliassenPalm_rhomin_buoycoor, &
+ config_AM_eliassenPalm_rhomax_buoycoor
+
+ call mpas_pool_get_config(ocnConfigs, 'config_AM_eliassenPalm_rhomin_buoycoor', &
+ config_AM_eliassenPalm_rhomin_buoycoor)
+ call mpas_pool_get_config(ocnConfigs, 'config_AM_eliassenPalm_rhomax_buoycoor', &
+ config_AM_eliassenPalm_rhomax_buoycoor)
+
+ printWarning = .false.
+ iCellMinBound = -1
+ iCellMaxBound = -1
+
+ do iCell = 1, nCells
+ if (potentialDensity(1,iCell) < config_AM_eliassenPalm_rhomin_buoycoor) then
+ printWarning = .true.
+ iCellMinBound = iCell
+ exit
+ end if
+ if (potentialDensity(maxLevelCell(iCell),iCell) > config_AM_eliassenPalm_rhomax_buoycoor) then
+ printWarning = .true.
+ iCellMaxBound = iCell
+ exit
+ end if
+ enddo
+
+ if (printWarning) then
+ write(stderrUnit,*)
+ write(stderrUnit,*) ' *** WARNING: in eliassen_palm analysis member, subroutine check_potentialDensityRef_range.'
+ write(stderrUnit,*) ' One or more columns in the ocean domain have densities that are not'
+ write(stderrUnit,*) ' contained in the defined buoyancy space of the EPFT module'
+ if (iCellMinBound.gt.0) write(stderrUnit,*) ' fluid is lighter than min buoyancy at cell: ',iCellMinBound
+ if (iCellMaxBound.gt.0) write(stderrUnit,*) ' fluid is lighter than max buoyancy at cell: ',iCellMaxBound
+ write(stderrUnit,*)
+ end if
+
+ end subroutine check_potentialDensityRef_range!}}}
+
+
+!***********************************************************************
+!
+! subroutine linear_interp_1d_field_along_column
+!
+!> \brief One-dimensional interpolation in buoyancy coordinates
+!> \author Juan A. Saenz, Todd Ringler
+!> \date 17 December 2013
+!> \details
+!> Interpolate a field yFieldIn residing on xFieldIn onto xColumnOut and store
+!> and return in yFieldOut.
+!> Interpolation is done using one-dimensional interpolation along xColumnOut.
+!> Required: xFieldIn monotonically increases with index value
+!
+!-----------------------------------------------------------------------
+
+ subroutine linear_interp_1d_field_along_column(nVertLevels, nCells, nBuoyancyLayers, &
+ maxLevelCell, xFieldIn, yFieldIn, xColumnOut, yFieldOut)!{{{
+
+ !-----------------------------------------------------------------
+ ! intent(in)
+ !-----------------------------------------------------------------
+ integer, intent(in) :: nVertLevels, nCells, nBuoyancyLayers
+ integer, dimension(nCells), intent(in) :: maxLevelCell
+ real (kind=RKIND), dimension(nVertLevels, nCells), intent(in) :: xFieldIn
+ real (kind=RKIND), dimension(nVertLevels, nCells), intent(in) :: yFieldIn
+ real (kind=RKIND), dimension(nBuoyancyLayers), intent(in) :: xColumnOut
+
+ !-----------------------------------------------------------------
+ ! intent(out)
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(nBuoyancyLayers, nCells), intent(out) :: yFieldOut
+
+ !-----------------------------------------------------------------
+ ! Local variables
+ !-----------------------------------------------------------------
+ integer :: iCell, maxLevel, kB, kBBottom, kBTop, kDataAbove, kDataBelow, kData
+ real (kind=RKIND) :: dx, dy
+ real (kind=RKIND), dimension(nVertLevels, nCells) :: xSrc ! source data
+ real (kind=RKIND), dimension(nBuoyancyLayers) :: xDst ! destination data
+
+ ! jas issue: the code below works for monotonically decreasing arrays.
+ ! however above it expects arguments that are monotonically increasing arrays.
+ xSrc = -xFieldIn
+ xDst = -xColumnOut
+
+ !-----------------------------------------------------------------
+ ! test for monoticity of xSrc
+ !-----------------------------------------------------------------
+ ! jas issue : to do
+
+ !-----------------------------------------------------------------
+ ! initialize intent(out)
+ !-----------------------------------------------------------------
+ yFieldOut = 0.0_RKIND
+
+ !-----------------------------------------------------------------
+ ! loop over all columns
+ !-----------------------------------------------------------------
+ do iCell = 1, nCells
+
+ ! find the index of the bottom level of a column
+ maxLevel = maxLevelCell(iCell)
+
+ ! Monotonically decreasing xSrc required
+ ! Find index of first element in xDst that is inside xSrc(:,iCell)
+ kBTop = 1
+ do kB = 1, nBuoyancyLayers
+ ! the following line ensures that
+ ! if all xDst > xSrc(1,iCell) then kBTop = nBuoyancyLayers
+ kBTop = kB
+ if (xDst(kB) <= xSrc(1,iCell) ) then
+ exit
+ endif
+ enddo
+
+ !find last target buoyancy level inside column
+ kBBottom = nBuoyancyLayers
+ do kB = nBuoyancyLayers, 1, -1
+ ! the following line ensures that
+ ! if all xDst < xSrc(1,iCell) then kBBottom = 1
+ kBBottom = kB
+ if (xDst(kB) >= xSrc(maxLevel,iCell) ) then
+ exit
+ endif
+ enddo
+
+ ! For the target x levels outside the x range in a column:
+ ! set data from 1:kBTop-1 to surface values
+ do kB = 1, kBTop-1
+ yFieldOut(kB,iCell) = yFieldIn(1,iCell)
+ enddo
+ !set data from kBBottom+1:nBuoyancyLayers to bottom values
+ do kB = kBBottom+1, nBuoyancyLayers
+ yFieldOut(kB,iCell) = yFieldIn(maxLevel,iCell)
+ enddo
+
+ ! The interpolation:
+ ! for the target buoyancy levels within the buoyancy range in a column:
+ kDataAbove = 1
+ kDataBelow = kDataAbove + 1
+ do kB = kBTop, kBBottom
+ ! for each xDst(kB) value, find the corresponding upper and lower
+ ! xSrc value in the field data, then interpolate y between those values.
+ if (xDst(kB) < xSrc(kDataBelow,iCell)) then
+ do kData = kDataBelow, maxLevel
+ if (xDst(kB) > xSrc(kData,iCell) ) then
+ kDataBelow=kData
+ kDataAbove=kDataBelow-1
+ exit
+ endif
+ enddo
+ endif
+
+ dx = xSrc(kDataBelow,iCell) - xSrc(kDataAbove,iCell)
+ dy = yFieldIn(kDataBelow,iCell) - yFieldIn(kDataAbove,iCell)
+ yFieldOut(kB,iCell) = yFieldIn(kDataAbove,iCell) + &
+ (xDst(kB)-xSrc(kDataAbove,iCell)) * dy/dx
+ enddo
+
+ enddo
+
+ end subroutine linear_interp_1d_field_along_column!}}}
+
+
+!***********************************************************************
+!
+! subroutine computeSigma
+!
+!> \brief Calculate the inverse of the derivative of buoy wrt z
+!> \author Juan A. Saenz, Todd Ringler
+!> \date May 2015
+!> \details
+!> This subroutine calculates the inverse of the derivative of buoy wrt z.
+!
+!-----------------------------------------------------------------------
+
+ subroutine computeSigma(nCells, nLayers, &
+ heightInterface, buoyInterface, sigma)!{{{
+ !-----------------------------------------------------------------
+ ! intent(in)
+ !-----------------------------------------------------------------
+ integer, intent(in) :: nCells, nLayers
+ real (kind=RKIND), dimension(:,:), intent(in) :: heightInterface
+ real (kind=RKIND), dimension(:), intent(in) :: buoyInterface
+
+ !-----------------------------------------------------------------
+ ! intent(out)
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(:,:), intent(out) :: sigma
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ integer :: iCell, k
+
+ !-----------------------------------------------------------------
+ ! initialize sigma assuming zero thickness layers everywhere
+ !-----------------------------------------------------------------
+ sigma = 0.0_RKIND
+
+ !-----------------------------------------------------------------
+ ! loop over all column, sigam = delta z / delta b
+ ! note: positive z points "up", i.e. from k+1 to k
+ ! note: positive b points "up", i.e. from k+1 to k
+ !-----------------------------------------------------------------
+ do iCell = 1, nCells
+ do k = 1,nLayers
+ sigma(k,iCell) = (heightInterface(k+1,iCell) - heightInterface(k,iCell)) / &
+ (buoyInterface(k+1) - buoyInterface(k))
+ enddo
+ enddo
+
+ end subroutine computeSigma!}}}
+
+
+
+!***********************************************************************
+!
+! subroutine computeMontgomeryPotential
+!
+!> \brief Compute the Montgomery potential
+!> \author Juan A. Saenz, Todd Ringler
+!> \date May 20015
+!> \details
+!> This subroutine computes the Montgomery potential using eqn 2.10 in
+!> R.L. Higdon and R.A. Szoeke (1997), J. Comp. Phys. 135, 30–53, Article No. CP975733
+!
+!> Montgomery Potential (MP) in layer k is MP(k-1) + pInterface(k)*deltaAlpha
+!> where deltaAlpha is (1/potDens(k) - 1/potDens(k-1))
+!> and pInterface(k) is the pressure at interface k, i.e. at top of layer k.
+!>
+!> Montgomery potential of a layer is constant across layer
+!-----------------------------------------------------------------------
+
+ subroutine computeMontgomeryPotential(nLayers, nCells, pSurface, &
+ density, potDens, heightInterface, MontgomeryPotential)!{{{
+
+ !-----------------------------------------------------------------
+ ! intent(in)
+ !-----------------------------------------------------------------
+ integer, intent(in) :: nLayers, nCells
+ real (kind=RKIND), dimension(nCells), intent(in) :: pSurface
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: density
+ real (kind=RKIND), dimension(nLayers), intent(in) :: potDens
+ real (kind=RKIND), dimension(nLayers+1, nCells), intent(in) :: heightInterface
+
+ !-----------------------------------------------------------------
+ ! intent(out)
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(nLayers, nCells), intent(out) :: MontgomeryPotential
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ integer :: iCell, k
+ real (kind=RKIND) :: pInterfacek ! pressure at interface k, i.e. at top of layer k
+
+ !-----------------------------------------------------------------
+ ! initialize intent(out)
+ !-----------------------------------------------------------------
+ MontgomeryPotential = 0.0_RKIND
+
+ !-----------------------------------------------------------------
+ ! loop over all columns
+ !-----------------------------------------------------------------
+ do iCell = 1, nCells
+
+ !-----------------------------------------------------------------
+ ! compute Montgomery potential in top buoyancy layer
+ ! at present, assume atmosphere surface pressure is zero (or a constant)
+ !-----------------------------------------------------------------
+ pInterfacek = 0.0_RKIND
+ k = 1
+ MontgomeryPotential(k,iCell) = pInterfacek/potDens(k) + gravity*heightInterface(k,iCell)
+
+ !-----------------------------------------------------------------
+ ! compute Montgomery potential by accumulating jump across each layer interace
+ ! Jump == pressure at interface * (alpha (below interface) - alpha (above interface))
+ !-----------------------------------------------------------------
+ do k = 2, nLayers
+ pInterfacek = pInterfacek + &
+ gravity * ( heightInterface(k-1,iCell)-heightInterface(k,iCell) ) * density(k-1,iCell)
+ MontgomeryPotential(k,iCell) = MontgomeryPotential(k-1,iCell) + &
+ pInterfacek * ( 1/potDens(k) - 1/potDens(k-1) )
+ enddo
+
+ enddo
+
+ end subroutine computeMontgomeryPotential!}}}
+
+
+
+!***********************************************************************
+!
+! subroutine computeNormalGradientOnEdge
+!
+!> \brief Compute the gradient of a quantity that exists on cell centers
+!> \author Juan A. Saenz, Todd Ringler
+!> \date May 2015
+!> \details
+!> This subroutine computes the normal derivative of a scalar
+!> quantity that exists on cell centers. Routine assumes that
+!> data is valid throughout the entire column, as is the case
+!> when working in buoyancy coordinates
+!
+!-----------------------------------------------------------------------
+
+ subroutine computeNormalGradientOnEdge(nBLayers, nCells, nEdges, &
+ meshPool, field, normalGradOnEdge)!{{{
+
+ !-----------------------------------------------------------------
+ ! intent(in)
+ !-----------------------------------------------------------------
+ integer, intent(in) :: nBLayers, nCells, nEdges
+ type (mpas_pool_type), intent(in) :: meshPool !< Input: mesh information
+ real (kind=RKIND), dimension(:,:), intent(in) :: field
+
+ !-----------------------------------------------------------------
+ ! intent(out)
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(:,:), intent(out) :: normalGradOnEdge
+
+ !-----------------------------------------------------------------
+ !local variables
+ !-----------------------------------------------------------------
+ integer :: iEdge, k, cell1, cell2, kMin, kMax
+ integer, pointer :: nBuoyancyLayers
+ integer, dimension(:,:), pointer :: cellsOnEdge
+ integer, dimension(:,:), pointer :: boundaryEdge
+ real (kind=RKIND), dimension(:), pointer :: dcEdge
+ real (kind=RKIND) :: invLength
+
+ !-----------------------------------------------------------------
+ ! assign pointers
+ !-----------------------------------------------------------------
+ call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
+ call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
+ call mpas_pool_get_array(meshPool, 'boundaryEdge', boundaryEdge)
+
+ call mpas_pool_get_dimension(meshPool, 'nBuoyancyLayers', nBuoyancyLayers)
+
+ !-----------------------------------------------------------------
+ ! initialize intent(out)
+ !-----------------------------------------------------------------
+ normalGradOnEdge = 0.0_RKIND
+
+ !-----------------------------------------------------------------
+ ! loop over edges, compute derivative as (cell2 - cell1) / dc
+ !-----------------------------------------------------------------
+ do iEdge = 1, nEdges
+ ! do not compute the normal derivative at land/sea interface
+ if (boundaryEdge(1,iEdge) == 1) then
+ normalGradOnEdge(:,iEdge) = 0.0_RKIND
+ else
+ cell1 = cellsOnEdge(1, iEdge)
+ cell2 = cellsOnEdge(2, iEdge)
+ invLength = 1.0_RKIND / dcEdge(iEdge)
+ do k = 1, nBuoyancyLayers
+ normalGradOnEdge(k,iEdge) = ( field(k,cell2) - field(k,cell1) )*invLength
+ enddo
+ end if
+ enddo
+
+ end subroutine computeNormalGradientOnEdge!}}}
+
+
+
+!***********************************************************************
+!
+! subroutine updateEnsembleAverage
+!
+!> \brief Update ensemble average
+!> \author Juan A. Saenz, Todd Ringler
+!> \date May 2015
+!> \details
+!> This subroutine updates the ensemble average
+!
+!-----------------------------------------------------------------------
+
+ subroutine updateEnsembleAverage(nLayers, nCells, nSamples, A, Abar)!{{{
+
+ !-----------------------------------------------------------------
+ ! intent(in)
+ !-----------------------------------------------------------------
+ integer, intent(in) :: nLayers, nCells, nSamples
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: A
+
+ !-----------------------------------------------------------------
+ ! intent(inout)
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(nLayers, nCells), intent(inout) :: Abar
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ integer :: iCell, k
+
+ !-----------------------------------------------------------------
+ ! Abar is the current estimate of the ensemble average
+ ! on input, Abar was built using nSamples of A
+ ! To update Abar, we multiple Abar times nSamples, add in the
+ ! current value (A), then normalize by (nSamples + 1)
+ !-----------------------------------------------------------------
+ do iCell = 1, nCells
+ do k = 1, nLayers
+ Abar(k,iCell) = (nSamples * Abar(k,iCell) + A(k,iCell)) / (nSamples + 1.0_RKIND)
+ enddo
+ enddo
+
+ end subroutine updateEnsembleAverage!}}}
+
+
+!***********************************************************************
+!
+! subroutine calculateTWA
+!
+!> \brief Calculate the thickness weighted average
+!> \author Juan A. Saenz, Todd Ringler
+!> \date May 2015
+!> \details
+!> This subroutine calculates the thickness weighted average
+!
+!-----------------------------------------------------------------------
+ subroutine calculateTWA(nLayers, nCells, nBuoyancyLayers, sigmaEA, &
+ varSigmaEA, varTWA)!{{{
+
+ !-----------------------------------------------------------------
+ ! intent(in)
+ !-----------------------------------------------------------------
+ integer, intent(in) :: nLayers, nCells, nBuoyancyLayers
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: sigmaEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: varSigmaEA
+
+ !-----------------------------------------------------------------
+ ! intent(inout)
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(nLayers, nCells), intent(out) :: varTWA
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ integer :: iCell, k
+
+ !-----------------------------------------------------------------
+ ! initialize intent(out)
+ !-----------------------------------------------------------------
+ varTWA = 0.0_RKIND
+
+ do iCell = 1, nCells
+ do k = 1,nBuoyancyLayers
+ varTWA(k,iCell) = varSigmaEA(k,iCell) / max(epsilonEPFT,sigmaEA(k,iCell))
+ enddo
+ enddo
+
+ end subroutine calculateTWA!}}}
+
+
+!***********************************************************************
+!
+! subroutine calculateEPFTfromTWA
+!
+!> \brief Calculate the Eliassen-Palm flux tensor from TWAs
+!> \author Juan A. Saenz
+!> \date January 2014
+!> \details
+!> This subroutine calculates the Eliassen and Palm flux tensor from thickness
+!> weighted averages.
+!> EPTF_pq(x,y,z) is represented as EPFT(p,q,k,i)
+!-----------------------------------------------------------------------
+
+ subroutine calculateEPFTfromTWA(nLayers, nCells, &
+ sigmaEA, heightEA, heightSqEA, MxEA, MyEA, HMxEA, HMyEA, uTWA, vTWA, varpiTWA, &
+ uuSigmaEA, vvSigmaEA, uvSigmaEA, uvarpisigmaEA, vvarpisigmaEA, Etensor)!{{{
+ implicit none
+ integer, intent(in) :: nLayers, nCells
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: sigmaEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: heightEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: heightSqEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: MxEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: MyEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: HMxEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: HMyEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: uTWA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: vTWA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: varpiTWA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: uuSigmaEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: vvSigmaEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: uvSigmaEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: uvarpisigmaEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: vvarpisigmaEA
+ real (kind=RKIND), dimension(3, 3, nLayers, nCells), intent(out) :: Etensor
+
+ ! local variables
+ integer :: iCell, kLayer
+ real (kind=RKIND) :: sigma
+ real (kind=RKIND) :: uppupp, vppvpp, uppvpp, uppwpp, vppwpp
+ real (kind=RKIND) :: HpHp, HpMxp, HpMyp
+ real (kind=RKIND) :: dummy1, dummy2, dummy3
+
+ Etensor = 0.0_RKIND
+
+ do iCell = 1, nCells
+ do kLayer = 1,nLayers
+
+ sigma = max(sigmaEA(kLayer,iCell), epsilonEPFT)
+
+ uppupp = uuSigmaEA(kLayer,iCell) / sigma - uTWA(kLayer,iCell)*uTWA(kLayer,iCell)
+ vppvpp = vvSigmaEA(kLayer,iCell) / sigma - vTWA(kLayer,iCell)*vTWA(kLayer,iCell)
+ uppvpp = uvSigmaEA(kLayer,iCell) / sigma - uTWA(kLayer,iCell)*vTWA(kLayer,iCell)
+ uppwpp = uvarpisigmaEA(kLayer,iCell) / sigma - uTWA(kLayer,iCell)*varpiTWA(kLayer,iCell)
+ vppwpp = vvarpisigmaEA(kLayer,iCell) / sigma - vTWA(kLayer,iCell)*varpiTWA(kLayer,iCell)
+
+ HpHp = heightSqEA(kLayer,iCell) - heightEA(kLayer,iCell)*heightEA(kLayer,iCell)
+ HpMxp = HMxEA(kLayer,iCell) - heightEA(kLayer,iCell) * MxEA(kLayer,iCell)
+ HpMyp = HMyEA(kLayer,iCell) - heightEA(kLayer,iCell) * MyEA(kLayer,iCell)
+
+ !EPTF_pq(x,y,z) is represented as EPFT(p,q,kLayer,iCell)
+ !column 1: Eu
+ Etensor(1,1,kLayer,iCell) = uppupp + 0.5_RKIND * HpHp / sigma
+ Etensor(2,1,kLayer,iCell) = uppvpp
+ Etensor(3,1,kLayer,iCell) = uppwpp + HpMxp / sigma
+
+ !column 2: Ev
+ Etensor(1,2,kLayer,iCell) = uppvpp
+ Etensor(2,2,kLayer,iCell) = vppvpp + 0.5_RKIND * HpHp / sigma
+ Etensor(3,2,kLayer,iCell) = vppwpp + HpMyp / sigma
+
+ !column 3: Ew
+ Etensor(1,3,kLayer,iCell) = 0.0_RKIND
+ Etensor(2,3,kLayer,iCell) = 0.0_RKIND
+ Etensor(3,3,kLayer,iCell) = 0.0_RKIND
+
+ enddo
+ enddo
+
+ end subroutine calculateEPFTfromTWA!}}}
+
+
+!***********************************************************************
+!
+! subroutine calculateCorrelationfromTWA
+!
+!> \brief Calculate the eddy correlation from TWAs
+!> \author Juan A. Saenz
+!> \date July 2015
+!> \details
+!> This subroutine calculates the eddy kinetic energy from thickness
+!> weighted averages.
+!-----------------------------------------------------------------------
+
+ subroutine calculateCorrelationfromTWA(nLayers, nCells, &
+ sigmaEA, uTWA, vTWA, uvSigmaEA, uvCorr)!{{{
+ implicit none
+ integer, intent(in) :: nLayers, nCells
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: sigmaEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: uTWA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: vTWA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: uvSigmaEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(out) :: uvCorr
+
+ ! local variables
+ integer :: iCell, kLayer
+ real (kind=RKIND) :: sigma
+ real (kind=RKIND) :: uppupp, vppvpp
+
+ uvCorr = 0.0_RKIND ! jas issue: assign a mask value instead
+
+ do iCell = 1, nCells
+ do kLayer = 1,nLayers
+ sigma = max(sigmaEA(kLayer,iCell), epsilonEPFT)
+ uvCorr(kLayer, iCell) = uvSigmaEA(kLayer,iCell) / sigma - uTWA(kLayer,iCell)*vTWA(kLayer,iCell)
+ enddo
+ enddo
+
+ end subroutine calculateCorrelationfromTWA!}}}
+
+
+!***********************************************************************
+!
+! subroutine calculateEPEfromTWA
+!
+!> \brief Calculate the eddy potential energy from TWAs
+!> \author Juan A. Saenz
+!> \date July 2015
+!> \details
+!> This subroutine calculates the eddy potential energy from thickness
+!> weighted averages.
+!-----------------------------------------------------------------------
+
+ subroutine calculateEPEfromTWA(nLayers, nCells, &
+ sigmaEA, heightEA, heightSqEA, epe)!{{{
+ implicit none
+ integer, intent(in) :: nLayers, nCells
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: sigmaEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: heightEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: heightSqEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(out) :: epe
+
+ ! local variables
+ integer :: iCell, kLayer
+ real (kind=RKIND) :: sigma
+ real (kind=RKIND) :: HpHp
+
+ epe = 0.0_RKIND
+
+ do iCell = 1, nCells
+ do kLayer = 1,nLayers
+
+ sigma = max(sigmaEA(kLayer,iCell), epsilonEPFT)
+ HpHp = heightSqEA(kLayer,iCell) - heightEA(kLayer,iCell)*heightEA(kLayer,iCell)
+
+ epe(kLayer,iCell) = 0.5_RKIND * HpHp / sigma
+
+ enddo
+ enddo
+
+ end subroutine calculateEPEfromTWA!}}}
+
+
+!***********************************************************************
+!
+! subroutine calculateEddyFormDragfromTWA
+!
+!> \brief Calculate the eddy form drag from TWAs
+!> \author Juan A. Saenz
+!> \date July 2015
+!> \details
+!> This subroutine calculates the eddy form drag from thickness
+!> weighted averages.
+!-----------------------------------------------------------------------
+
+ subroutine calculateEddyFormDragfromTWA(nLayers, nCells, &
+ sigmaEA, heightEA, MxEA, HMxEA, formDragX)!{{{
+ implicit none
+ integer, intent(in) :: nLayers, nCells
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: sigmaEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: heightEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: MxEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(in) :: HMxEA
+ real (kind=RKIND), dimension(nLayers, nCells), intent(out) :: formDragX
+
+ ! local variables
+ integer :: iCell, kLayer
+ real (kind=RKIND) :: sigma
+ real (kind=RKIND) :: HpMxp
+
+ formDragX = 0.0_RKIND
+
+ do iCell = 1, nCells
+ do kLayer = 1,nLayers
+
+ sigma = max(sigmaEA(kLayer,iCell), epsilonEPFT)
+ HpMxp = HMxEA(kLayer,iCell) - heightEA(kLayer,iCell) * MxEA(kLayer,iCell)
+
+ formDragX(kLayer,iCell) = HpMxp / sigma
+ enddo
+ enddo
+
+ end subroutine calculateEddyFormDragfromTWA!}}}
+
+
+!***********************************************************************
+!
+! subroutine calculateDivEPFT
+!
+!> \brief Calculate the divergence of EPFT
+!> \author Juan A. Saenz, Todd Ringler
+!> \date May 2015
+!> \details
+!> This subroutine calculates the divergence of the Eliassen-Palm flux tensor.
+!> This is done by calculating the divergence of the column vectors in the tensor.
+!> The divergence of a vector v in buoyancy coordinates is given by (Young 2012):
+!> div of v = sigma^-1 (sigma * v_i)_xi
+!
+!-----------------------------------------------------------------------
+
+ subroutine calculateDivEPFT(debugFlag, onASphere, rho0, nLayers, nCells, nEdges, &
+ meshPool, buoyancyMidRef, sigmaEA, buoyancyMaskEA, tensorCellIn, vectorCellOut)!{{{
+
+ use mpas_vector_operations
+
+ logical, intent(in) :: debugFlag
+ logical, intent(in) :: onASphere
+ integer, intent(in) :: nLayers, nCells, nEdges
+ type (mpas_pool_type), intent(in) :: meshPool
+ real (kind=RKIND), intent(in) :: rho0 ! config_density0
+ real (kind=RKIND), dimension(:), intent(in) :: buoyancyMidRef
+ real (kind=RKIND), dimension(:,:), intent(in) :: sigmaEA
+ real (kind=RKIND), dimension(:,:), intent(in) :: buoyancyMaskEA
+ real (kind=RKIND), dimension(:,:,:,:), intent(in) :: tensorCellIn
+ real (kind=RKIND), dimension(:,:,:), intent(out) :: vectorCellOut
+
+ ! local variables
+ logical :: includeHalo
+ integer :: q, iCell, kLayer, iComponent
+ real (kind=RKIND) :: wrk, wrkAbove, wrkBelow, sigma, db
+ real (kind=RKIND), dimension(:), pointer :: latCell
+ real (kind=RKIND), dimension(:), pointer :: lonCell
+ integer, dimension(:,:), pointer :: edgeSignOnCell
+ real (kind=RKIND), dimension(:,:), allocatable :: scalarWrk1
+ real (kind=RKIND), dimension(:,:,:), allocatable :: vectorCellWrk1
+ real (kind=RKIND), dimension(:,:,:), allocatable :: vectorCellWrk2
+ real (kind=RKIND), dimension(:,:,:), allocatable :: vectorEdgeWrk1
+ real (kind=RKIND), dimension(:), allocatable :: vertVector
+
+ ! variables used for testing and debugging
+ real (kind=RKIND), dimension(:), allocatable :: divExact
+ real (kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell
+ integer, dimension(:,:), pointer :: boundaryCell
+
+ if (debugFlag) then
+ allocate(divExact(nCells+1))
+ end if
+
+ allocate(scalarWrk1(nLayers,nCells+1))
+ allocate(vectorCellWrk1(3,nLayers,nCells+1))
+ allocate(vectorCellWrk2(3,nLayers,nCells+1))
+ allocate(vectorEdgeWrk1(3,nLayers,nEdges+1))
+ allocate(vertVector(nLayers))
+
+ call mpas_pool_get_array(meshPool, 'latCell', latCell)
+ call mpas_pool_get_array(meshPool, 'lonCell', lonCell)
+ call mpas_pool_get_array(meshPool, 'edgeSignOnCell', edgeSignOnCell)
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'zCell', zCell)
+ call mpas_pool_get_array(meshPool, 'boundaryCell', boundaryCell)
+
+ includeHalo = .true.
+
+ ! initialize work and intent(out)
+ vectorCellOut = 0.0_RKIND
+
+ ! loop over all three column vectors
+ do q = 1, 3
+
+ scalarWrk1 = 0.0_RKIND
+
+ ! horizontal derivatives
+ vectorCellWrk1 = tensorCellIn(:,q,:,:)
+
+ ! weight the vector with sigmaEA(:,:)
+ do iComponent = 1,3
+ vectorCellWrk1(iComponent,:,:) = sigmaEA(:,:)*vectorCellWrk1(iComponent,:,:)
+ enddo
+
+
+ ! use q=3 as a test vector
+ if (q.eq.3 .and. debugFlag) then
+ do iCell = 1,nCells
+ vectorCellWrk1(1,:,iCell) = xCell(iCell)
+ vectorCellWrk1(2,:,iCell) = yCell(iCell)
+ vectorCellWrk1(3,:,iCell) = zCell(iCell)
+ ! the analytical divergence:
+ divExact(iCell) = -1.0_RKIND*sin(lonCell(iCell)) * &
+ (1.0_RKIND + 2.0_RKIND*sin(latCell(iCell))) !+ 3.0*sin(latCell(iCell))
+ enddo
+ endif
+
+ ! zero the vertical component of vectorCellWrk1
+ ! the vertical will be treated seperately below
+ vectorCellWrk1(3,:,:) = 0.0_RKIND
+
+ if (onASphere) then
+
+ ! convert from lat/lon to Cartesian (x,y,z)
+ do iCell = 1,nCells
+ do kLayer = 1,nLayers
+ call mpas_vector_LonLatR_to_R3(vectorCellWrk1(:,kLayer,iCell), &
+ lonCell(iCell), latCell(iCell), vectorCellWrk2(:,kLayer,iCell))
+ end do
+ end do
+
+ ! copy vector measured in x,y,z back into Wrk1
+ vectorCellWrk1 = vectorCellWrk2
+
+ end if
+
+ ! average the vector from cell centers to cell edges
+ call mpas_vector_R3Cell_to_Edge(vectorCellWrk1, meshPool, &
+ vectorEdgeWrk1)
+
+ ! computed the divergence via the weak, line-integral form
+ call mpas_divergence_in_r3_buoyancy(vectorEdgeWrk1, meshPool, &
+ edgeSignOnCell, includeHalo, scalarWrk1)
+
+ ! use q=3 as a test vector
+ if (q.eq.3 .and. debugFlag) then
+ print *, ' '
+ print *, 'calculateDivEPFT:'
+ print *, 'layer, RMS relative error on layer :'
+ do kLayer = 1,nLayers
+ wrk = sqrt( &
+ sum( &
+ ( &
+ (divExact(:)-scalarWrk1(kLayer,:))/ max(abs(divExact(:)),1.0e-15_RKIND) &
+ )**2 * &
+ (1.0_RKIND - boundaryCell(1,:)) &
+ ) / nCells )
+ print *, kLayer, wrk
+ enddo
+ endif
+
+
+ ! Normalize by sigma, after having taken the derivative of sigma * v_i
+ if (q < 3 .or. .not. debugFlag) then
+ do iCell = 1,nCells
+ do kLayer = 1,nLayers
+ sigma = max(sigmaEA(kLayer,iCell), epsilonEPFT)
+ scalarWrk1(kLayer,iCell) = scalarWrk1(kLayer,iCell) / sigma
+ end do
+ end do
+ end if
+
+
+ ! vertical derivative
+ do iCell = 1,nCells
+
+ ! copy the vertical component of EPFT into a work array
+ vertVector(:) = tensorCellIn(3,q,:,iCell)
+
+ ! use q=3 as a test vector
+ if (q.eq.3 .and. debugFlag) then
+ vertVector(:) = 0.0_RKIND
+ endif
+
+
+ do kLayer = 1,nLayers
+
+ wrk = 0.0_RKIND
+
+ if(kLayer.eq.1) then
+ wrkAbove=sigmaEA(kLayer,iCell)*vertVector(kLayer)
+ wrkBelow=sigmaEA(kLayer+1,iCell)*vertVector(kLayer+1)
+ db = buoyancyMidRef(kLayer)-buoyancyMidRef(kLayer+1)
+ else if (kLayer.eq.nLayers) then
+ wrkAbove=sigmaEA(kLayer-1,iCell)*vertVector(kLayer-1)
+ wrkBelow=sigmaEA(kLayer,iCell)*vertVector(kLayer)
+ db = buoyancyMidRef(kLayer-1)-buoyancyMidRef(kLayer)
+ else
+ wrkAbove=sigmaEA(kLayer-1,iCell)*vertVector(kLayer-1)
+ wrkBelow=sigmaEA(kLayer+1,iCell)*vertVector(kLayer+1)
+ db = buoyancyMidRef(kLayer-1)-buoyancyMidRef(kLayer+1)
+ endif
+
+ sigma = max(sigmaEA(kLayer,iCell), epsilonEPFT)
+ wrk = (wrkAbove - wrkBelow) / db / sigma
+
+ scalarWrk1(kLayer,iCell) = scalarWrk1(kLayer,iCell) + wrk
+
+ end do ! kLayer = 1,nLayers
+
+ end do ! iCell = 1,nCells
+
+ vectorCellOut(q,:,:) = scalarWrk1
+
+ end do !do q=1,3
+
+ if (debugFlag) then
+ deallocate(divExact)
+ end if
+ deallocate(scalarWrk1)
+ deallocate(vectorCellWrk1)
+ deallocate(vectorCellWrk2)
+ deallocate(vectorEdgeWrk1)
+ deallocate(vertVector)
+
+ end subroutine calculateDivEPFT!}}}
+
+
+
+!***********************************************************************
+!
+! subroutine calculateErtelPVFlux
+!
+!> \brief Calculate the Ertel potential vorticity fluxes
+!> \author Juan A. Saenz
+!> \date January 2014
+!> \details
+!> This subroutine calculates the Ertel potential vorticity fluxes
+!> using the divergence of EPFT, as outlined in eqn 129 of Young 2012.
+!
+!-----------------------------------------------------------------------
+
+ subroutine calculateErtelPVFlux(nCells, nBuoyancyLayers, &
+ sigma, divEPFT, ErtelPVFlux)!{{{
+
+ integer, intent(in) :: nCells, nBuoyancyLayers
+ real (kind=RKIND), dimension(:,:), intent(in) :: sigma
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: divEPFT
+ real (kind=RKIND), dimension(:,:,:), intent(out) :: ErtelPVFlux
+
+ ! local variables
+ integer :: i, k
+
+ ErtelPVFlux(1,:,:) = divEPFT(2,:,:)
+ ErtelPVFlux(2,:,:) = -1.0_RKIND * divEPFT(1,:,:)
+ ErtelPVFlux(3,:,:) = 0.0_RKIND
+
+ do i = 1, nCells
+ do k = 1,nBuoyancyLayers
+ ErtelPVFlux(:,k,i) = ErtelPVFlux(:,k,i) / max(sigma(k,i),epsilonEPFT)
+ end do
+ end do
+
+ end subroutine calculateErtelPVFlux
+
+
+!***********************************************************************
+!
+! subroutine calculateErtelPVTendencyFromPVFlux
+!
+!> \brief Calculate the Ertel PV tendency from Ertel PV flux
+!> \author Juan A. Saenz, Todd Ringler
+!> \date May 2015
+!> \details
+!> This subroutine calculates the Ertel PV tendency as the divergence of
+!> the Ertel PV flux, where the latter only has horizontal components.
+!
+!-----------------------------------------------------------------------
+
+ subroutine calculateErtelPVTendencyFromPVFlux(debugFlag, onASphere, nLayers, nCells, nEdges, &
+ meshPool, sigma, vectorCell, divVectorCell)!{{{
+
+ use mpas_vector_operations
+
+ logical, intent(in) :: debugFlag
+ logical, intent(in) :: onASphere
+ integer, intent(in) :: nLayers, nCells, nEdges
+ type (mpas_pool_type), intent(in) :: meshPool
+ real (kind=RKIND), dimension(:,:), intent(in) :: sigma
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: vectorCell
+ real (kind=RKIND), dimension(:,:), intent(out) :: divVectorCell
+
+ ! local variables
+ logical :: includeHalo
+ integer :: i, k, iComponent
+ real (kind=RKIND), dimension(:), pointer :: latCell
+ real (kind=RKIND), dimension(:), pointer :: lonCell
+ integer, dimension(:,:), pointer :: edgeSignOnCell, boundaryCell
+ real (kind=RKIND), dimension(:,:,:), allocatable :: vectorCellWrk1
+ real (kind=RKIND), dimension(:,:,:), allocatable :: vectorCellWrk2
+ real (kind=RKIND), dimension(:,:,:), allocatable :: vectorEdgeWrk1
+
+ ! test variables
+ real (kind=RKIND) :: wrk
+ real (kind=RKIND), dimension(:), allocatable :: divExact
+ real (kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell
+
+ if (debugFlag) then
+ allocate(divExact(nCells+1))
+ end if
+
+
+ allocate(vectorCellWrk1(3,nLayers,nCells+1))
+ allocate(vectorCellWrk2(3,nLayers,nCells+1))
+ allocate(vectorEdgeWrk1(3,nLayers,nEdges)) !jas issue Todd had set this to nEdges+1
+
+ call mpas_pool_get_array(meshPool, 'edgeSignOnCell', edgeSignOnCell)
+ call mpas_pool_get_array(meshPool, 'boundaryCell', boundaryCell)
+ call mpas_pool_get_array(meshPool, 'latCell', latCell)
+ call mpas_pool_get_array(meshPool, 'lonCell', lonCell)
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'zCell', zCell)
+
+ includeHalo = .true.
+
+ divVectorCell = 0.0_RKIND
+
+ ! copy vector into work array
+ vectorCellWrk1 = vectorCell
+
+ ! weight the vector with sigma(:,:)
+ do iComponent = 1,3
+ vectorCellWrk1(iComponent,:,:) = sigma(:,:)*vectorCellWrk1(iComponent,:,:)
+ enddo
+
+
+ if (debugFlag) then
+ do i= 1,nCells
+ vectorCellWrk1(1,:,i) = xCell(i)
+ vectorCellWrk1(2,:,i) = yCell(i)
+ vectorCellWrk1(3,:,i) = zCell(i)
+ ! the analytical divergence:
+ divExact(i) = -1.0_RKIND*sin(lonCell(i)) * &
+ (1.0_RKIND + 2.0_RKIND*sin(latCell(i))) !+ 3.0*sin(latCell(i))
+ enddo
+ endif
+
+
+ if (onASphere) then
+ ! copy vector into work array
+ do i = 1,nCells
+ do k = 1,nLayers
+ call mpas_vector_LonLatR_to_R3(vectorCellWrk1(:,k,i), &
+ lonCell(i), latCell(i), vectorCellWrk2(:,k,i))
+ end do
+ end do
+
+ ! copy transformed vector back to Wrk1
+ vectorCellWrk1 = vectorCellWrk2
+ end if
+
+ ! average vector from cell centers to cell edges
+ call mpas_vector_R3Cell_to_Edge(vectorCellWrk1, meshPool, &
+ vectorEdgeWrk1)
+
+ ! computed divergence via weak-form, line integral
+ call mpas_divergence_in_r3_buoyancy(vectorEdgeWrk1, meshPool, edgeSignOnCell, &
+ includeHalo, divVectorCell)
+
+
+ if (debugFlag) then
+ print *, ' '
+ print *, 'calculateErtelPVTendencyFromPVFlux:'
+ print *, 'k, RMS relative error on layer:'
+ do k= 1,nLayers
+ wrk = sqrt( &
+ sum( &
+ ( &
+ (divExact(:)-divVectorCell(k,:))/ max(abs(divExact(:)),1.0e-15_RKIND) &
+ )**2 * &
+ (1.0_RKIND - boundaryCell(1,:)) &
+ ) / nCells )
+ print *, k, wrk
+ enddo
+ endif
+
+
+ if (.not. debugFlag) then
+ do i = 1,nCells
+ do k = 1,nLayers
+ divVectorCell(k,i) = divVectorCell(k,i) / max(sigma(k,i), epsilonEPFT)
+ end do
+ end do
+ end if
+
+ if (debugFlag) then
+ deallocate(divExact)
+ end if
+ deallocate(vectorCellWrk1)
+ deallocate(vectorCellWrk2)
+ deallocate(vectorEdgeWrk1)
+
+ end subroutine calculateErtelPVTendencyFromPVFlux!}}}
+
+
+
+!***********************************************************************
+!
+! subroutine computeErtelPV
+!
+!> \brief Calculate Ertel potential vorticity on buoyancy surfaces
+!> \author Juan A. Saenz
+!> \date January 2014
+!> \details
+!> This subroutine calculates Ertel potential voriticity in buoyancy surfaces
+!
+!-----------------------------------------------------------------------
+
+ subroutine computeErtelPV(nCells, nLayers, nEdges, meshPool, &
+ fCell, uCell, vCell, sigma, ErtelPV)
+
+ use mpas_vector_reconstruction
+
+ integer, intent(in) :: nCells, nLayers, nEdges
+ type (mpas_pool_type), intent(in) :: meshPool
+ real (kind=RKIND), dimension(:), intent(in) :: fCell
+ real (kind=RKIND), dimension(:,:), intent(in) :: uCell, vCell
+ real (kind=RKIND), dimension(:,:), intent(in) :: sigma
+ real (kind=RKIND), dimension(:,:), intent(out) :: ErtelPV
+
+ ! local variables
+ integer :: i, k
+ real (kind=RKIND), dimension(:,:), allocatable :: velNormalGradOnEdge
+ real (kind=RKIND), dimension(:,:), allocatable :: velGradX, velGradY, velGradZ
+ real (kind=RKIND), dimension(:,:), allocatable :: velGradZonal, velGradMerid
+ real (kind=RKIND), dimension(:,:), allocatable :: vGradZonal, uGradMerid
+
+ allocate(velNormalGradOnEdge(nLayers, nEdges)) ! jas issue this one seems correct
+ allocate(velGradX(nLayers, nCells)) ! jas issue gets sent to routine where looping over nCellsSolve
+ allocate(velGradY(nLayers, nCells)) ! jas issue gets sent to routine where looping over nCellsSolve
+ allocate(velGradZ(nLayers, nCells)) ! jas issue gets sent to routine where looping over nCellsSolve
+ allocate(velGradZonal(nLayers, nCells)) ! jas issue gets sent to routine where looping over nCellsSolve
+ allocate(velGradMerid(nLayers, nCells)) ! jas issue gets sent to routine where looping over nCellsSolve
+ allocate(uGradMerid(nLayers, nCells)) ! jas issue gets assigned array of size is nCells
+ allocate(vGradZonal(nLayers, nCells)) ! jas issue gets assigned array of size is nCells
+
+ ! calculate derivative of uTWA with respect to the meridional direction
+ call computeNormalGradientOnEdge(nLayers, nCells, nEdges, &
+ meshPool, uCell, velNormalGradOnEdge)
+ call mpas_reconstruct(meshPool, velNormalGradOnEdge, &
+ velGradX, velGradY, velGradZ, &
+ velGradZonal, velGradMerid, includeHalos=.true.)
+ uGradMerid = velGradMerid
+
+ ! calculate derivative of vTWA with respect to the zonal direction
+ call computeNormalGradientOnEdge(nLayers, nCells, nEdges, &
+ meshPool, vCell, velNormalGradOnEdge)
+ call mpas_reconstruct(meshPool, velNormalGradOnEdge, &
+ velGradX, velGradY, velGradZ, &
+ velGradZonal, velGradMerid, includeHalos=.true.)
+ vGradZonal = velGradZonal
+
+ ErtelPV = 0.0_RKIND
+
+ do i = 1, nCells
+ do k = 1,nLayers
+ ErtelPV(k,i) = (fCell(i) + vGradZonal(k,i) - uGradMerid(k,i))/max(sigma(k,i),epsilonEPFT)
+ end do
+ end do
+
+ deallocate(velNormalGradOnEdge)
+ deallocate(velGradX)
+ deallocate(velGradY)
+ deallocate(velGradZ)
+ deallocate(velGradZonal)
+ deallocate(velGradMerid)
+ deallocate(vGradZonal)
+ deallocate(uGradMerid)
+
+
+ end subroutine computeErtelPV
+
+
+!***********************************************************************
+!
+! subroutine computeVerticalDerivative
+!
+!> \brief Calculate the the vertical derivative, in depth coordinates, of a scalar
+!> \author Juan A. Saenz
+!> \date July, 2015
+!> \details
+!> This subroutine calculates the vertical derivative, in depth coordinates, of a scalar.
+!> The scalar is assumed to exist in the middle of a cell layer.
+!> The vertical derivative in the middle of the cell layer is returned.
+!
+!-----------------------------------------------------------------------
+
+ subroutine computeVerticalDerivative(nCells, nLayers, &
+ firstLayer, lastLayer, heightMid, field, derivativeField)!{{{
+ integer, intent(in) :: nCells, nLayers
+ integer, dimension(nCells), intent(in) :: firstLayer, lastLayer
+ real (kind=RKIND), dimension(:,:), intent(in) :: heightMid
+ real (kind=RKIND), dimension(:,:), intent(in) :: field
+ real (kind=RKIND), dimension(:,:), intent(out) :: derivativeField
+
+ ! local variables
+ integer :: iCell, kLayer
+ real (kind=RKIND) :: wrkAbove, wrkBelow, dz
+
+ derivativeField(nLayers, 1:nCells) = 0.0_RKIND
+
+ do iCell = 1,nCells
+
+ if ( lastLayer(iCell) > firstLayer(iCell) ) then
+ wrkAbove = field(firstLayer(iCell),iCell)
+ wrkBelow = field(firstLayer(iCell)+1,iCell)
+ dz = heightMid(firstLayer(iCell),iCell)-heightMid(firstLayer(iCell)+1,iCell)
+
+ derivativeField(firstLayer(iCell), iCell) = (wrkAbove - wrkBelow) / dz
+
+ do kLayer = firstLayer(iCell)+1, lastLayer(iCell)-1
+
+ wrkAbove = field(kLayer-1,iCell)
+ wrkBelow = field(kLayer+1,iCell)
+ dz = heightMid(kLayer-1,iCell)-heightMid(kLayer+1,iCell)
+
+ derivativeField(kLayer, iCell) = (wrkAbove - wrkBelow) / dz
+
+ end do ! kLayer = firstLayer(iCell)+1, lastLayer(iCell)-1
+
+ wrkAbove = field(lastLayer(iCell)-1,iCell)
+ wrkBelow = field(lastLayer(iCell),iCell)
+ dz = heightMid(lastLayer(iCell)-1,iCell)-heightMid(lastLayer(iCell),iCell)
+
+ derivativeField(lastLayer(iCell), iCell) = (wrkAbove - wrkBelow) / dz
+ end if
+ end do ! iCell = 1,nCells
+ end subroutine computeVerticalDerivative!}}}
+
+
+!***********************************************************************
+!
+! subroutine eddyGeomDecompEPFT
+!
+!> \brief Calculate the eddy geometric decomposition from EPFT
+!> \author Juan A. Saenz
+!> \date January 2014
+!> \details
+!> This subroutine calculates the eddy geometric decomposition from EPFT
+!
+!-----------------------------------------------------------------------
+
+ subroutine eddyGeomDecompEPFT()!sigmaRef, ErtelPVFlux, ErtelPVTendency)!{{{
+ ! Compute the geometric decomposition in terms of angles and eccentricities using
+ ! the entries of EPFT.
+
+ end subroutine eddyGeomDecompEPFT!}}}
+
+
+!***********************************************************************
+!
+! routine mpas_divergence_in_r3_buoyancy
+!
+!> \brief MPAS 3D divergence routine
+!> \author Todd Ringler
+!> \date 02/07/14
+!> \details
+!> This routine computes the of an input vector.
+!-----------------------------------------------------------------------
+ subroutine mpas_divergence_in_r3_buoyancy(vectorR3Edge, meshPool, &
+ edgeSignOnCell, includeHalo, divCell)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ vectorR3Edge !< Input: vector at edge, R3, indices (direction,verticalIndex,edgeIndex)
+
+ type (mpas_pool_type), intent(in) :: &
+ meshPool !< Input: mesh information
+
+ integer, dimension(:,:), intent(in) :: &
+ edgeSignOnCell !< Input: Direction of vector connecting cells
+
+ logical, intent(in) :: &
+ includeHalo !< Input: If true, halo cells and edges are included in computation
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(out) :: &
+ divCell !< Output: scalar divergence, indices (verticalIndex,edgeIndex)
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iEdge, iCell, i, k, p
+ integer, pointer :: nVertLevels, nCells
+
+ integer, dimension(:), pointer :: nEdgesOnCell
+ integer, dimension(:,:), pointer :: edgesOnCell
+
+ real (kind=RKIND) :: invAreaCell
+ real (kind=RKIND) :: edgeNormalDotVector
+ real (kind=RKIND), dimension(:), pointer :: dvEdge, areaCell
+ real (kind=RKIND), dimension(:,:), pointer :: edgeNormalVectors
+
+ call mpas_pool_get_dimension(meshPool, 'nBuoyancyLayers', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell)
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell)
+ call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge)
+ call mpas_pool_get_array(meshPool, 'areaCell', areaCell)
+ call mpas_pool_get_array(meshPool, 'edgeNormalVectors', edgeNormalVectors)
+
+ divCell(:,:) = 0.0_RKIND
+ do iCell = 1, nCells
+ invAreaCell = 1.0_RKIND / areaCell(iCell)
+ do i = 1, nEdgesOnCell(iCell)
+ iEdge = edgesOnCell(i, iCell)
+ do k = 1, nVertLevels
+ edgeNormalDotVector = 0.0_RKIND
+ do p=1,3
+ edgeNormalDotVector = edgeNormalDotVector + &
+ edgeNormalVectors(p,iEdge)*vectorR3Edge(p,k,iEdge)
+ enddo
+ divCell(k,iCell) = divCell(k,iCell) - &
+ edgeSignOnCell(i,iCell) * dvEdge(iEdge) * invAreaCell * &
+ edgeNormalDotVector
+ end do
+ end do
+ end do
+
+ end subroutine mpas_divergence_in_r3_buoyancy!}}}
+
+
+!***********************************************************************
+!
+! routine mpas_vector_R3Cell_to_Edge
+!
+!> \brief MPAS 3D divergence routine
+!> \author Todd Ringler
+!> \date 02/07/14
+!> \details
+!> This routine averages a vector field from cells to edges
+!-----------------------------------------------------------------------
+ subroutine mpas_vector_R3Cell_to_Edge(vectorCell, meshPool, &
+ vectorEdge)
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: vectorCell
+ type (mpas_pool_type), intent(in) :: meshPool !< Input: mesh information
+ real (kind=RKIND), dimension(:,:,:), intent(out) :: vectorEdge
+
+ !local variables
+ integer :: iEdge, k, cell1, cell2
+ integer, pointer :: nEdges, nBuoyancyLayers
+ integer, dimension(:,:), pointer :: cellsOnEdge, boundaryEdge
+
+ call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
+ call mpas_pool_get_array(meshPool, 'boundaryEdge', boundaryEdge)
+
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+ call mpas_pool_get_dimension(meshPool, 'nBuoyancyLayers', nBuoyancyLayers)
+
+ vectorEdge = 0.0_RKIND
+
+ do iEdge = 1, nEdges
+ ! Enforce vector value of zero on boundary edges, e.g. no slip for velocities
+ if (boundaryEdge(1,iEdge) == 1) then
+ vectorEdge(:,:,iEdge) = 0.0_RKIND
+ else
+ cell1 = cellsOnEdge(1, iEdge)
+ cell2 = cellsOnEdge(2, iEdge)
+ do k = 1, nBuoyancyLayers
+ vectorEdge(:,k,iEdge) = 0.5_RKIND*( vectorCell(:,k,cell2) + vectorCell(:,k,cell1) )
+ enddo
+ end if
+ enddo
+
+ end subroutine mpas_vector_R3Cell_to_Edge!}}}
+
+
+end module ocn_eliassen_palm
+
+! vim: foldmethod=marker
diff --git a/src/core_ocean/analysis_members/mpas_ocn_global_stats.F b/src/core_ocean/analysis_members/mpas_ocn_global_stats.F
index c989190b72..ab68cdc53a 100644
--- a/src/core_ocean/analysis_members/mpas_ocn_global_stats.F
+++ b/src/core_ocean/analysis_members/mpas_ocn_global_stats.F
@@ -118,12 +118,13 @@ subroutine ocn_init_global_stats(domain, err)!{{{
open(fileID,file=trim(config_AM_globalStats_directory)//'/stats_readme.txt',STATUS='UNKNOWN', POSITION='rewind')
write (fileID,'(a)') 'readme file for MPAS-Ocean global statistics'
- write (fileID,'(/,a)') 'stats_time.txt. contains: timeIndex, timestamp, CFLNumberGlobal'
- write (fileID,'(/,a)') 'All other stats_*.txt. contain the following columns. Rows correspond to timestamps in rows of stats_time.txt'
+ write (fileID,'(/,a)') 'stats_time.txt. contains: timestamp, time (in days), CFLNumberGlobal'
+ write (fileID,'(/,a)') 'All other stats_*.txt. contain the following columns. Rows correspond to timestamps ' &
+ // 'in rows of stats_time.txt'
write (fileID,'(a)') "See user's guide for units associated with these variables."
i=1
- write (fileID,'(i5,a)') i,'. time, in days, using a 360 day calendar'; i=i+1
+ write (fileID,'(i5,a)') i,'. time, in days'; i=i+1
write (fileID,'(i5,a)') i,'. layerThickness'; i=i+1
write (fileID,'(i5,a)') i,'. normalVelocity'; i=i+1
write (fileID,'(i5,a)') i,'. tangentialVelocity'; i=i+1
@@ -131,7 +132,8 @@ subroutine ocn_init_global_stats(domain, err)!{{{
write (fileID,'(i5,a)') i,'. relativeVorticity'; i=i+1
write (fileID,'(i5,a)') i,'. enstrophy = relativeVorticity**2'; i=i+1
write (fileID,'(i5,a)') i,'. kineticEnergyCell'; i=i+1
- write (fileID,'(i5,a)') i,'. normalizedAbsoluteVorticity = (relative vorticity + planetary vorticity)/layer thickness'; i=i+1
+ write (fileID,'(i5,a)') i,'. normalizedAbsoluteVorticity = (relative vorticity + planetary vorticity)/layer ' &
+ // 'thickness'; i=i+1
write (fileID,'(i5,a)') i,'. pressure'; i=i+1
write (fileID,'(i5,a)') i,'. montgomeryPotential'; i=i+1
write (fileID,'(i5,a)') i,'. vertVelocityTop vertical velocity'; i=i+1
@@ -140,10 +142,11 @@ subroutine ocn_init_global_stats(domain, err)!{{{
write (fileID,'(i5,a)') i,'. highFreqThickness'; i=i+1
write (fileID,'(i5,a)') i,'. Tracers: usually T, S, then others in remaining columns'
- write (fileID,'(/,a)') 'A chain of simple unix commands may be used to access a specific part of the data. For example,'
+ write (fileID,'(/,a)') 'A chain of simple unix commands may be used to access a specific part of the data. ' &
+ // 'For example,'
write (fileID,'(a)') 'to view the last three values of column seven in the global average, use:'
write (fileID,'(a)') "cat stats_avg.txt | awk '{print $7}' | tail -n3"
-
+
close (fileID)
endif
@@ -218,45 +221,52 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
type (dm_info) :: dminfo
type (block_type), pointer :: block
type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: tracersPool
type (mpas_pool_type), pointer :: meshPool
type (mpas_pool_type), pointer :: scratchPool
type (mpas_pool_type), pointer :: diagnosticsPool
integer :: err_tmp
integer :: nCellsGlobal, nEdgesGlobal, nVerticesGlobal, iTracer
- integer :: elementIndex, variableIndex, nVariables, nSums, nMaxes, nMins
+ integer :: iEdge, variableIndex, nVariables, nSums, nMaxes, nMins
integer :: k, i, fileID
integer :: timeYYYY, timeMM, timeDD, timeH, timeM, timeS
- integer, pointer :: nVertLevels, nCellsSolve, nEdgesSolve, nVerticesSolve, num_tracers
+ integer, pointer :: nVertLevels, nCellsSolve, nEdgesSolve, nVerticesSolve, num_activeTracers
character*1 timeChar
integer, parameter :: kMaxVariables = 1024 ! this must be a little more than double the number of variables to be reduced
integer, dimension(:), pointer :: maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
- character (len=StrKIND), pointer :: xtime
+ character (len=StrKIND), pointer :: xtime, simulationStartTime
+ type (MPAS_Time_type) :: xtime_timeType, simulationStartTime_timeType
+ type (MPAS_TimeInterval_type) :: timeStep
- real (kind=RKIND) :: volumeCellGlobal, volumeEdgeGlobal, CFLNumberGlobal, localCFL, localSum, areaCellGlobal, areaEdgeGlobal, areaTriangleGlobal, time_days
+ real (kind=RKIND) :: localCFL, localSum, dt
+ real (kind=RKIND), pointer :: volumeCellGlobal, volumeEdgeGlobal, CFLNumberGlobal, areaCellGlobal, &
+ areaEdgeGlobal, areaTriangleGlobal
real (kind=RKIND), dimension(:), pointer :: areaCell, dcEdge, dvEdge, areaTriangle, areaEdge
- real (kind=RKIND), dimension(:,:), pointer :: layerThickness, normalVelocity, tangentialVelocity, layerThicknessEdge, relativeVorticity, kineticEnergyCell, &
- normalizedRelativeVorticityEdge, normalizedPlanetaryVorticityEdge, pressure, montgomeryPotential, vertAleTransportTop, vertVelocityTop, &
- lowFreqDivergence, highFreqThickness, density
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness, normalVelocity, tangentialVelocity, layerThicknessEdge, &
+ relativeVorticity, kineticEnergyCell, normalizedRelativeVorticityEdge, &
+ normalizedPlanetaryVorticityEdge, pressure, montgomeryPotential, &
+ vertAleTransportTop, vertVelocityTop, lowFreqDivergence, highFreqThickness, &
+ density
+
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
- real (kind=RKIND), dimension(:), pointer :: minGlobalStats,maxGlobalStats,sumGlobalStats, averages, rms, verticalSumMins, verticalSumMaxes
+ real (kind=RKIND), pointer :: daysSinceStartOfSim
+ real (kind=RKIND), dimension(:), pointer :: minGlobalStats,maxGlobalStats,sumGlobalStats, averages, rms, verticalSumMins, &
+ verticalSumMaxes
real (kind=RKIND), dimension(kMaxVariables) :: sumSquares, reductions, sums, mins, maxes
- real (kind=RKIND), dimension(kMaxVariables) :: sums_tmp, sumSquares_tmp, mins_tmp, maxes_tmp, averages_tmp, verticalSumMins_tmp, verticalSumMaxes_tmp
+ real (kind=RKIND), dimension(kMaxVariables) :: sums_tmp, sumSquares_tmp, mins_tmp, maxes_tmp, averages_tmp, &
+ verticalSumMins_tmp, verticalSumMaxes_tmp
real (kind=RKIND), dimension(:,:), allocatable :: enstrophy, normalizedAbsoluteVorticity, workArray
- logical, pointer :: thicknessFilterActive, globalStatsAMPKGActive
+ logical, pointer :: thicknessFilterActive
logical, pointer :: config_AM_globalStats_text_file
character (len=StrKIND), pointer :: config_AM_globalStats_directory
err = 0
- call mpas_pool_get_package(ocnPackages, 'globalStatsAMPKGActive', globalStatsAMPKGActive)
-
- if ( .not. globalStatsAMPKGActive ) return
-
dminfo = domain % dminfo
call mpas_pool_get_package(ocnPackages, 'thicknessFilterActive', thicknessFilterActive)
@@ -270,15 +280,24 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
call mpas_pool_get_array(globalStatsAMPool, 'avgGlobalStats', averages)
call mpas_pool_get_array(globalStatsAMPool, 'vertSumMinGlobalStats', verticalSumMins)
call mpas_pool_get_array(globalStatsAMPool, 'vertSumMaxGlobalStats', verticalSumMaxes)
-
- sums = 0.0
- sumSquares = 0.0
- mins = 1.0e34
- maxes = -1.0e34
- averages = 0.0
- verticalSumMins = 1.0e34
- verticalSumMaxes = -1.0e34
- reductions = 0.0
+ call mpas_pool_get_array(globalStatsAMPool, 'areaCellGlobal', areaCellGlobal)
+ call mpas_pool_get_array(globalStatsAMPool, 'areaEdgeGlobal', areaEdgeGlobal)
+ call mpas_pool_get_array(globalStatsAMPool, 'areaTriangleGlobal', areaTriangleGlobal)
+ call mpas_pool_get_array(globalStatsAMPool, 'volumeCellGlobal', volumeCellGlobal)
+ call mpas_pool_get_array(globalStatsAMPool, 'volumeEdgeGlobal', volumeEdgeGlobal)
+ call mpas_pool_get_array(globalStatsAMPool, 'CFLNumberGlobal', CFLNumberGlobal)
+
+ sums = 0.0_RKIND
+ sumSquares = 0.0_RKIND
+ mins = 1.0e34_RKIND
+ maxes = -1.0e34_RKIND
+ averages = 0.0_RKIND
+ verticalSumMins = 1.0e34_RKIND
+ verticalSumMaxes = -1.0e34_RKIND
+ reductions = 0.0_RKIND
+
+ timeStep = mpas_get_clock_timestep(domain % clock, ierr=err_tmp)
+ call mpas_get_timeInterval(timeStep, dt=dt)
block => domain % blocklist
do while (associated(block))
@@ -288,12 +307,13 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
call mpas_pool_get_dimension(block % dimensions, 'nVerticesSolve', nVerticesSolve)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'globalStatsAM', globalStatsAMPool)
- call mpas_pool_get_dimension(statePool, 'num_tracers', num_tracers)
+ call mpas_pool_get_dimension(tracersPool, 'num_activeTracers', num_activeTracers)
call mpas_pool_get_array(meshPool, 'areaCell', areaCell)
call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
@@ -305,7 +325,7 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, 1)
- call mpas_pool_get_array(statePool, 'tracers', tracers, 1)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
if(thicknessFilterActive) then
call mpas_pool_get_array(statePool, 'lowFreqDivergence', lowFreqDivergence, 1)
call mpas_pool_get_array(statePool, 'highFreqThickness', highFreqThickness, 1)
@@ -322,8 +342,9 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
call mpas_pool_get_array(diagnosticsPool, 'tangentialVelocity', tangentialVelocity)
call mpas_pool_get_array(diagnosticsPool, 'layerThicknessEdge', layerThicknessEdge)
call mpas_pool_get_array(diagnosticsPool, 'kineticEnergyCell', kineticEnergyCell)
-
call mpas_pool_get_array(diagnosticsPool, 'xtime', xtime)
+ call mpas_pool_get_array(diagnosticsPool, 'simulationStartTime',simulationStartTime)
+ call mpas_pool_get_array(diagnosticsPool, 'daysSinceStartOfSim',daysSinceStartOfSim)
allocate(areaEdge(1:nEdgesSolve))
areaEdge = dcEdge(1:nEdgesSolve)*dvEdge(1:nEdgesSolve)
@@ -333,8 +354,12 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
variableIndex = 0
! layerThickness
variableIndex = variableIndex + 1
- call ocn_compute_field_area_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), layerThickness(:,1:nCellsSolve), &
- sums_tmp(variableIndex), sumSquares_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), verticalSumMaxes_tmp(variableIndex))
+ call ocn_compute_field_area_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, &
+ maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), &
+ layerThickness(:,1:nCellsSolve), sums_tmp(variableIndex), &
+ sumSquares_tmp(variableIndex), mins_tmp(variableIndex), &
+ maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
+ verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
sumSquares(variableIndex) = sumSquares(variableIndex) + sumSquares_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -344,9 +369,14 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
! normalVelocity
variableIndex = variableIndex + 1
- call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nEdgesSolve, maxLevelEdgeTop(1:nEdgesSolve), areaEdge(1:nEdgesSolve), layerThicknessEdge(:,1:nEdgesSolve), &
- normalVelocity(:,1:nEdgesSolve), sums_tmp(variableIndex), sumSquares_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
- verticalSumMaxes_tmp(variableIndex))
+ call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nEdgesSolve, &
+ maxLevelEdgeTop(1:nEdgesSolve), areaEdge(1:nEdgesSolve), &
+ layerThicknessEdge(:,1:nEdgesSolve), &
+ normalVelocity(:,1:nEdgesSolve), sums_tmp(variableIndex), &
+ sumSquares_tmp(variableIndex), mins_tmp(variableIndex), &
+ maxes_tmp(variableIndex), &
+ verticalSumMins_tmp(variableIndex), &
+ verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
sumSquares(variableIndex) = sumSquares(variableIndex) + sumSquares_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -356,9 +386,14 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
! tangentialVelocity
variableIndex = variableIndex + 1
- call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nEdgesSolve, maxLevelEdgeTop(1:nEdgesSolve), areaEdge(1:nEdgesSolve), layerThicknessEdge(:,1:nEdgesSolve), &
- tangentialVelocity(:,1:nEdgesSolve), sums_tmp(variableIndex), sumSquares_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
- verticalSumMaxes_tmp(variableIndex))
+ call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nEdgesSolve, &
+ maxLevelEdgeTop(1:nEdgesSolve), areaEdge(1:nEdgesSolve), &
+ layerThicknessEdge(:,1:nEdgesSolve), &
+ tangentialVelocity(:,1:nEdgesSolve), &
+ sums_tmp(variableIndex), sumSquares_tmp(variableIndex), &
+ mins_tmp(variableIndex), maxes_tmp(variableIndex), &
+ verticalSumMins_tmp(variableIndex), &
+ verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
sumSquares(variableIndex) = sumSquares(variableIndex) + sumSquares_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -368,8 +403,12 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
! layerThicknessEdge
variableIndex = variableIndex + 1
- call ocn_compute_field_area_weighted_local_stats_max_level(dminfo, nVertLevels, nEdgesSolve, maxLevelEdgeTop(1:nEdgesSolve), areaEdge(1:nEdgesSolve), layerThicknessEdge(:,1:nEdgesSolve), &
- sums_tmp(variableIndex), sumSquares_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), verticalSumMaxes_tmp(variableIndex))
+ call ocn_compute_field_area_weighted_local_stats_max_level(dminfo, nVertLevels, nEdgesSolve, &
+ maxLevelEdgeTop(1:nEdgesSolve), areaEdge(1:nEdgesSolve), &
+ layerThicknessEdge(:,1:nEdgesSolve), sums_tmp(variableIndex), &
+ sumSquares_tmp(variableIndex), mins_tmp(variableIndex), &
+ maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
+ verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
sumSquares(variableIndex) = sumSquares(variableIndex) + sumSquares_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -379,8 +418,14 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
! relativeVorticity
variableIndex = variableIndex + 1
- call ocn_compute_field_area_weighted_local_stats_max_level(dminfo, nVertLevels, nVerticesSolve, maxLevelVertexBot(1:nVerticesSolve), areaTriangle(1:nVerticesSolve), relativeVorticity(:,1:nVerticesSolve), &
- sums_tmp(variableIndex), sumSquares_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), verticalSumMaxes_tmp(variableIndex))
+ call ocn_compute_field_area_weighted_local_stats_max_level(dminfo, nVertLevels, nVerticesSolve, &
+ maxLevelVertexBot(1:nVerticesSolve), &
+ areaTriangle(1:nVerticesSolve), &
+ relativeVorticity(:,1:nVerticesSolve), &
+ sums_tmp(variableIndex), sumSquares_tmp(variableIndex), &
+ mins_tmp(variableIndex), maxes_tmp(variableIndex), &
+ verticalSumMins_tmp(variableIndex), &
+ verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
sumSquares(variableIndex) = sumSquares(variableIndex) + sumSquares_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -392,9 +437,13 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
allocate(enstrophy(nVertLevels,nVerticesSolve))
enstrophy(:,:)=relativeVorticity(:,1:nVerticesSolve)**2
variableIndex = variableIndex + 1
- call ocn_compute_field_area_weighted_local_stats_max_level(dminfo, nVertLevels, nVerticesSolve, maxLevelVertexBot(1:nVerticesSolve), areaTriangle(1:nVerticesSolve), &
- enstrophy(:,:), sums_tmp(variableIndex), sumSquares_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), &
- verticalSumMins_tmp(variableIndex), verticalSumMaxes_tmp(variableIndex))
+ call ocn_compute_field_area_weighted_local_stats_max_level(dminfo, nVertLevels, nVerticesSolve, &
+ maxLevelVertexBot(1:nVerticesSolve), &
+ areaTriangle(1:nVerticesSolve), enstrophy(:,:), &
+ sums_tmp(variableIndex), sumSquares_tmp(variableIndex), &
+ mins_tmp(variableIndex), maxes_tmp(variableIndex), &
+ verticalSumMins_tmp(variableIndex), &
+ verticalSumMaxes_tmp(variableIndex))
deallocate(enstrophy)
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
sumSquares(variableIndex) = sumSquares(variableIndex) + sumSquares_tmp(variableIndex)
@@ -405,9 +454,14 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
! kineticEnergyCell
variableIndex = variableIndex + 1
- call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), layerThickness(:,1:nCellsSolve), &
- kineticEnergyCell(:,1:nCellsSolve), sums_tmp(variableIndex), sumSquares_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
- verticalSumMaxes_tmp(variableIndex))
+ call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, &
+ maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), &
+ layerThickness(:,1:nCellsSolve), &
+ kineticEnergyCell(:,1:nCellsSolve), &
+ sums_tmp(variableIndex), sumSquares_tmp(variableIndex), &
+ mins_tmp(variableIndex), maxes_tmp(variableIndex), &
+ verticalSumMins_tmp(variableIndex), &
+ verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
sumSquares(variableIndex) = sumSquares(variableIndex) + sumSquares_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -417,11 +471,17 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
! normalizedAbsoluteVorticity
allocate(normalizedAbsoluteVorticity(nVertLevels,nEdgesSolve))
- normalizedAbsoluteVorticity(:,:) = normalizedRelativeVorticityEdge(:,1:nEdgesSolve) + normalizedPlanetaryVorticityEdge(:,1:nEdgesSolve)
+ normalizedAbsoluteVorticity(:,:) = normalizedRelativeVorticityEdge(:,1:nEdgesSolve) &
+ + normalizedPlanetaryVorticityEdge(:,1:nEdgesSolve)
variableIndex = variableIndex + 1
- call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nEdgesSolve, maxLevelEdgeTop(1:nEdgesSolve), areaEdge(1:nEdgesSolve), layerThicknessEdge(:,1:nEdgesSolve), &
- normalizedAbsoluteVorticity(:,1:nEdgesSolve), sums_tmp(variableIndex), sumSquares_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
- verticalSumMaxes_tmp(variableIndex))
+ call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nEdgesSolve, &
+ maxLevelEdgeTop(1:nEdgesSolve), areaEdge(1:nEdgesSolve), &
+ layerThicknessEdge(:,1:nEdgesSolve), &
+ normalizedAbsoluteVorticity(:,1:nEdgesSolve), &
+ sums_tmp(variableIndex), sumSquares_tmp(variableIndex), &
+ mins_tmp(variableIndex), maxes_tmp(variableIndex), &
+ verticalSumMins_tmp(variableIndex), &
+ verticalSumMaxes_tmp(variableIndex))
deallocate(normalizedAbsoluteVorticity)
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
sumSquares(variableIndex) = sumSquares(variableIndex) + sumSquares_tmp(variableIndex)
@@ -432,9 +492,13 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
! pressure
variableIndex = variableIndex + 1
- call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), layerThickness(:,1:nCellsSolve), &
- pressure(:,1:nCellsSolve), sums_tmp(variableIndex), sumSquares_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
- verticalSumMaxes_tmp(variableIndex))
+ call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, &
+ maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), &
+ layerThickness(:,1:nCellsSolve), pressure(:,1:nCellsSolve), &
+ sums_tmp(variableIndex), sumSquares_tmp(variableIndex), &
+ mins_tmp(variableIndex), maxes_tmp(variableIndex), &
+ verticalSumMins_tmp(variableIndex), &
+ verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
sumSquares(variableIndex) = sumSquares(variableIndex) + sumSquares_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -444,9 +508,14 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
! montgomeryPotential
variableIndex = variableIndex + 1
- call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), layerThickness(:,1:nCellsSolve), &
- montgomeryPotential(:,1:nCellsSolve), sums_tmp(variableIndex), sumSquares_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
- verticalSumMaxes_tmp(variableIndex))
+ call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, &
+ maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), &
+ layerThickness(:,1:nCellsSolve), &
+ montgomeryPotential(:,1:nCellsSolve), &
+ sums_tmp(variableIndex), sumSquares_tmp(variableIndex), &
+ mins_tmp(variableIndex), maxes_tmp(variableIndex), &
+ verticalSumMins_tmp(variableIndex), &
+ verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
sumSquares(variableIndex) = sumSquares(variableIndex) + sumSquares_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -457,9 +526,13 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
! vertVelocityTop vertical velocity
variableIndex = variableIndex + 1
workArray = vertVelocityTop(1:nVertLevels,1:nCellsSolve)
- call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), layerThickness(:,1:nCellsSolve), &
- workArray, sums_tmp(variableIndex), sumSquares_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
- verticalSumMaxes_tmp(variableIndex))
+ call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, &
+ maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), &
+ layerThickness(:,1:nCellsSolve), workArray, &
+ sums_tmp(variableIndex), sumSquares_tmp(variableIndex), &
+ mins_tmp(variableIndex), maxes_tmp(variableIndex), &
+ verticalSumMins_tmp(variableIndex), &
+ verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
sumSquares(variableIndex) = sumSquares(variableIndex) + sumSquares_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -470,9 +543,13 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
! vertAleTransportTop vertical velocity
variableIndex = variableIndex + 1
workArray = vertAleTransportTop(1:nVertLevels,1:nCellsSolve)
- call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), layerThickness(:,1:nCellsSolve), &
- workArray, sums_tmp(variableIndex), sumSquares_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
- verticalSumMaxes_tmp(variableIndex))
+ call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, &
+ maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), &
+ layerThickness(:,1:nCellsSolve), workArray, &
+ sums_tmp(variableIndex), sumSquares_tmp(variableIndex), &
+ mins_tmp(variableIndex), maxes_tmp(variableIndex), &
+ verticalSumMins_tmp(variableIndex), &
+ verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
sumSquares(variableIndex) = sumSquares(variableIndex) + sumSquares_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -483,9 +560,14 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
! lowFreqDivergence
variableIndex = variableIndex + 1
if (thicknessFilterActive) then
- call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), layerThickness(:,1:nCellsSolve), &
- lowFreqDivergence(:,1:nCellsSolve), sums_tmp(variableIndex), sumSquares_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
- verticalSumMaxes_tmp(variableIndex))
+ call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, &
+ maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), &
+ layerThickness(:,1:nCellsSolve), &
+ lowFreqDivergence(:,1:nCellsSolve), &
+ sums_tmp(variableIndex), sumSquares_tmp(variableIndex), &
+ mins_tmp(variableIndex), maxes_tmp(variableIndex), &
+ verticalSumMins_tmp(variableIndex), &
+ verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
sumSquares(variableIndex) = sumSquares(variableIndex) + sumSquares_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -497,9 +579,14 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
! highFreqThickness
variableIndex = variableIndex + 1
if (thicknessFilterActive) then
- call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), layerThickness(:,1:nCellsSolve), &
- highFreqThickness(:,1:nCellsSolve), sums_tmp(variableIndex), sumSquares_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
- verticalSumMaxes_tmp(variableIndex))
+ call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, &
+ maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), &
+ layerThickness(:,1:nCellsSolve), &
+ highFreqThickness(:,1:nCellsSolve), &
+ sums_tmp(variableIndex), sumSquares_tmp(variableIndex), &
+ mins_tmp(variableIndex), maxes_tmp(variableIndex), &
+ verticalSumMins_tmp(variableIndex), &
+ verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
sumSquares(variableIndex) = sumSquares(variableIndex) + sumSquares_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -508,13 +595,17 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
verticalSumMaxes(variableIndex) = max(verticalSumMaxes(variableIndex), verticalSumMaxes_tmp(variableIndex))
end if
- ! Tracers
- do iTracer=1,num_tracers
+ ! active Tracers
+ do iTracer=1,num_activeTracers
variableIndex = variableIndex + 1
- workArray = Tracers(iTracer,:,1:nCellsSolve)
- call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), layerThickness(:,1:nCellsSolve), &
- workArray, sums_tmp(variableIndex), sumSquares_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
- verticalSumMaxes_tmp(variableIndex))
+ workArray = activeTracers(iTracer,:,1:nCellsSolve)
+ call ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nCellsSolve, &
+ maxLevelCell(1:nCellsSolve), areaCell(1:nCellsSolve), &
+ layerThickness(:,1:nCellsSolve), workArray, &
+ sums_tmp(variableIndex), sumSquares_tmp(variableIndex), &
+ mins_tmp(variableIndex), maxes_tmp(variableIndex), &
+ verticalSumMins_tmp(variableIndex), &
+ verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
sumSquares(variableIndex) = sumSquares(variableIndex) + sumSquares_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -547,14 +638,12 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
nSums = nSums + 1
sums(nSums) = sums(nSums) + nVerticesSolve
- localCFL = 0.0
- do elementIndex = 1,nEdgesSolve
- ! note: dt not connected. dt will not be available in post processing mode.
- !localCFL = max(localCFL, maxval(dt*normalVelocity(:,elementIndex)/dcEdge(elementIndex)))
+ localCFL = 0.0_RKIND
+ do iEdge = 1,nEdgesSolve
+ localCFL = max(localCFL, maxval(dt*abs(normalVelocity(1:maxLevelEdgeTop(iEdge),iEdge))/dcEdge(iEdge)))
end do
nMaxes = nMaxes + 1
maxes(nMaxes) = localCFL
-
do i = 1, nVariables
mins(nMins+i) = min(mins(nMins+i),verticalSumMins_tmp(i))
maxes(nMaxes+i) = max(maxes(nMaxes+i),verticalSumMaxes_tmp(i))
@@ -595,11 +684,6 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
! compute the averages (slightly different depending on how the sum was computed)
variableIndex = 0
- ! time, in days, using a 360 day calendar
- read (xtime, '(i4,10(a1,i2))') timeYYYY, timeChar, timeMM, timeChar, timeDD, timeChar, timeH, timeChar, timeM, timeChar, timeS
- ! subtract 31.0 because calendar starts on 00-01-01
- time_days = timeYYYY*360.0 + timeMM*30.0 + timeDD + (timeH + (timeM + timeS/60.0)/60.0)/24.0 - 31.0
-
! layerThickness
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/(areaCellGlobal*nVertLevels)
@@ -682,8 +766,8 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
rms(variableIndex) = 0.0_RKIND
end if
- ! Tracers
- do iTracer=1,num_tracers
+ ! active tracers
+ do iTracer=1,num_activeTracers
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
rms(variableIndex) = sqrt(sumSquares(variableIndex)/volumeCellGlobal)
@@ -704,22 +788,22 @@ subroutine ocn_compute_global_stats(domain, timeLevel, err)!{{{
if (dminfo % my_proc_id == IO_NODE) then
fileID = getFreeUnit()
open(fileID,file=trim(config_AM_globalStats_directory)//'/stats_min.txt',STATUS='UNKNOWN', POSITION='append')
- write (fileID,'(100es24.14)') time_days, mins(1:nVariables)
+ write (fileID,'(100es24.14)') daysSinceStartOfSim, mins(1:nVariables)
close (fileID)
open(fileID,file=trim(config_AM_globalStats_directory)//'/stats_max.txt',STATUS='UNKNOWN', POSITION='append')
- write (fileID,'(100es24.14)') time_days, maxes(1:nVariables)
+ write (fileID,'(100es24.14)') daysSinceStartOfSim, maxes(1:nVariables)
close (fileID)
open(fileID,file=trim(config_AM_globalStats_directory)//'/stats_sum.txt',STATUS='UNKNOWN', POSITION='append')
- write (fileID,'(100es24.14)') time_days, sums(1:nVariables)
+ write (fileID,'(100es24.14)') daysSinceStartOfSim, sums(1:nVariables)
close (fileID)
open(fileID,file=trim(config_AM_globalStats_directory)//'/stats_rms.txt',STATUS='UNKNOWN', POSITION='append')
- write (fileID,'(100es24.14)') time_days, rms(1:nVariables)
+ write (fileID,'(100es24.14)') daysSinceStartOfSim, rms(1:nVariables)
close (fileID)
open(fileID,file=trim(config_AM_globalStats_directory)//'/stats_avg.txt',STATUS='UNKNOWN', POSITION='append')
- write (fileID,'(100es24.14)') time_days, averages(1:nVariables)
+ write (fileID,'(100es24.14)') daysSinceStartOfSim, averages(1:nVariables)
close (fileID)
open(fileID,file=trim(config_AM_globalStats_directory)//'/stats_time.txt',STATUS='UNKNOWN', POSITION='append')
- write (fileID,'(a)') trim(xtime)
+ write (fileID,'(a,2es24.14)') trim(xtime), daysSinceStartOfSim, CFLNumberGlobal
close (fileID)
open(fileID,file=trim(config_AM_globalStats_directory)//'/stats_colmin.txt',STATUS='UNKNOWN', POSITION='append')
write (fileID,'(100es24.14)') verticalSumMins(1:nVariables)
@@ -843,12 +927,12 @@ subroutine ocn_compute_field_area_weighted_local_stats_max_level(dminfo, nVertLe
integer :: elementIndex
real (kind=RKIND) :: colSum, colRMS, colSumAbs
- localSum = 0.0
- localRMS = 0.0
- localMin = 1.0e34
- localMax = -1.0e34
- localVertSumMin = 1.0e34
- localVertSumMax = -1.0e34
+ localSum = 0.0_RKIND
+ localRMS = 0.0_RKIND
+ localMin = 1.0e34_RKIND
+ localMax = -1.0e34_RKIND
+ localVertSumMin = 1.0e34_RKIND
+ localVertSumMax = -1.0e34_RKIND
do elementIndex = 1, nElements
colSum = sum(field(1:maxLevel(elementIndex),elementIndex))
@@ -863,8 +947,9 @@ subroutine ocn_compute_field_area_weighted_local_stats_max_level(dminfo, nVertLe
end subroutine ocn_compute_field_area_weighted_local_stats_max_level!}}}
- subroutine ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nElements, maxLevel, areas, layerThickness, field, &!{{{
- localSum, localRMS, localMin, localMax, localVertSumMin, localVertSumMax)
+ subroutine ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVertLevels, nElements, maxLevel, areas, & !{{{
+ layerThickness, field, localSum, localRMS, localMin, &
+ localMax, localVertSumMin, localVertSumMax)
implicit none
@@ -881,17 +966,19 @@ subroutine ocn_compute_field_volume_weighted_local_stats_max_level(dminfo, nVert
real (kind=RKIND) :: thicknessWeightedColSum, thicknessWeightedColRMS, thicknessWeightedColSumAbs
real (kind=RKIND), dimension(nVertLevels, nElements) :: hTimesField
- localSum = 0.0
- localRMS = 0.0
- localMin = 1.0e34
- localMax = -1.0e34
- localVertSumMin = 1.0e34
- localVertSumMax = -1.0e34
+ localSum = 0.0_RKIND
+ localRMS = 0.0_RKIND
+ localMin = 1.0e34_RKIND
+ localMax = -1.0e34_RKIND
+ localVertSumMin = 1.0e34_RKIND
+ localVertSumMax = -1.0e34_RKIND
do elementIndex = 1, nElements
- thicknessWeightedColSum = sum(layerThickness(1:maxLevel(elementIndex),elementIndex)*field(1:maxLevel(elementIndex),elementIndex))
+ thicknessWeightedColSum = sum(layerThickness(1:maxLevel(elementIndex),elementIndex) &
+ * field(1:maxLevel(elementIndex),elementIndex))
localSum = localSum + areas(elementIndex) * thicknessWeightedColSum
- thicknessWeightedColRMS = sum(layerThickness(1:maxLevel(elementIndex),elementIndex)*field(1:maxLevel(elementIndex),elementIndex)**2)
+ thicknessWeightedColRMS = sum(layerThickness(1:maxLevel(elementIndex),elementIndex) &
+ * field(1:maxLevel(elementIndex),elementIndex)**2)
localRMS = localRMS + areas(elementIndex) * thicknessWeightedColRMS
localMin = min(localMin,minval(field(1:maxLevel(elementIndex),elementIndex)))
localMax = max(localMax,maxval(field(1:maxLevel(elementIndex),elementIndex)))
diff --git a/src/core_ocean/analysis_members/mpas_ocn_high_frequency_output.F b/src/core_ocean/analysis_members/mpas_ocn_high_frequency_output.F
index 38e3675394..a95fbed662 100644
--- a/src/core_ocean/analysis_members/mpas_ocn_high_frequency_output.F
+++ b/src/core_ocean/analysis_members/mpas_ocn_high_frequency_output.F
@@ -158,12 +158,25 @@ subroutine ocn_compute_high_frequency_output(domain, timeLevel, err)!{{{
type (mpas_pool_type), pointer :: diagnosticsPool
type (mpas_pool_type), pointer :: forcingPool
type (mpas_pool_type), pointer :: highFrequencyOutputAMPool
+ type (mpas_pool_type), pointer :: tracersPool
+ type (mpas_pool_type), pointer :: scratchPool
- integer :: iLevel, iLevelTarget
- integer, pointer :: nVertLevels
+ integer :: iLevel, iLevelTarget, iCell, iEdge, i, cell1, cell2, k
+ integer, pointer :: nVertLevels, nCells, nEdges
+ integer, dimension(:), pointer :: nEdgesOnCell, maxLevelEdgeTop, maxLevelCell
+ integer, dimension(:,:), pointer :: edgesOnCell, cellsOnEdge
+
+ real (kind=RKIND) :: invAreaCell1, layerThicknessEdge1, coeff
real (kind=RKIND), dimension(:), pointer :: refBottomDepth, kineticEnergyAt100m, relativeVorticityAt100m
- real (kind=RKIND), dimension(:,:), pointer :: kineticEnergyCell, relativeVorticityCell, tracersAtSurface
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+ real (kind=RKIND), dimension(:), pointer :: divergenceAt100m, relativeVorticityVertexAt100m
+ real (kind=RKIND), dimension(:), pointer :: barotropicSpeed, columnIntegratedSpeed, dvEdge, dcEdge, areaCell
+ real (kind=RKIND), dimension(:,:), pointer :: kineticEnergyCell, relativeVorticityCell, activeTracersAtSurface
+ real (kind=RKIND), dimension(:,:), pointer :: relativeVorticity, divergence, layerThickness, normalVelocity
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
+
+ ! scratch space
+ type (field1DReal), pointer :: normalThicknessFluxSumField, layerThicknessSumEdgeField
+ real (kind=RKIND), dimension(:), pointer :: normalThicknessFluxSum, layerThicknessSumEdge
err = 0
@@ -172,6 +185,8 @@ subroutine ocn_compute_high_frequency_output(domain, timeLevel, err)!{{{
block => domain % blocklist
do while (associated(block))
! get dimensions
+ call mpas_pool_get_dimension(block % dimensions, 'nCells', nCells)
+ call mpas_pool_get_dimension(block % dimensions, 'nEdges', nEdges)
call mpas_pool_get_dimension(block % dimensions, 'nVertLevels', nVertLevels)
! get pointers to pools
@@ -179,6 +194,8 @@ subroutine ocn_compute_high_frequency_output(domain, timeLevel, err)!{{{
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
call mpas_pool_get_subpool(domain % blocklist % structs, 'highFrequencyOutputAM', highFrequencyOutputAMPool)
! get static data from mesh pool
@@ -187,12 +204,16 @@ subroutine ocn_compute_high_frequency_output(domain, timeLevel, err)!{{{
! get arrays that will be 'sliced' and put into high frequency output
call mpas_pool_get_array(diagnosticsPool, 'kineticEnergyCell', kineticEnergyCell, timeLevel)
call mpas_pool_get_array(diagnosticsPool, 'relativeVorticityCell', relativeVorticityCell, timeLevel)
- call mpas_pool_get_array(statePool, 'tracers', tracers, timeLevel)
+ call mpas_pool_get_array(diagnosticsPool, 'relativeVorticity', relativeVorticity, timeLevel)
+ call mpas_pool_get_array(diagnosticsPool, 'divergence', divergence, timeLevel)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, timeLevel)
! get arrays that can be written to output at high freqency
call mpas_pool_get_array(highFrequencyOutputAMPool, 'kineticEnergyAt100m', kineticEnergyAt100m)
call mpas_pool_get_array(highFrequencyOutputAMPool, 'relativeVorticityAt100m', relativeVorticityAt100m)
- call mpas_pool_get_array(highFrequencyOutputAMPool, 'tracersAtSurface', tracersAtSurface)
+ call mpas_pool_get_array(highFrequencyOutputAMPool, 'activeTracersAtSurface', activeTracersAtSurface)
+ call mpas_pool_get_array(highFrequencyOutputAMPool, 'divergenceAt100m', divergenceAt100m)
+ call mpas_pool_get_array(highFrequencyOutputAMPool, 'relativeVorticityVertexAt100m', relativeVorticityVertexAt100m)
!
! note for future build out
@@ -212,8 +233,77 @@ subroutine ocn_compute_high_frequency_output(domain, timeLevel, err)!{{{
! tracer data will be converted to new tracer infrastrcture (and this line removed) before June 23 2015.
kineticEnergyAt100m(:) = kineticEnergyCell(iLevelTarget,:)
relativeVorticityAt100m(:) = relativeVorticityCell(iLevelTarget,:)
- tracersAtSurface(1,:) = tracers(1,1,:)
- tracersAtSurface(2,:) = tracers(2,1,:)
+ divergenceAt100m(:) = divergence(iLevelTarget,:)
+ relativeVorticityVertexAt100m = relativeVorticity(iLevelTarget,:)
+ activeTracersAtSurface(1,:) = activeTracers(1,1,:)
+ activeTracersAtSurface(2,:) = activeTracers(2,1,:)
+
+ !
+ ! compute barotropic kinetic energy
+ !
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+ call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, 1)
+ call mpas_pool_get_array(meshPool, 'maxLevelEdgeTop', maxLevelEdgeTop)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell)
+ call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell)
+ call mpas_pool_get_array(meshPool, 'areaCell', areaCell)
+ call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge)
+ call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
+ call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
+ call mpas_pool_get_array(highFrequencyOutputAMPool, 'barotropicSpeed', barotropicSpeed)
+ call mpas_pool_get_array(highFrequencyOutputAMPool, 'columnIntegratedSpeed', columnIntegratedSpeed)
+
+ ! scratch arrays
+ call mpas_pool_get_field(scratchPool, 'normalThicknessFluxSum', normalThicknessFluxSumField)
+ call mpas_allocate_scratch_field(normalThicknessFluxSumField, .true.)
+ normalThicknessFluxSum => normalThicknessFluxSumField % array
+
+ call mpas_pool_get_field(scratchPool, 'layerThicknessSumEdge', layerThicknessSumEdgeField)
+ call mpas_allocate_scratch_field(layerThicknessSumEdgeField, .true.)
+ layerThicknessSumEdge => layerThicknessSumEdgeField % array
+
+ do iEdge = 1, nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+
+ ! normal Barotropic Velocity = sum(h*u)/sum(h) on each edge
+ layerThicknessEdge1 = 0.5_RKIND*( layerThickness(1,cell1) + layerThickness(1,cell2) )
+ normalThicknessFluxSum(iEdge) = layerThicknessEdge1 * normalVelocity(1,iEdge)
+ layerThicknessSumEdge(iEdge) = layerThicknessEdge1
+
+ do k=2, maxLevelEdgeTop(iEdge)
+ layerThicknessEdge1 = 0.5_RKIND*( layerThickness(k,cell1) + layerThickness(k,cell2) )
+
+ normalThicknessFluxSum(iEdge) = normalThicknessFluxSum(iEdge) + layerThicknessEdge1 * normalVelocity(k,iEdge)
+ layerThicknessSumEdge(iEdge) = layerThicknessSumEdge(iEdge) + layerThicknessEdge1
+ enddo
+ enddo
+
+ do iCell = 1, nCells
+ invAreaCell1 = 1.0_RKIND / areaCell(iCell)
+ barotropicSpeed(iCell) = 0.0_RKIND
+ !columnIntegratedSpeed(iCell) = 0.0_RKIND
+ do i = 1, nEdgesOnCell(iCell)
+ iEdge = edgesOnCell(i, iCell)
+
+ coeff = 0.25_RKIND * dcEdge(iEdge) * dvEdge(iEdge) * invAreaCell1
+ ! this is kinetic energy, in units of m^2/sec^2
+ barotropicSpeed(iCell) = barotropicSpeed(iCell) &
+ + coeff * (normalThicknessFluxSum(iEdge) / layerThicknessSumEdge(iEdge))**2
+
+ end do
+ barotropicSpeed(iCell) = sqrt(2.0_RKIND*barotropicSpeed(iCell))
+
+ ! columnIntegratedSpeed = sum(h*sqrt(2*ke)), where ke is kineticEnergyCell
+ ! and the sum is over the full column at cell centers.
+ columnIntegratedSpeed(iCell) = layerThickness(1,iCell)*sqrt( 2.0_RKIND * kineticEnergyCell(1,iCell) )
+ do k=2, maxLevelCell(iCell)
+ columnIntegratedSpeed(iCell) = columnIntegratedSpeed(iCell) &
+ + layerThickness(k,iCell)*sqrt( 2.0_RKIND * kineticEnergyCell(k,iCell) )
+ enddo
+
+ end do
block => block % next
end do
diff --git a/src/core_ocean/analysis_members/mpas_ocn_lagrangian_particle_tracking.F b/src/core_ocean/analysis_members/mpas_ocn_lagrangian_particle_tracking.F
new file mode 100644
index 0000000000..5279c33a6f
--- /dev/null
+++ b/src/core_ocean/analysis_members/mpas_ocn_lagrangian_particle_tracking.F
@@ -0,0 +1,2796 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_lagrangian_particle_tracking
+!
+!> \brief MPAS ocean analysis mode member: lagrangian_particle_tracking
+!> \author Phillip J. Wolfram
+!> \date 02/20/14 and 07/23/2015
+!> \details
+!> MPAS ocean analysis core member: lagrangian particle tracking
+!> module computes Lagrangian particle trajectories and associated
+!> diagnostics
+!-----------------------------------------------------------------------
+#define COMMA ,
+#define LIGHT_DEBUG_WRITE(M) ! write(stderrUnit,*) M
+#define LIGHT_DEBUG_ALL_WRITE(M) ! write(stderrUnit,*) M
+#define LIGHT_WARNING_WRITE(M) write(stderrUnit,*) 'WARNING: '//M
+#define LIGHT_ERROR_WRITE(M) write(stderrUnit,*) 'ERROR: '//M
+
+module ocn_lagrangian_particle_tracking
+
+ use mpas_timer
+ use mpas_dmpar
+ use mpas_timekeeping
+ use mpas_stream_manager
+
+ use ocn_constants
+
+ use ocn_particle_list
+ use ocn_lagrangian_particle_tracking_interpolations
+ use ocn_lagrangian_particle_tracking_reset
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_lagrangian_particle_tracking, &
+ ocn_compute_lagrangian_particle_tracking, &
+ ocn_restart_lagrangian_particle_tracking, &
+ ocn_finalize_lagrangian_particle_tracking
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ ! neighboring processors and arrays for send numbers / recvs, total number of neighboring processors to a particular processor
+ ! allocated in init, deallocated in finalize
+ ! these globals could be moved to the framework component, as well
+ ! as quite a few of the subroutines
+ integer, dimension(:), pointer :: g_compProcNeighsNearby => null(), g_compProcNeighs => null(), g_ioProcNeighs=>null()
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_lagrangian_particle_tracking
+!
+!> \brief Initialize MPAS-Ocean analysis member
+!> \author Phillip J. Wolfram
+!> \date 02/20/14
+!> \details
+!> This routine conducts all initializations required for the
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_lagrangian_particle_tracking(domain, err)!{{{
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+ logical :: config_AM_lagrPartTrack_reset_particles
+ character (len=StrKIND), pointer :: config_AM_lagrPartTrack_reset_criteria
+
+ err = 0
+
+ LIGHT_DEBUG_WRITE('starting ocn_init_lagrangian_particle_tracking')
+ call mpas_timer_start("totalLPT")
+ call mpas_timer_start("initLPT")
+
+ ! resets likely are unnecessary
+ !call mpas_stream_mgr_reset_alarms(stream_manager, streamID='lagrPartTrackInput', ierr=err)
+ !call mpas_stream_mgr_reset_alarms(stream_manager, streamID='lagrPartTrackRestart', ierr=err)
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! init
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ ! build up the particles lists and fill them with their data
+ call mpas_particle_list_build_and_assign_particle_list(domain, err)
+ ! now we have built the particlelist for a given block
+ LIGHT_DEBUG_WRITE('finished building and allocating particles in init')
+
+ ! parallel code:
+
+ ! get "MPI halos" for communication of particles in halo during computational step
+ call mpas_particle_list_build_computation_halos(domain, err, g_compProcNeighsNearby)
+ LIGHT_DEBUG_WRITE('finished building and computational halos')
+
+ ! get "MPI halos" for IO communication during write and restart steps (ioBlock to currentBlocks)
+ ! AllToAll Computation!
+ call mpas_particle_list_build_halos(domain, err, 'currentBlock', g_ioProcNeighs)
+ LIGHT_DEBUG_WRITE('g_ioProcNeighs=' COMMA g_ioProcNeighs)
+ LIGHT_DEBUG_WRITE('finished building io halos')
+
+ ! transfer particles to their appropriate blocks (currentBlock) via MPI
+ ! note, don't necessarily need to have g_ionSend and g_ionRecv comeout
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("trans_from_block_to_blockLPT")
+ call mpas_particle_list_test_numparticles_to_neighprocs(domain % dminfo % my_proc_id, g_compProcNeighsNearby, g_ioProcNeighs)
+#endif
+ ! move particles to the 'currentBlock'
+ call mpas_particle_list_transfer_particles_from_block_to_named_block(domain, err, .True., .False., 'currentBlock', &
+ g_ioProcNeighs)
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("trans_from_block_to_blockLPT")
+ !call MPI_Barrier(domain % dminfo % comm, err)
+#endif
+
+ ! tests to make sure all the values are ok !{{{
+#ifdef MPAS_DEBUG
+ call mpas_particle_list_test_neighscalc(domain, err)
+ call mpas_particle_list_test_numparticles_to_neighprocs(domain % dminfo % my_proc_id, g_compProcNeighsNearby, g_ioProcNeighs)
+ call mpas_particle_list_test_num_current_particlelist(domain)
+#endif
+ LIGHT_DEBUG_WRITE('g_compProcNeighsNearby = ' COMMA g_compProcNeighsNearby)
+ !}}}
+
+ ! now set sums for autocorrelation calculation to be zero
+ call zero_autocorrelation_sums(domain)
+
+ ! previous compute startup calls
+ call intialize_wachspress_coefficients(domain, err)
+ call initalize_fields(domain, err)
+ call compute_velocity_on_potentialdensity_surface(domain,err,1)
+ call compute_velocity_on_potentialdensity_surface(domain,err,2)
+ call initialize_particle_properties(domain,2,err)
+ call write_lagrangian_particle_tracking(domain, err)
+
+ ! set up particle reset condition
+ call ocn_setup_particle_reset_condition(domain, err)
+
+ LIGHT_DEBUG_WRITE('finished ocn_init_lagrangian_particle_tracking')
+ call mpas_timer_stop("initLPT")
+
+ call mpas_timer_stop("totalLPT")
+
+ end subroutine ocn_init_lagrangian_particle_tracking!}}}
+
+
+!***********************************************************************
+!
+! routine ocn_compute_lagrangian_particle_tracking
+!
+!> \brief Compute MPAS-Ocean analysis member
+!> \author Phillip J. Wolfram
+!> \date 02/20/14
+!> \details
+!> This routine conducts all computation required for this
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_compute_lagrangian_particle_tracking(domain, timeLevel, err)!{{{
+
+ implicit none
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(in) :: timeLevel
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ type (dm_info) :: dminfo
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: scratchPool
+ type (mpas_pool_type), pointer :: diagnosticsPool
+ type (mpas_pool_type), pointer :: lagrPartTrackFieldsPool, lagrPartTrackCellsPool, lagrPartTrackScratchPool
+ integer, dimension(:), pointer :: cellOwnerBlock
+ integer, pointer :: currentBlock, ioBlock, indexToParticleID, transfered
+ type (mpas_particle_list_type), pointer :: particlelist
+ type (mpas_particle_type), pointer :: particle
+
+ real (kind=RKIND), dimension(3) :: particlePosition, particleVelocity
+ real (kind=RKIND), pointer :: xParticle, yParticle, zParticle, lonVel, latVel, buoyancyParticle, sumU, sumV, sumUU, &
+ sumUV, sumVV
+ real (kind=RKIND), dimension(3) :: xSubStep, diffSubStep, diffParticlePosition
+ real (kind=RKIND), pointer :: zLevelParticle
+ real (kind=RKIND), dimension(:,:), pointer :: zTop, vertVelocityTop, zMid, areaBArray
+ real (kind=RKIND), dimension(:), pointer :: bottomDepth
+ type (field2DReal), pointer :: normalVelocity, uVertexVelocity, vVertexVelocity, wVertexVelocity, layerThickness
+
+ real (kind=RKIND), dimension(:,:), pointer :: uVertexVelocityArray, vVertexVelocityArray, wVertexVelocityArray, &
+ buoyancyTimeInterp, potentialDensity
+
+ real(kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell
+ real(kind=RKIND), dimension(:), pointer :: xVertex, yVertex, zVertex
+
+ integer, dimension(:,:), pointer :: verticesOnCell, boundaryVertex
+ integer, dimension(:), pointer :: maxLevelCell
+
+ integer theVertex, iLevel, iLevelBuoyancy, aVertex, &
+ nSteps, timeStep, subStep, subStepOrder, timeInterpOrder, aTimeLevel, nCellVertices, blockProc, arrayIndex
+ integer, pointer :: nCells, nVertLevels, iCell
+ integer, dimension(:), pointer :: nCellVerticesArray
+ integer, dimension(:,:), pointer :: cellsOnCell
+ logical, pointer :: onSphere
+ logical :: config_AM_lagrPartTrack_reset_particles
+ character (len=StrKIND), pointer :: config_AM_lagrPartTrack_reset_criteria
+
+ real (kind=RKIND), dimension(4) :: kWeightK, kWeightKVert
+ real (kind=RKIND), dimension(3,4) :: kWeightX
+ real (kind=RKIND), dimension(4) :: kWeightXVert
+ real (kind=RKIND), dimension(4) :: kWeightT, kWeightTVert
+ real (kind=RKIND), dimension(3,5) :: kCoeff
+ real (kind=RKIND), dimension(5) :: kCoeffVert
+ real (kind=RKIND), dimension(2) :: timeCoeff
+ real (kind=RKIND) :: dt, dtSim, tSubStep
+ real (kind=RKIND), pointer :: dtParticle
+ real (kind=RKIND) :: zSubStep
+ real (kind=RKIND) :: diffSubStepVert, diffParticlePositionVert, particleVelocityVert, verticalVelocityInterp
+ real (kind=RKIND) :: buoyancyInterp
+ real (kind=RKIND), pointer :: sphereRadius
+ integer, pointer :: verticalTreatment, vertexReconstMethod, timeIntegration, indexLevel, filterNum
+ character(len=StrKIND), pointer :: config_dt
+ type (MPAS_timeInterval_type) :: timeStepESMF
+ logical :: resetParticle, resetParticleAny
+ integer :: err_tmp
+
+ err = 0
+
+ !! don't do compute for debugging purposes
+ !write(stderrUnit,*) 'Computing Lagrangian Particle Tracking -- NO COMPUTATION!'
+ !return
+
+ dminfo = domain % dminfo
+
+ LIGHT_DEBUG_WRITE('Computing Lagrangian Particle Tracking...')
+ call mpas_timer_start("totalLPT")
+ call mpas_timer_start("computeLPT")
+
+ call mpas_pool_get_config(ocnConfigs, 'config_AM_lagrPartTrack_filter_number', filterNum)
+ call mpas_pool_get_config(ocnConfigs, 'config_AM_lagrPartTrack_reset_criteria', config_AM_lagrPartTrack_reset_criteria)
+
+ if (trim(config_AM_lagrPartTrack_reset_criteria) == 'none') then
+ config_AM_lagrPartTrack_reset_particles = .False.
+ else
+ config_AM_lagrPartTrack_reset_particles = .True.
+ end if
+
+ ! get the most recent velocities on the potential density surfaces
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("velocity_pot_density_LPT")
+#endif
+ call compute_velocity_on_potentialdensity_surface(domain,err,2)
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("velocity_pot_density_LPT")
+#endif
+
+ resetParticleAny = .False.
+
+ block => domain % blocklist
+ do while (associated(block)) !{{{
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("memtasksLPT")
+#endif
+ ! allocate scratch memory / setup pointers / get block !{{{
+ call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
+ call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackFields', lagrPartTrackFieldsPool)
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackScratch', lagrPartTrackScratchPool)
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackCells', lagrPartTrackCellsPool)
+
+ ! particlelist should be stored in the structs pool probably (need to seriously rework the code!)
+ particlelist => block % particlelist
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'zCell', zCell)
+ call mpas_pool_get_array(meshPool, 'xVertex', xVertex)
+ call mpas_pool_get_array(meshPool, 'yVertex', yVertex)
+ call mpas_pool_get_array(meshPool, 'zVertex', zVertex)
+ call mpas_pool_get_array(lagrPartTrackCellsPool, 'wachspressAreaB', areaBArray)
+ call mpas_pool_get_array(diagnosticsPool, 'zTop', zTop)
+ call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
+ call mpas_pool_get_array(diagnosticsPool, 'vertVelocityTop', vertVelocityTop)
+ call mpas_pool_get_array(diagnosticsPool, 'potentialDensity', buoyancyTimeInterp)
+
+ ! note, originally this was diagnostics % state % normalVelocity (without time level), but
+ ! now there is a time level so selection of the correct time level appears to be tricky
+ ! the issue is large, nearly NAN normalVelocities with timeLevel=2
+ call mpas_pool_get_field(statePool, 'normalVelocity', normalVelocity, timeLevel=timeLevel)
+ ! potentially a costly function call, but ensures halos are ok
+ !call mpas_dmpar_exch_halo_field(normalVelocity)
+ call mpas_pool_get_field(statePool, 'layerThickness', layerThickness, timeLevel=timeLevel)
+
+ call mpas_pool_get_array(meshPool, 'verticesOnCell', verticesOnCell)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'boundaryVertex', boundaryVertex)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nCellVerticesArray)
+ call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell)
+
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', onSphere)
+ call mpas_pool_get_config(meshPool, 'sphere_radius', sphereRadius)
+ call mpas_pool_get_config(block % configs, 'config_dt', config_dt)
+ call mpas_set_timeInterval(timeStepESMF, timeString=config_dt, ierr=err)
+ !}}}
+
+ !{{{
+ ! flip previous time level to back (switching memory pointers)
+ call mpas_pool_shift_time_levels(lagrPartTrackFieldsPool)
+ call mpas_pool_get_field(lagrPartTrackFieldsPool, 'uVertexVelocity', uVertexVelocity, timeLevel=2)
+ call mpas_pool_get_field(lagrPartTrackFieldsPool, 'vVertexVelocity', vVertexVelocity, timeLevel=2)
+ call mpas_pool_get_field(lagrPartTrackFieldsPool, 'wVertexVelocity', wVertexVelocity, timeLevel=2)
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("memtasksLPT")
+#endif
+
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("reconst_filter_LPT")
+#endif
+ ! need to handle periodicity within functions below for vertex reconstruction
+ call ocn_vertex_reconstruction(filterNum, meshPool, lagrPartTrackScratchPool, lagrPartTrackCellsPool, &
+ layerThickness % array, normalVelocity % array, &
+ uVertexVelocity, vVertexVelocity, wVertexVelocity)
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("reconst_filter_LPT")
+ LIGHT_DEBUG_ALL_WRITE('uVertexVelocity=' COMMA uVertexVelocity % array)
+ LIGHT_DEBUG_ALL_WRITE('vVertexVelocity=' COMMA vVertexVelocity % array)
+ LIGHT_DEBUG_ALL_WRITE('wVertexVelocity=' COMMA wVertexVelocity % array)
+#endif
+ !}}}
+
+ LIGHT_DEBUG_WRITE('beginning particle loop with particlelist associated = ' COMMA associated(particlelist))
+#ifdef MPAS_DEBUG
+ call mpas_particle_list_test_num_current_particlelist(domain)
+#endif
+
+ !!!!!!!!!! LOOP OVER PARTICLES !!!!!!!!!!
+ ! update the particle position (just from initialized value for now)
+ ! this is a loop over particle list and its datastructures
+ do while(associated(particlelist)) !{{{
+ ! get pointers / option values
+ particle => particlelist % particle
+
+ ! get values {{{
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("memtasksLPT")
+#endif
+ call mpas_pool_get_array(particle % haloDataPool, 'xParticle', xParticle)
+ call mpas_pool_get_array(particle % haloDataPool, 'yParticle', yParticle)
+ call mpas_pool_get_array(particle % haloDataPool, 'zParticle', zParticle)
+ particlePosition(1) = xParticle
+ particlePosition(2) = yParticle
+ particlePosition(3) = zParticle
+
+ call mpas_pool_get_array(particle % haloDataPool, 'zLevelParticle', zLevelParticle)
+
+ call mpas_pool_get_array(particle % haloDataPool, 'verticalTreatment', verticalTreatment)
+ call mpas_pool_get_array(particle % haloDataPool, 'vertexReconstMethod', vertexReconstMethod)
+ call mpas_pool_get_array(particle % haloDataPool, 'indexLevel', indexLevel)
+ call mpas_pool_get_array(particle % haloDataPool, 'timeIntegration', timeIntegration)
+ call mpas_pool_get_array(particle % haloDataPool, 'dtParticle', dtParticle)
+ call mpas_pool_get_array(particle % haloDataPool, 'buoyancyParticle', buoyancyParticle)
+ call mpas_pool_get_array(particle % haloDataPool, 'indexToParticleID', indexToParticleID)
+ call mpas_pool_get_array(particle % haloDataPool, 'currentCell', iCell)
+
+ call mpas_pool_get_array(particle % haloDataPool, 'lonVel', lonVel)
+ call mpas_pool_get_array(particle % haloDataPool, 'latVel', latVel)
+ call mpas_pool_get_array(particle % haloDataPool, 'sumU', sumU)
+ call mpas_pool_get_array(particle % haloDataPool, 'sumV', sumV)
+ call mpas_pool_get_array(particle % haloDataPool, 'sumUU', sumUU)
+ call mpas_pool_get_array(particle % haloDataPool, 'sumUV', sumUV)
+ call mpas_pool_get_array(particle % haloDataPool, 'sumVV', sumVV)
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("memtasksLPT")
+#endif
+ ! process timers / particle reset functions here (need a timer and ability to reset particle to
+ ! some set of initial values for the reset
+ !}}}
+
+ !!!!!!!!!! COMPUTE TIME STEP INFORMATION !!!!!!!!!!
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("time_step_LPT")
+#endif
+ ! would eventually need to correspond to domain dt, but for now this is a
+ ! global constant
+ call mpas_get_timeInterval(timeStepESMF, dt=dtSim)
+ ! adjust time step for consistency with integer number of steps
+ nSteps = ceiling(dtSim/dtParticle)
+ dt = dtSim/nSteps
+
+ !!!!!!!!!! ASSIGN TEMPORAL INTEGRATION COEFFICIENTS !!!!!!!!!!
+ ! kCoeff is (3,subStepOrder+1)
+ ! kWeightX is subStepOrder
+ ! kWeightK is subStepOrder
+ ! kWeightT is subStepOrder
+ select case (timeIntegration) !{{{
+ case(1) ! EE integration
+ kWeightK(1) = 0.0_RKIND
+
+ kWeightT(1) = 0.0_RKIND
+
+ kWeightX(:,1) = 1.0_RKIND
+
+ subStepOrder = 1
+ case(2) ! RK2 integration
+ kWeightK(1) = 0.0_RKIND
+ kWeightK(2) = 0.5_RKIND
+
+ kWeightT(1) = 0.0_RKIND
+ kWeightT(2) = 0.5_RKIND
+
+ kWeightX(:,1) = 0.0_RKIND
+ kWeightX(:,2) = 1.0_RKIND
+
+ subStepOrder = 2
+ case(4) ! RK4 integration
+ kWeightK(1) = 0.0_RKIND
+ kWeightK(2) = 0.5_RKIND
+ kWeightK(3) = 0.5_RKIND
+ kWeightK(4) = 1.0_RKIND
+
+ kWeightT(1) = 0.0_RKIND
+ kWeightT(2) = 0.5_RKIND
+ kWeightT(3) = 0.5_RKIND
+ kWeightT(4) = 1.0_RKIND
+
+ kWeightX(:,1) = 1.0_RKIND/6.0_RKIND
+ kWeightX(:,2) = 1.0_RKIND/3.0_RKIND
+ kWeightX(:,3) = 1.0_RKIND/3.0_RKIND
+ kWeightX(:,4) = 1.0_RKIND/6.0_RKIND
+
+ subStepOrder = 4
+ case default ! RK2 integration
+ kWeightK(1) = 0.0_RKIND
+ kWeightK(2) = 0.5_RKIND
+
+ kWeightT(1) = 0.0_RKIND
+ kWeightT(2) = 0.5_RKIND
+
+ kWeightX(:,1) = 0.0_RKIND
+ kWeightX(:,2) = 1.0_RKIND
+
+ subStepOrder = 2
+ end select !}}}
+
+ ! use same integration coefficients for the vertical
+ kWeightKVert = kWeightK
+ kWeightXVert = kWeightX(1,:)
+ kWeightTVert = kWeightT
+ kCoeffVert = kCoeff(1,:)
+
+ !!!!!!!!!! LOOP OVER TIME STEPS !!!!!!!!!!
+ do timeStep = 1, nSteps !{{{
+ ! kCoeff is (3,subStepOrder+1)
+ kCoeff = 0.0_RKIND
+ kCoeffVert = 0.0_RKIND
+ ! compute first
+ do subStep = 1, subStepOrder !{{{
+
+ !!!!!!!!!! COMPUTE PARTICLE SUBSTEP POSITIONS USE FOR VELOCITY !!!!!!!!!!
+ ! horizontal
+ xSubStep = particlePosition
+ diffSubStep = kWeightK(subStep) * kCoeff(:,subStep)
+
+ if(kWeightK(subStep) /= 0.0_RKIND) then
+ ! project substep to correct spherical shell because diffSubStep isn't 0 and particle moves
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("particle_horizontal_movementLPT")
+#endif
+ call particle_horizontal_movement(meshPool, xSubStep, diffSubStep)
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("particle_horizontal_movementLPT")
+#endif
+ end if
+
+ ! vertical
+ zSubStep = zLevelParticle
+ diffSubStepVert = kWeightKVert(subStep) * kCoeffVert(subStep)
+
+ if(kWeightKVert(subStep) /= 0.0_RKIND) then
+ zSubStep = zSubStep + diffSubStepVert
+ end if
+
+ ! get new time step (tm = (timestep-1)*dt)
+ tSubStep = (timeStep-1 + kWeightT(subStep)) * dt
+
+ !!!!!!!!!! GET SPECIFIC CELL INDICES AND GEOMETRY !!!!!!!!!!
+
+ ! determine cell location
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("get_validated_cell_idLPT")
+#endif
+ LIGHT_DEBUG_WRITE('beginning of substeps')
+ call get_validated_cell_id(nCells, xCell,yCell,zCell , xVertex,yVertex,zVertex, &
+ xSubStep(1),xSubStep(2),xSubStep(3), meshPool, &
+ nCellVerticesArray, verticesOnCell, iCell, nCellVertices, cellsOnCell)
+ LIGHT_DEBUG_WRITE('iCell=' COMMA iCell)
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("get_validated_cell_idLPT")
+#endif
+
+ if(verticalTreatment /= 4) then
+ ! other cases using zSubStep for iLevel and vertical interpolation
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("mpas_get_vertical_idLPT")
+#endif
+ iLevel = mpas_get_vertical_id(maxLevelCell(iCell), zSubStep, zMid(:,iCell))
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("mpas_get_vertical_idLPT")
+#endif
+ LIGHT_DEBUG_WRITE('iLevel=' COMMA iLevel)
+ end if
+
+ !!!!!!!!!! TEMPORALLY INTERPOLATE TIME FIELD !!!!!!!!!!
+ ! use these coefficients to just get the velocity at n
+ !timeInterpOrder = 1
+ !timeCoeff(1) =1.0_RKIND
+ ! use these coefficients to just get the velocity at n+1
+ !timeInterpOrder = 2
+ !timeCoeff(1) =0.0_RKIND
+ !timeCoeff(2) =1.0_RKIND
+ ! get interpolation coefficients for linear interpolation in time
+ timeInterpOrder = 2
+ timeCoeff(1) = tSubStep / dtSim
+ timeCoeff(2) = 1.0_RKIND - timeCoeff(1)
+
+ ! ensure that buoyancy is fixed for each run
+ buoyancyInterp = buoyancyParticle
+ ! return interpolated horizontal velocity "particleVelocity" and vertical velocity "particleVelocityVert"
+
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("velocity_time_interpolationLPT")
+#endif
+ call velocity_time_interpolation(particleVelocity, particleVelocityVert, &
+ diagnosticsPool, lagrPartTrackFieldsPool, &
+ timeInterpOrder, timeCoeff, iCell, iLevel, buoyancyInterp, maxLevelCell, &
+ verticalTreatment, indexLevel, nCellVertices, verticesOnCell, boundaryVertex, &
+ xSubStep, zSubStep, zMid, zTop, vertVelocityTop, xVertex, yVertex, zVertex, meshPool, areaBArray)
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("velocity_time_interpolationLPT")
+#endif
+
+ !!!!!!!!!! FORM INTEGRATION WEIGHTS kj !!!!!!!!!!
+ kCoeff(:,subStep+1) = dt * particleVelocity
+ kCoeffVert(subStep+1) = dt * particleVelocityVert
+ end do
+
+ !!!!!!!!!! UPDATE PARTICLE POSITIONS !!!!!!!!!!
+ !!!!!!!!!! HORIZONTAL AND VERTICAL CONSIDERED SEPARATELY !!!!!!!!!!
+ diffParticlePosition = 0.0_RKIND
+ diffParticlePositionVert = 0.0_RKIND
+ do subStep = 1, subStepOrder
+ ! first complete particle integration
+ diffParticlePosition = diffParticlePosition + kWeightX(:,subStep) * kCoeff(:,subStep+1)
+ diffParticlePositionVert = diffParticlePositionVert + kWeightXVert(subStep) * kCoeffVert(subStep+1)
+ end do
+ ! now, make sure particle position is still on same spherical shell as before
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("particle_horizontal_movementLPT")
+#endif
+ call particle_horizontal_movement(meshPool, particlePosition, diffParticlePosition)
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("particle_horizontal_movementLPT")
+#endif
+ ! now can do any vertical movements independent of the horizontal movement
+ ! that was just calculated ( probably need to have more output from the vertical_treatment
+ ! and aggregate here
+ zLevelParticle = zLevelParticle + diffParticlePositionVert
+
+ end do !}}}
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("time_step_LPT")
+#endif
+ !}}}
+
+ !!!!!!!!!! PERFORM SAMPLING (VELOCITY, TEMP, SALINITY, ETC) !!!!!!!!!!
+ ! this could be done just before the output anyway
+
+ ! need iCell computed for final position
+ ! need scalar values interpolated in time to yield single value
+ ! probably need to store zMid too, including flipping it
+ ! get updated cell location
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("get_validated_cell_idLPT")
+#endif
+ LIGHT_DEBUG_WRITE('do sampling')
+ call get_validated_cell_id(nCells, xCell,yCell,zCell , xVertex,yVertex,zVertex, &
+ particlePosition(1),particlePosition(2),particlePosition(3), meshPool, &
+ nCellVerticesArray, verticesOnCell, iCell, nCellVertices, cellsOnCell)
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("get_validated_cell_idLPT")
+#endif
+
+ if(verticalTreatment == 4) then !('buoyancySurface') !{{{
+ !! determine index level (don't need validated version because that will "fix" values which we may not want
+ !! however, if the particle's target buoyancy surface doesn't exist then we will need to
+ !! ensure that vertical location is valid, placing particles outside of range of zMid back inside
+ !! we don't validate this because we want the code to fail, at least initially, in the case that
+ !! the particle is in a cell that does not have the proper buoyancy target because this implies
+ !! that the buoyancy tracking mode has completely failed.
+ !! need to make sure it is validated for buoyancy particles
+ iLevelBuoyancy = mpas_get_vertical_id(maxLevelCell(iCell), buoyancyInterp, buoyancyTimeInterp(:,iCell))
+ ! interpolate the scalars now (assumes that scalar value is constant within a particular cell)
+ call interp_cell_scalars(iLevelBuoyancy, maxLevelCell(iCell), buoyancyInterp, buoyancyTimeInterp(:,iCell), &
+ zMid(:,iCell), zLevelParticle)
+ !}}}
+ else
+ ! make sure final zLevelParticle is ok so that it can't extent past zMid range
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("mpas_get_vertical_idLPT")
+#endif
+ iLevel = mpas_get_vertical_id(maxLevelCell(iCell), zLevelParticle, zMid(:,iCell))
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("mpas_get_vertical_idLPT")
+#endif
+ end if
+
+ ! compute necessary information for autocorrelation !{{{
+ ! get the updated velocity
+ ! ensure that buoyancy is fixed for each run
+ buoyancyInterp = buoyancyParticle
+ ! we just need the last part of the velocity field interpolation because we are at the end of the timestep
+ timeInterpOrder = 2
+ timeCoeff(1) = 0.0_RKIND
+ timeCoeff(2) = 1.0_RKIND
+ ! return interpolated horizontal velocity "particleVelocity" and vertical velocity "particleVelocityVert"
+ ! noting we use the final positions
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("velocity_time_interpolationLPT")
+#endif
+ call velocity_time_interpolation(particleVelocity, particleVelocityVert, &
+ diagnosticsPool, lagrPartTrackFieldsPool, &
+ timeInterpOrder, timeCoeff, iCell, iLevel, buoyancyInterp, maxLevelCell, &
+ verticalTreatment, indexLevel, nCellVertices, verticesOnCell, boundaryVertex, &
+ particlePosition, zLevelParticle, zMid, zTop, vertVelocityTop, xVertex, yVertex, zVertex, &
+ meshPool, areaBArray)
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("velocity_time_interpolationLPT")
+#endif
+ ! convert horizontal velocity to lat/lon velocity
+
+ ! store velocity for use in computing normalized autocorrelation offline
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("mpas_convert_xyz_velocity_to_latlonLPT")
+#endif
+ call mpas_convert_xyz_velocity_to_latlon(lonVel, latVel, particlePosition, particleVelocity)
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("mpas_convert_xyz_velocity_to_latlonLPT")
+#endif
+
+ ! now store components needed to compute integral timescale
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("storeSingleParticleStats")
+#endif
+ sumU = sumU + lonVel
+ sumV = sumV + latVel
+ sumUU = sumUU + lonVel*lonVel
+ sumUV = sumUV + lonVel*latVel
+ sumVV = sumVV + latVel*latVel
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("storeSingleParticleStats")
+#endif
+ !}}}
+
+ ! properly store particle position (because we can't store arrays directly for particles and must
+ ! work entirely in vectors
+ xParticle = particlePosition(1)
+ yParticle = particlePosition(2)
+ zParticle = particlePosition(3)
+
+ !!!!!!!!!! PASS PARTICLES FROM PROCESSOR TO PROCESSOR !!!!!!!!!!
+ !{{{
+ ! 1. determine if iCell is on halo (just set each particle's currentBlock to the correct currentBlock
+ ! 2. determine owning block in halo, update particle's currentBlock
+
+ ! determine currentBlock ownership of iCell
+ ! and set cellOwnerBlock to be current block
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("particleAssignments")
+#endif
+
+ resetParticle = .False.
+ if (config_AM_lagrPartTrack_reset_particles) then ! need to link to currentBlockReset for communication
+ ! determine if particles should be reset based on different criteria. If so, reset them.
+ call ocn_evaluate_particle_reset_condition(domain, block, particle, dtSim, iCell, resetParticle, err)
+ end if
+ resetParticleAny = resetParticleAny .or. resetParticle
+
+ if (.not. resetParticle) then
+ ! update halo fields for particles moving from adjacent computational halos
+ call mpas_particle_list_update_particle_block(domain, block, particle, 'lagrPartTrackCells', iCell)
+ end if
+
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("particleAssignments")
+#endif
+ !}}}
+
+ ! get next particle to process on the list
+ particlelist => particlelist % next
+ end do !}}}
+
+ ! get next block
+ block => block % next
+ end do !}}}
+
+ !!!!!!!!!! PASS PARTICLES FROM PROCESSOR TO PROCESSOR !!!!!!!!!!
+ ! MPI calls
+ ! 3. place particle on temporary list to be sent to processor, removing particle from present list
+ ! 4. pass list of particles to owning block (outside block loop so that all blocks can be processed)
+ ! 5. delete all particles on the temporary lists (potentially if on different proc)
+ ! because they have been permenantly moved to block owning the halo
+ !
+ ! Items 3-5 should be able to be described in terms of current code
+ ! noting that the most important thing is to ensure that the particle's currentBlock is
+ ! updated. Then, a routine can be called to make sure particles are placed on their appropriate
+ ! currentBlocks
+
+ ! particle transfer can then occur from computational processor to computational processor
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("trans_from_block_to_blockLPT")
+#endif
+ if (config_AM_lagrPartTrack_reset_particles .and. resetParticleAny) then
+ ! need to link to currentBlockReset for communication
+ call mpas_particle_list_build_halos(domain, err, 'currentBlockReset', g_compProcNeighs)
+ ! take the union of this halo with the particle computation halos to build complete computational halo
+ call mpas_particle_list_self_union_halo_lists(g_compProcNeighs, g_compProcNeighsNearby, domain % dminfo % nprocs, &
+ domain % dminfo % my_proc_id)
+ else
+ allocate(g_compProcNeighs(size(g_compProcNeighsNearby)))
+ g_compProcNeighs = g_compProcNeighsNearby
+ end if
+ call mpas_particle_list_transfer_particles_from_block_to_named_block(domain, err, .True., .False., 'currentBlock', &
+ g_compProcNeighs)
+ deallocate(g_compProcNeighs)
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("trans_from_block_to_blockLPT")
+#endif
+
+ ! do IO communications if this is an output time step
+ if (mpas_stream_mgr_ringing_alarms(domain % streamManager, streamID='lagrPartTrackOutput', &
+ direction=MPAS_STREAM_OUTPUT, ierr=err)) then
+ call write_lagrangian_particle_tracking(domain, err)
+ end if
+
+ call mpas_timer_stop("computeLPT")
+ call mpas_timer_stop("totalLPT")
+
+ LIGHT_DEBUG_WRITE('finished computing Lagrangian Particle Tracking')
+
+ end subroutine ocn_compute_lagrangian_particle_tracking!}}}
+
+!***********************************************************************
+!
+! routine ocn_restart_lagrangian_particle_tracking
+!
+!> \brief Save restart for MPAS-Ocean analysis member
+!> \author Phillip J. Wolfram
+!> \date 02/20/14 and 07/23/15
+!> \details
+!> This routine conducts computation required to save a restart state
+!> for the MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_restart_lagrangian_particle_tracking(domain, err)!{{{
+
+ implicit none
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ call mpas_timer_start("totalLPT")
+
+ ! do restart if this is a restart step
+ if (mpas_stream_mgr_ringing_alarms(domain % streamManager, streamID='lagrPartTrackRestart', &
+ direction=MPAS_STREAM_OUTPUT, ierr=err)) then
+ call mpas_timer_start("restartLPT")
+
+ LIGHT_DEBUG_WRITE('start ocn_restart_lagrangian_particle_tracking')
+ ! transfer particles to their appropriate blocks (ioBlock) via MPI
+ ! note, don't necessarily need to have g_ionSend and g_ionRecv comeout
+ call mpas_particle_list_build_halos(domain, err, 'ioBlock', g_ioProcNeighs)
+ call mpas_particle_list_transfer_particles_from_block_to_named_block(domain, err, .True., .True., 'ioBlock', &
+ g_ioProcNeighs)
+ deallocate(g_ioProcNeighs)
+
+ ! write out all the data, sorting to make sure that shuffled particles
+ ! are ouptut correctly (done separately in each function, could be
+ ! pulled out as an optimization)
+ ! write halo data out, but don't need nonhalo data because it is
+ ! computed for output (diagnostic, not prognostic)
+ call mpas_particle_list_write_halo_data(domain, err)
+ !call mpas_particle_list_write_nonhalo_data(domain, err)
+
+ ! need to now remove the io particles (remove particles that don't have the
+ ! correct currentBlock)
+ call mpas_particle_list_remove_particles_not_on_current_block(domain,err)
+
+ LIGHT_DEBUG_WRITE('end ocn_restart_lagrangian_particle_tracking')
+ call mpas_timer_stop("restartLPT")
+ end if
+
+ call mpas_timer_stop("totalLPT")
+
+ end subroutine ocn_restart_lagrangian_particle_tracking!}}}
+
+!***********************************************************************
+!
+! routine write_lagrangian_particle_tracking
+!
+!> \brief Driver for MPAS-Ocean analysis output
+!> \author Phillip Wolfram
+!> \date 02/20/14
+!> \details
+!> This routine writes all output for this MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+ subroutine write_lagrangian_particle_tracking(domain, err)!{{{
+
+ implicit none
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ LIGHT_DEBUG_WRITE('start write_lagrangian_particle_tracking')
+ call mpas_timer_start("totalLPT")
+ call mpas_timer_start("writeLPT")
+
+ !call mpas_particle_list_test_num_current_particlelist(domain)
+
+ ! transfer particles to their appropriate blocks (ioBlock) via MPI
+ ! note, don't necessarily need to have g_ionSend and g_ionRecv comeout
+ !write(stderrUnit,*) 'g_ioProcNeighs = ', g_ioProcNeighs
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("trans_from_block_to_blockLPT")
+#endif
+ ! depreciated (can just use update_halo_io to keep g_ioProcNeighs up to date)
+ !! get "MPI halos" for IO communication during write and restart steps (currentBlock to ioBlock)
+ call mpas_particle_list_build_halos(domain, err, 'ioBlock', g_ioProcNeighs)
+ ! transfer the data
+ call mpas_particle_list_transfer_particles_from_block_to_named_block(domain, err, .False., .True., 'ioBlock', &
+ g_ioProcNeighs)
+ deallocate(g_ioProcNeighs)
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("trans_from_block_to_blockLPT")
+#endif
+
+ ! write out all the data, sorting to make sure that shuffled particles
+ ! are ouptut correctly (done separately in each function, could be
+ ! pulled out as an optimization)
+ call mpas_particle_list_write_halo_data(domain, err)
+ call mpas_particle_list_write_nonhalo_data(domain, err)
+
+#ifdef MPAS_DEBUG
+ call mpas_particle_list_test_num_current_particlelist(domain)
+#endif
+ ! need to now remove the io particles (remove particles that don't have the
+ ! correct currentBlock)
+ call mpas_particle_list_remove_particles_not_on_current_block(domain,err)
+
+#ifdef MPAS_DEBUG
+ call mpas_particle_list_test_num_current_particlelist(domain)
+#endif
+ LIGHT_DEBUG_WRITE('end write_lagrangian_particle_tracking')
+ call mpas_timer_stop("writeLPT")
+ call mpas_timer_stop("totalLPT")
+
+
+ end subroutine write_lagrangian_particle_tracking!}}}
+
+!***********************************************************************
+!
+! routine ocn_finalize_lagrangian_particle_tracking
+!
+!> \brief Finalize MPAS-Ocean analysis member
+!> \author Phillip J. Wolfram
+!> \date 02/20/14
+!> \details
+!> This routine conducts all finalizations required for this
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_finalize_lagrangian_particle_tracking(domain, err)!{{{
+
+ implicit none
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ type (block_type), pointer :: block
+ integer :: timeLev
+
+ call mpas_timer_start("totalLPT")
+ call mpas_timer_start("finalizeLPT")
+ err = 0
+
+ LIGHT_DEBUG_WRITE('start ocn_finalize_lagrangian_particle_tracking')
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_particle_list_destroy_particle_list(block % particlelist)
+ block => block % next
+ end do
+
+ deallocate(g_compProcNeighsNearby)
+
+ LIGHT_DEBUG_WRITE('end ocn_finalize_lagrangian_particle_tracking')
+ call mpas_timer_stop("finalizeLPT")
+ call mpas_timer_stop("totalLPT")
+
+ end subroutine ocn_finalize_lagrangian_particle_tracking!}}}
+
+!-----------------------------------------------------------------------
+!
+! PRIVATE SUBROUTINES
+!
+!-----------------------------------------------------------------------
+!{{{
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! SUBROUTINE GET_VALIDATED_CELL_ID
+ !
+ ! Computes the validated cell ID for a particular location base on proximity to point.
+ ! Phillip Wolfram 06/18/2014
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ subroutine get_validated_cell_id(nCells, xCell,yCell,zCell , xVertex,yVertex,zVertex, &
+ xSubStep,ySubStep,zSubStep, meshPool, nCellVerticesArray, verticesOnCell, &
+ iCell, nCellVertices, cellsOnCell)
+
+ implicit none
+
+ ! intent (in)
+ integer, intent(in) :: nCells !< number of cells
+ integer, dimension(:,:), pointer, intent(in) :: verticesOnCell !< vertex indices on cell
+ integer, dimension(:), pointer, intent(in) :: nCellVerticesArray
+ real (kind=RKIND), dimension(:), intent(in) :: xCell,yCell,zCell !< spatial location of cell centers
+ real (kind=RKIND), dimension(:), intent(in) :: xVertex,yVertex,zVertex !< spatial location of cell vertices
+ real (kind=RKIND), intent(in) :: xSubStep,ySubStep,zSubStep
+ type (mpas_pool_type), intent(in), pointer :: meshPool ! meshPool pointer
+ integer, dimension(:,:), intent(in) :: cellsOnCell ! cell connectivity
+
+ !intent (out)
+ integer, intent(inout) :: iCell
+ integer, intent(out) :: nCellVertices
+ character (len=StrKIND) :: message
+#ifdef MPAS_DEBUG
+ logical, pointer :: is_periodic
+ real(kind=RKIND), pointer :: x_period, y_period
+ logical, pointer :: on_a_sphere
+ real(kind=RKIND), dimension(:), pointer :: xtmp, ytmp
+ integer :: i
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+ call mpas_pool_get_config(meshPool, 'is_periodic', is_periodic)
+ call mpas_pool_get_config(meshPool, 'x_period', x_period)
+ call mpas_pool_get_config(meshPool, 'y_period', y_period)
+#endif
+
+ ! get cell index
+!#ifdef MPAS_DEBUG
+! iCell = -1
+!#endif
+ call mpas_get_nearby_cell_index(nCells, xCell,yCell,zCell , &
+ xSubStep,ySubStep,zSubStep, meshPool, iCell, cellsOnCell, nCellVerticesArray)
+
+ nCellVertices = nCellVerticesArray(iCell)
+
+#ifdef MPAS_DEBUG
+ ! check to make sure the horizontal location is valid, otherwise report an error
+ !write(stderrUnit,*) 'max verticesOnCell = ', maxval(verticesOnCell(:,iCell)), 'nVertices = ', size(xVertex)
+ if (on_a_sphere .or. .not. is_periodic) then
+ if(.not. point_in_cell(nCellVertices, &
+ xVertex(verticesOnCell(1:nCellVertices,iCell)), &
+ yVertex(verticesOnCell(1:nCellVertices,iCell)), &
+ zVertex(verticesOnCell(1:nCellVertices,iCell)), &
+ xSubStep,ySubStep,zSubStep , on_a_sphere)) then
+ write(message, *) 'Point (', xSubStep, ySubStep, zSubStep , ') is horizontally outside cell ', iCell
+ LIGHT_DEBUG_WRITE(message)
+ write(message, *) 'Cell (', xCell(iCell), yCell(iCell), zCell(iCell), ') with index ', iCell
+ LIGHT_DEBUG_WRITE(message)
+ LIGHT_DEBUG_WRITE('xVertex = ' COMMA xVertex(verticesOnCell(1:nCellVertices,iCell)))
+ LIGHT_DEBUG_WRITE('yVertex = ' COMMA yVertex(verticesOnCell(1:nCellVertices,iCell)))
+ LIGHT_DEBUG_WRITE('zVertex = ' COMMA zVertex(verticesOnCell(1:nCellVertices,iCell)))
+ end if
+ else
+ allocate(xtmp(nCellVertices), ytmp(nCellVertices))
+ do i = 1, nCellVertices
+ xtmp(i) = mpas_fix_periodicity(xVertex(verticesOnCell(i,iCell)), xSubStep, x_period)
+ ytmp(i) = mpas_fix_periodicity(yVertex(verticesOnCell(i,iCell)), ySubStep, y_period)
+ end do
+ if(.not. point_in_cell(nCellVertices, xtmp, ytmp, &
+ zVertex(verticesOnCell(1:nCellVertices,iCell)), &
+ xSubStep,ySubStep,zSubStep , on_a_sphere)) then
+ write(message, *) 'Point (', xSubStep, ySubStep, zSubStep, ') is horizontally outside cell ', iCell
+ LIGHT_DEBUG_WRITE(message)
+ write(message, *) 'Cell (', xCell(iCell), yCell(iCell), zCell(iCell), ') with index ', iCell
+ LIGHT_DEBUG_WRITE(message)
+ LIGHT_DEBUG_WRITE('xVertex = ' COMMA xtmp)
+ LIGHT_DEBUG_WRITE('yVertex = ' COMMA ytmp)
+ LIGHT_DEBUG_WRITE('zVertex = ' COMMA zVertex(verticesOnCell(1:nCellVertices,iCell)))
+ end if
+ deallocate(xtmp, ytmp)
+ end if
+#endif
+
+ end subroutine get_validated_cell_id
+
+#ifdef MPAS_DEBUG
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! FUNCTION POINT_IN_CELL
+ !
+ ! Check to make sure point (xp,yp,zp) is within cell iCell (implicit via xv,yv,zv)
+ ! Phillip Wolfram 05/01/2014
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ logical function point_in_cell(nVertices, xv,yv,zv , xp,yp,zp, on_a_sphere) !{{{
+ implicit none
+
+ integer, intent(in) :: nVertices ! number of vertices for cell
+ real (kind=RKIND), dimension(:), intent(in) :: xv,yv,zv ! cell vertex locations
+ real (kind=RKIND), intent(in) :: xp,yp,zp ! point location
+ logical, intent(in) :: on_a_sphere ! flag designating if we are on a sphere
+
+ integer :: aPoint, v1, v0
+ real (kind=RKIND) :: pointRadius ! magnitude of a point radius
+ real (kind=RKIND), dimension(3) :: pPoint ! point vector
+ real (kind=RKIND), dimension(3, nVertices) :: pVertices ! vertices vectors
+ real (kind=RKIND), dimension(3) :: vec1, vec2, crossProd ! temporary vectors
+ integer, dimension(nVertices+1) :: cyclePlusOne
+
+ ! normalize locations to same spherical shell (unit) for direct comparison
+ if (on_a_sphere) then
+ pointRadius = sqrt(xp*xp + yp*yp + zp*zp)
+ pPoint = (/ xp/pointRadius , yp/pointRadius , zp/pointRadius /)
+ do aPoint = 1, nVertices
+ pointRadius = sqrt(xv(aPoint)*xv(aPoint) + yv(aPoint)*yv(aPoint) + zv(aPoint)*zv(aPoint))
+ pVertices(:,aPoint) = (/ xv(aPoint), yv(aPoint), zv(aPoint) /) / pointRadius
+ end do
+ else
+ pPoint = (/ xp,yp,zp /)
+ do aPoint = 1, nVertices
+ pVertices(:, aPoint) = (/ xv(aPoint), yv(aPoint), zv(aPoint) /)
+ end do
+ end if
+
+ ! build up vertex cycle for the cell
+ do aPoint = 1, nVertices-1
+ cyclePlusOne(aPoint) = aPoint + 1
+ end do
+ cyclePlusOne(nVertices) = 1
+
+ ! check, using cross-products, that point is within the cell, assuming it is to start
+ point_in_cell = .true.
+ do aPoint = 1, nVertices
+ ! get indices of points
+ v0 = aPoint
+ v1 = cyclePlusOne(aPoint)
+
+ ! compute the local vectors
+ vec1 = pVertices(:,v1) - pVertices(:,v0)
+ vec2 = pPoint - pVertices(:,v0)
+
+ ! compute the cross product and dot with normal, if negative we are outside cell
+ ! we only need to fail on a single test!
+ call mpas_cross_product_in_r3(vec1,vec2,crossProd)
+ if (on_a_sphere) then
+ if(sum(crossProd*pVertices(:,v0)) < 0) then
+ point_in_cell = .false.
+ end if
+ else
+ if(crossProd(3) < 0) then
+ point_in_cell = .false.
+ end if
+ end if
+
+ end do
+
+ end function point_in_cell!}}}
+#endif
+
+!***********************************************************************
+!
+! routine initalize_fields
+!
+!> \brief Initialize fields
+!> \author Phillip Wolfram
+!> \date 05/22/2014
+!> \details
+!> This routine inializes the fields necessary for particle tracking
+!
+!-----------------------------------------------------------------------
+ subroutine initalize_fields(domain, err)!{{{
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input/output variables
+ !-----------------------------------------------------------------
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: diagnosticsPool
+ type (mpas_pool_type), pointer :: lagrPartTrackFieldsPool, lagrPartTrackScratchPool, lagrPartTrackCellsPool
+ real(kind=RKIND), dimension(:,:), pointer :: normalVelocity, layerThickness
+ integer :: timeLev
+ integer, pointer :: filterNum
+ type (field2DReal), pointer :: uVV, vVV, wVV
+ real (kind=RKIND), dimension(:,:), pointer :: potentialDensity
+
+ !write(stderrUnit,*) 'inialize_vertex_velocity start'
+
+ call mpas_pool_get_config(ocnConfigs, 'config_AM_lagrPartTrack_filter_number', filterNum)
+
+ err = 0
+
+ block => domain % blocklist
+ do while (associated(block))
+ ! setup pointers / get block
+ call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackFields', lagrPartTrackFieldsPool)
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackScratch', lagrPartTrackScratchPool)
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackCells', lagrPartTrackCellsPool)
+ call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
+
+ !! initialize field for RBF (needed depending upon calling pattern of analysis member)
+ !call mpas_initialize_vectors(meshPool)
+ !call mpas_init_reconstruct(meshPool)
+
+ ! initialize fresh memory for both levels
+ do timeLev = 1, 2
+ ! connect variables to pointer array
+ call mpas_pool_get_field(lagrPartTrackFieldsPool, 'uVertexVelocity', uVV, timeLevel=timeLev)
+ call mpas_pool_get_field(lagrPartTrackFieldsPool, 'vVertexVelocity', vVV, timeLevel=timeLev)
+ call mpas_pool_get_field(lagrPartTrackFieldsPool, 'wVertexVelocity', wVV, timeLevel=timeLev)
+
+ ! initialize, but could potentially remove these lines
+ uVV % array = 0.0_RKIND
+ vVV % array = 0.0_RKIND
+ wVV % array = 0.0_RKIND
+
+ ! make sure memory has been allocated
+#ifdef MPAS_DEBUG
+ if(.not.associated(uVV) .or. &
+ .not.associated(vVV) .or. &
+ .not.associated(wVV)) then
+ LIGHT_DEBUG_WRITE('[u,v,w]VertexVelocity memory not allocated!')
+ end if
+#endif
+
+ call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, timeLevel=timeLev)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, timeLevel=timeLev)
+
+ ! get new time level velocity (linear RBF)
+ !write(stderrUnit,*) 'uVV= ', uVV % array
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("init_reconst_filter_LPT")
+#endif
+ call ocn_vertex_reconstruction(filterNum, meshPool, lagrPartTrackScratchPool, lagrPartTrackCellsPool, &
+ layerThickness, normalVelocity, uVV, vVV, wVV)
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("init_reconst_filter_LPT")
+#endif
+
+ end do
+
+ block => block % next
+ end do
+ !write(stderrUnit,*) 'inialize_vertex_velocity end'
+
+ end subroutine initalize_fields!}}}
+
+!***********************************************************************
+!
+! routine initalize_wachspress_coefficients
+!
+!> \brief Initialize Wachspress coefficients
+!> \author Phillip Wolfram
+!> \date 01/26/2015
+!> \details
+!> This routine inializes the B_i Wachspress coefficients which are
+!> static in time
+!
+!-----------------------------------------------------------------------
+ subroutine intialize_wachspress_coefficients(domain, err) !{{{
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input/output variables
+ !-----------------------------------------------------------------
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: lagrPartTrackCellsPool
+ type (mpas_pool_type), pointer :: meshPool
+ integer :: nVertices, iCell, i, im1, i0, ip1, iVertex
+ integer, pointer :: nCells
+ real (kind=RKIND), dimension(:), allocatable :: xv,yv,zv
+ real (kind=RKIND), dimension(3) :: v1, v2, v3
+ real (kind=RKIND), pointer :: radiusLocal
+ integer, dimension(:,:), pointer :: verticesOnCell
+ integer, dimension(:), pointer :: nCellVerticesArray
+ real (kind=RKIND), dimension(:), pointer :: xVertex, yVertex, zVertex
+ real (kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell
+ real (kind=RKIND), dimension(:,:), pointer :: areaBArray
+ logical, pointer :: on_a_sphere, is_periodic
+ real(kind=RKIND), pointer :: x_period, y_period
+
+ err = 0
+
+ block => domain % blocklist
+ do while (associated(block))
+ ! setup pointers / get block
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackCells', lagrPartTrackCellsPool)
+ call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+ call mpas_pool_get_config(meshPool, 'is_periodic', is_periodic)
+ call mpas_pool_get_config(meshPool, 'x_period', x_period)
+ call mpas_pool_get_config(meshPool, 'y_period', y_period)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nCellVerticesArray)
+ call mpas_pool_get_config(meshPool, 'sphere_radius', radiusLocal)
+ call mpas_pool_get_array(meshPool, 'verticesOnCell', verticesOnCell)
+ call mpas_pool_get_array(meshPool, 'xVertex', xVertex)
+ call mpas_pool_get_array(meshPool, 'yVertex', yVertex)
+ call mpas_pool_get_array(meshPool, 'zVertex', zVertex)
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'zCell', zCell)
+ call mpas_pool_get_array(lagrPartTrackCellsPool, 'wachspressAreaB', areaBArray)
+
+ ! compute B_i coefficients
+ areaBArray = 0.0_RKIND
+ do iCell = 1, nCells
+ nVertices = nCellVerticesArray(iCell)
+ allocate(xv(nVertices), yv(nVertices), zv(nVertices))
+ if (on_a_sphere .or. .not. is_periodic) then
+ xv = xVertex(verticesOnCell(:,iCell))
+ yv = yVertex(verticesOnCell(:,iCell))
+ zv = zVertex(verticesOnCell(:,iCell))
+ else
+ do iVertex=1,nVertices
+ xv(iVertex) = mpas_fix_periodicity(xVertex(verticesOnCell(iVertex,iCell)), &
+ xCell(iCell), x_period)
+ yv(iVertex) = mpas_fix_periodicity(yVertex(verticesOnCell(iVertex,iCell)), &
+ yCell(iCell), y_period)
+ zv(iVertex) = zVertex(verticesOnCell(iVertex,iCell))
+ end do
+ end if
+ do i = 1, nVertices
+ ! compute first area B_i
+ ! get vertex indices
+ im1 = mod(nVertices + i - 2, nVertices) + 1
+ i0 = mod(nVertices + i - 1, nVertices) + 1
+ ip1 = mod(nVertices + i , nVertices) + 1
+
+ ! precompute B_i areas
+ ! always the same because B_i independent of xp,yp,zp
+ v1(1) = xv(im1)
+ v1(2) = yv(im1)
+ v1(3) = zv(im1)
+ v2(1) = xv(i0)
+ v2(2) = yv(i0)
+ v2(3) = zv(i0)
+ v3(1) = xv(ip1)
+ v3(2) = yv(ip1)
+ v3(3) = zv(ip1)
+ areaBArray(iCell, i) = mpas_triangle_signed_area(v1, v2, v3, meshPool)
+ end do
+ deallocate(xv, yv, zv)
+
+ end do
+
+
+ block => block % next
+ end do
+
+ end subroutine intialize_wachspress_coefficients !}}}
+
+!***********************************************************************
+!
+! routine compute_velocity_on_potentialdensity_surface
+!
+!> \brief compute_velocity_on_potentialdensity_surface
+!> \author Phillip Wolfram
+!> \date 09/15/2014
+!> \details
+!> This routine interpolates the velocity field onto the potential
+!> density surface
+!
+!-----------------------------------------------------------------------
+ subroutine compute_velocity_on_potentialdensity_surface(domain,err,aTimeLevel) !{{{
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input/output variables
+ !-----------------------------------------------------------------
+ type (domain_type), intent(in) :: domain
+ integer, intent(in) :: aTimeLevel
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: meshPool, diagnosticsPool, lagrPartTrackCellsPool
+ real (kind=RKIND), dimension(:,:), pointer :: zonVel, merVel, depth, normalVelocityMer, normalVelocityZon
+ real (kind=RKIND), dimension(:), pointer :: buoyancySurfaceValues
+ integer, pointer :: nBuoyancySurfaces, nCells
+ real (kind=RKIND), dimension(:,:), pointer :: buoyancy, zMid
+ integer :: iLevel, aBuoyancySurface, iCell
+ integer, dimension(:), pointer :: maxLevelCell
+ real (kind=RKIND) :: phiInterp !< location to interpolate
+ real (kind=RKIND) :: alpha
+ integer :: iHigh, iLow, aval
+ real (kind=RKIND) :: eps=1e-14_RKIND
+
+ LIGHT_DEBUG_WRITE('compute_velocity_on_potentialdensity_surface start')
+
+ err = 0
+
+ block => domain % blocklist
+ do while (associated(block))
+ ! get pools
+ call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackCells', lagrPartTrackCellsPool)
+ call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
+ ! connect variables to pointer array
+ call mpas_pool_get_array(diagnosticsPool, 'velocityMeridional', normalVelocityMer)
+ call mpas_pool_get_array(diagnosticsPool, 'velocityZonal', normalVelocityZon)
+ call mpas_pool_get_array(lagrPartTrackCellsPool, 'buoyancySurfaceVelocityZonal', zonVel)
+ call mpas_pool_get_array(lagrPartTrackCellsPool, 'buoyancySurfaceVelocityMeridional', merVel)
+ call mpas_pool_get_array(lagrPartTrackCellsPool, 'buoyancySurfaceDepth', depth)
+ call mpas_pool_get_array(diagnosticsPool, 'potentialDensity', buoyancy)
+ call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nBuoyancySurfaces', nBuoyancySurfaces)
+ call mpas_pool_get_array(lagrPartTrackCellsPool,'buoyancySurfaceValues', buoyancySurfaceValues)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+
+ LIGHT_DEBUG_ALL_WRITE('nBuoyancySurfaces =' COMMA nBuoyancySurfaces)
+ LIGHT_DEBUG_ALL_WRITE('buoyancySurfaceValues=' COMMA buoyancySurfaceValues)
+ LIGHT_DEBUG_ALL_WRITE('size(buoyancy)=' COMMA size(buoyancy))
+ LIGHT_DEBUG_ALL_WRITE('shape(buoyancy)=' COMMA shape(buoyancy))
+ zonVel = -9999.0_RKIND
+ merVel = -9999.0_RKIND
+ ! for each buoyancy surface
+ do aBuoyancySurface = 1, nBuoyancySurfaces
+ ! for each cell
+ do iCell = 1, nCells
+
+ phiInterp = buoyancySurfaceValues(aBuoyancySurface)
+
+ ! get correct vertical levels
+
+ iLevel = mpas_get_vertical_id(maxLevelCell(iCell), phiInterp, buoyancy(:,iCell))
+
+ if(iLevel < 1) then
+ ! top level
+ if (iLevel == 0) then
+ aval = maxloc(buoyancy(1:maxLevelCell(iCell),iCell),1)
+ ! bottom level
+ else if (iLevel == -1) then
+ aval = minloc(buoyancy(1:maxLevelCell(iCell),iCell),1)
+ end if
+ zonVel(aBuoyancySurface, iCell) = normalVelocityZon(aval,iCell)
+ merVel(aBuoyancySurface, iCell) = normalVelocityMer(aval,iCell)
+ depth(aBuoyancySurface, iCell) = zMid(aval,iCell)
+ else
+ ! perform the interpolation
+ call get_bounding_indices(iLow, iHigh, phiInterp, buoyancy(:,iCell), iLevel, maxLevelCell(iCell))
+ ! get alpha between points
+ if(abs(buoyancy(iHigh,iCell) - buoyancy(iLow,iCell)) < eps) then
+ ! we really can't distinguish between each of these points numerically, just take the
+ ! average of both
+ alpha = 0.5_RKIND
+ else
+ alpha = (phiInterp - buoyancy(iLow,iCell))/(buoyancy(iHigh,iCell) - buoyancy(iLow,iCell))
+ end if
+
+ ! interpolate to the correct surface
+ zonVel(aBuoyancySurface, iCell) = alpha * normalVelocityZon(iHigh, iCell) + &
+ (1.0_RKIND - alpha) * normalVelocityZon(iLow, iCell)
+ merVel(aBuoyancySurface, iCell) = alpha * normalVelocityMer(iHigh, iCell) + &
+ (1.0_RKIND - alpha) * normalVelocityMer(iLow, iCell)
+ depth(aBuoyancySurface, iCell) = alpha * zMid(iHigh, iCell) + &
+ (1.0_RKIND - alpha) * zMid(iLow, iCell)
+ end if
+
+ end do
+
+ end do
+
+ block => block % next
+ end do
+ LIGHT_DEBUG_WRITE('compute_velocity_on_potentialdensity_surface end')
+
+ end subroutine compute_velocity_on_potentialdensity_surface !}}}
+
+!***********************************************************************
+!
+! routine initialize_particle_properties
+!
+!> \brief Initialize particle properties
+!> \author Phillip Wolfram
+!> \date 09/24/2014
+!> \details
+!> This routine initializes particle data for
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+ subroutine initialize_particle_properties(domain, timeLevel, err)!{{{
+
+ implicit none
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(in) :: timeLevel
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ type (dm_info) :: dminfo
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: scratchPool
+ type (mpas_pool_type), pointer :: diagnosticsPool
+ type (mpas_pool_type), pointer :: lagrPartTrackFieldsPool, lagrPartTrackCellsPool, lagrPartTrackScratchPool
+ integer, dimension(:), pointer :: cellOwnerBlock
+ integer, pointer :: currentBlock, ioBlock, indexToParticleID, transfered
+ integer :: currentProc, ioProc
+ type (mpas_particle_list_type), pointer :: particlelist
+ type (mpas_particle_type), pointer :: particle
+
+ real (kind=RKIND), dimension(3) :: particlePosition, particleVelocity
+ real (kind=RKIND), pointer :: xParticle, yParticle, zParticle, lonVel, latVel, buoyancyParticle, sumU, sumV, sumUU, &
+ sumUV, sumVV
+ real (kind=RKIND), dimension(3) :: xSubStep, diffSubStep, diffParticlePosition
+ real (kind=RKIND), pointer :: zLevelParticle
+ real (kind=RKIND), dimension(:,:), pointer :: zTop, vertVelocityTop, zMid, areaBArray
+ real (kind=RKIND), dimension(:), pointer :: bottomDepth
+ type (field2DReal), pointer :: normalVelocity, uVertexVelocity, vVertexVelocity, wVertexVelocity, layerThickness
+
+ real (kind=RKIND), dimension(:,:), pointer :: uVertexVelocityArray, vVertexVelocityArray, wVertexVelocityArray, buoyancy, &
+ buoyancyTimeInterp, potentialDensity
+
+ real(kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell
+ real(kind=RKIND), dimension(:), pointer :: xVertex, yVertex, zVertex
+
+ integer, dimension(:,:), pointer :: verticesOnCell, boundaryVertex
+ integer, dimension(:), pointer :: maxLevelCell
+
+ integer theVertex, iLevel, iLevelBuoyancy, aVertex, &
+ nSteps, timeStep, subStep, subStepOrder, timeInterpOrder, aTimeLevel, nCellVertices, blockProc, arrayIndex
+ integer, pointer :: nCells, nVertLevels
+ integer, dimension(:), pointer :: nCellVerticesArray
+ integer, dimension(:,:), pointer :: cellsOnCell
+ logical, dimension(:,:), pointer :: ioProcRecvList
+ logical, dimension(:), pointer :: ioProcSendList
+ logical, pointer :: onSphere
+
+ real (kind=RKIND), dimension(4) :: kWeightK, kWeightKVert
+ real (kind=RKIND), dimension(3,4) :: kWeightX
+ real (kind=RKIND), dimension(4) :: kWeightXVert
+ real (kind=RKIND), dimension(4) :: kWeightT, kWeightTVert
+ real (kind=RKIND), dimension(3,5) :: kCoeff
+ real (kind=RKIND), dimension(5) :: kCoeffVert
+ real (kind=RKIND), dimension(2) :: timeCoeff
+ real (kind=RKIND) :: dt, dtSim, tSubStep
+ real (kind=RKIND), pointer :: dtParticle
+ real (kind=RKIND) :: zSubStep
+ real (kind=RKIND) :: diffSubStepVert, diffParticlePositionVert, particleVelocityVert, verticalVelocityInterp
+ real (kind=RKIND) :: buoyancyInterp
+ real (kind=RKIND), pointer :: sphereRadius
+ integer, pointer :: verticalTreatment, vertexReconstMethod, timeIntegration, indexLevel, filterNum, iCell
+
+ err = 0
+
+ dminfo = domain % dminfo
+
+ block => domain % blocklist
+ do while (associated(block)) !{{{
+ ! allocate scratch memory / setup pointers / get block
+ call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
+ call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackFields', lagrPartTrackFieldsPool)
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackScratch', lagrPartTrackScratchPool)
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackCells', lagrPartTrackCellsPool)
+
+ ! particlelist should be stored in the structs pool probably (need to seriously rework the code!)
+ particlelist => block % particlelist
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'zCell', zCell)
+ call mpas_pool_get_array(meshPool, 'xVertex', xVertex)
+ call mpas_pool_get_array(meshPool, 'yVertex', yVertex)
+ call mpas_pool_get_array(meshPool, 'zVertex', zVertex)
+ call mpas_pool_get_array(lagrPartTrackCellsPool, 'wachspressAreaB', areaBArray)
+ call mpas_pool_get_array(diagnosticsPool, 'zTop', zTop)
+ call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
+ call mpas_pool_get_array(diagnosticsPool, 'vertVelocityTop', vertVelocityTop)
+ call mpas_pool_get_array(diagnosticsPool, 'potentialDensity', buoyancyTimeInterp)
+
+ call mpas_pool_get_field(statePool, 'normalVelocity', normalVelocity, timeLevel=timeLevel)
+ call mpas_dmpar_exch_halo_field(normalVelocity)
+ call mpas_pool_get_field(statePool, 'layerThickness', layerThickness, timeLevel=timeLevel)
+
+ call mpas_pool_get_array(meshPool, 'verticesOnCell', verticesOnCell)
+ call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'boundaryVertex', boundaryVertex)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nCellVerticesArray)
+
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', onSphere)
+ call mpas_pool_get_config(meshPool, 'sphere_radius', sphereRadius)
+
+ !!!!!!!!!! LOOP OVER PARTICLES !!!!!!!!!!
+ ! update the particle position (just from initialized value for now)
+ ! this is a loop over particle list and its datastructures
+ do while(associated(particlelist)) !{{{
+ ! get pointers / option values
+ particle => particlelist % particle
+
+ ! get values {{{
+ call mpas_pool_get_array(particle % haloDataPool, 'xParticle', xParticle)
+ call mpas_pool_get_array(particle % haloDataPool, 'yParticle', yParticle)
+ call mpas_pool_get_array(particle % haloDataPool, 'zParticle', zParticle)
+ call mpas_pool_get_array(particle % haloDataPool, 'currentCell', iCell)
+ particlePosition(1) = xParticle
+ particlePosition(2) = yParticle
+ particlePosition(3) = zParticle
+
+ call mpas_pool_get_array(particle % haloDataPool, 'zLevelParticle', zLevelParticle)
+
+ call mpas_pool_get_array(particle % haloDataPool, 'verticalTreatment', verticalTreatment)
+ call mpas_pool_get_array(particle % haloDataPool, 'vertexReconstMethod', vertexReconstMethod)
+ call mpas_pool_get_array(particle % haloDataPool, 'indexLevel', indexLevel)
+ call mpas_pool_get_array(particle % haloDataPool, 'timeIntegration', timeIntegration)
+ call mpas_pool_get_array(particle % haloDataPool, 'dtParticle', dtParticle)
+ call mpas_pool_get_array(particle % haloDataPool, 'buoyancyParticle', buoyancyParticle)
+ call mpas_pool_get_array(particle % haloDataPool, 'indexToParticleID', indexToParticleID)
+
+ call mpas_pool_get_array(particle % haloDataPool, 'lonVel', lonVel)
+ call mpas_pool_get_array(particle % haloDataPool, 'latVel', latVel)
+ call mpas_pool_get_array(particle % haloDataPool, 'sumU', sumU)
+ call mpas_pool_get_array(particle % haloDataPool, 'sumV', sumV)
+ call mpas_pool_get_array(particle % haloDataPool, 'sumUU', sumUU)
+ call mpas_pool_get_array(particle % haloDataPool, 'sumUV', sumUV)
+ call mpas_pool_get_array(particle % haloDataPool, 'sumVV', sumVV)
+
+ !}}}
+
+ !!!!!!!!!! PERFORM SAMPLING (VELOCITY, TEMP, SALINITY, ETC) !!!!!!!!!!
+ ! this could be done just before the output anyway
+
+ ! need iCell computed for final position
+ ! need scalar values interpolated in time to yield single value
+ ! probably need to store zMid too, including flipping it
+ ! get updated cell location
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("get_validated_cell_idLPT")
+#endif
+ LIGHT_DEBUG_WRITE('sampling initialization')
+ call get_validated_cell_id(nCells, xCell,yCell,zCell , xVertex,yVertex,zVertex, &
+ particlePosition(1),particlePosition(2),particlePosition(3), meshPool, &
+ nCellVerticesArray, verticesOnCell, iCell, nCellVertices, cellsOnCell)
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("get_validated_cell_idLPT")
+#endif
+
+ if(verticalTreatment == 4) then !('buoyancySurface') !{{{
+ iLevelBuoyancy = mpas_get_vertical_id(maxLevelCell(iCell), buoyancyParticle, buoyancyTimeInterp(:,iCell))
+
+ ! interpolate the scalars now (assumes that scalar value is constant within a particular cell)
+ call interp_cell_scalars(iLevelBuoyancy, maxLevelCell(iCell), buoyancyParticle, buoyancyTimeInterp(:,iCell), &
+ zMid(:,iCell), zLevelParticle)
+ else
+ ! make sure final zLevelParticle is ok so that it can't extent past zMid range
+
+ iLevel = mpas_get_vertical_id(maxLevelCell(iCell), zLevelParticle, zMid(:,iCell))
+ end if
+
+ ! compute necessary information for autocorrelation !{{{
+ ! get the updated velocity
+ ! ensure that buoyancy is fixed for each run
+ buoyancyInterp = buoyancyParticle
+ ! we just need the last part of the velocity field interpolation because we are at the end of the timestep
+ timeInterpOrder = 1
+ timeCoeff(1) = 1.0_RKIND
+ timeCoeff(2) = 0.0_RKIND
+ ! return interpolated horizontal velocity "particleVelocity" and vertical velocity "particleVelocityVert"
+ ! noting we use the final positions
+ call velocity_time_interpolation(particleVelocity, particleVelocityVert, &
+ diagnosticsPool, lagrPartTrackFieldsPool, &
+ timeInterpOrder, timeCoeff, iCell, iLevel, buoyancyInterp, maxLevelCell, &
+ verticalTreatment, indexLevel, nCellVertices, verticesOnCell, boundaryVertex, &
+ particlePosition, zLevelParticle, zMid, zTop, vertVelocityTop, xVertex, yVertex, zVertex, &
+ meshPool, areaBArray)
+ ! convert horizontal velocity to lat/lon velocity
+
+ LIGHT_DEBUG_WRITE(iLevel COMMA particleVelocity)
+
+ ! store velocity for use in computing normalized autocorrelation offline
+
+ call mpas_convert_xyz_velocity_to_latlon(lonVel, latVel, particlePosition, particleVelocity)
+ !}}}
+
+ ! get next particle to process on the list
+ particlelist => particlelist % next
+ end do !}}}
+
+ ! get next block
+ block => block % next !}}}
+ end do !}}}
+
+ end subroutine initialize_particle_properties !}}}
+
+!***********************************************************************
+!
+! routine particle_vertical_treatment
+!
+!> \brief Vertical treatment to obtain correct horizontal velocity field
+!> \author Phillip Wolfram
+!> \date 03/31/2014
+!> \details
+!> This routine returns the vertex values which will be used in the
+!> Wachspress interoplant (uvCell) based on
+!> vertex velocities uVertexVelocity, vVertexVelocity, wVertexVelocity
+!> for a given cell which has nCellVertices which are determined from
+!> the list verticesOnCell.
+!> The routine collapses the vertical to a scalar.
+!
+!-----------------------------------------------------------------------
+ subroutine particle_vertical_treatment(verticalTreatment, indexLevel, nCellVertices, verticesOnCell, & !{{{
+ uVertexVelocity, vVertexVelocity, wVertexVelocity, &
+ uvCell, boundaryVertex, iLevel, nVertLevels, &
+ zLoc, zMid, zTop, phiInterp, phiMid, vertVelocityTop, vertVelocityInterp)
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ uVertexVelocity, vVertexVelocity, wVertexVelocity !< vertex velocities
+ integer, dimension(:), intent(in) :: verticesOnCell !< list of vertex indices on cell
+ integer, intent(in) :: nCellVertices !< current cell and the number of cell vertices
+ integer, intent(in) :: iLevel !< vertical level / cell of zLoc
+ integer, intent(in) :: nVertLevels !< number of vertical levels
+ integer, intent(in) :: verticalTreatment !< vertical treatment encoded as int
+ integer, intent(in) :: indexLevel !< value of index for fixed index space
+ integer, dimension(:), intent(in) :: boundaryVertex !< boundary vertices for particular level
+ real (kind=RKIND), intent(in) :: zLoc !< location to interpolate
+ real (kind=RKIND), dimension(:), intent(in) :: zTop !< elevation of cell top
+ real (kind=RKIND), dimension(:), intent(in) :: zMid !< elevation of cell middle
+ real (kind=RKIND), intent(in) :: phiInterp !< buoyancy value to interpolate
+ real (kind=RKIND), dimension(:), intent(in) :: phiMid !< buoyancy values at cell mid points
+ real (kind=RKIND), dimension(:), intent(in) :: vertVelocityTop !< velocity at top of cell
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(:,:), intent(out) :: uvCell !< components of vertex velocity (vertically selected)
+ real (kind=RKIND), intent(out) :: vertVelocityInterp ! vertically interpolated velocity
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ integer :: aVertex, theVertex
+
+ vertVelocityInterp = 0.0_RKIND
+
+ verticalTreatmentCase: select case (verticalTreatment)
+
+ case (1) verticalTreatmentCase !('indexLevel') !{{{
+ ! get vertically interpolanted values for vertexes in cell
+ ! and form polygon vertex values
+ do aVertex = 1, nCellVertices
+ theVertex = verticesOnCell(aVertex)
+ ! assume that we only care about the top level for a surface drifter
+ ! assumes that velocity is constant in top half of the cell
+ uvCell(1,aVertex) = uVertexVelocity(indexLevel,theVertex)
+ uvCell(2,aVertex) = vVertexVelocity(indexLevel,theVertex)
+ uvCell(3,aVertex) = wVertexVelocity(indexLevel,theVertex)
+ end do
+
+ !! ensure that the boundary condition is enforced
+ !call zero_boundary_nodal_values(nCellVertices, verticesOnCell, &
+ ! boundaryVertex, uvUcell, uvVcell, uvWcell)
+
+ ! no vertical motion, just horizontal motion
+ return
+ !}}}
+
+ case (2) verticalTreatmentCase !('fixedZLevel') !{{{
+
+ ! interpolate the horizontal velocity based on z-levels
+ call interp_nodal_vectors(ncellvertices, verticesoncell, &
+ ilevel, nVertLevels, zLoc, zmid, &
+ uvertexvelocity, vvertexvelocity, wvertexvelocity, uvCell)
+
+ !! ensure that there is zero nodal velocity on the boundary
+ !call zero_boundary_nodal_values(nCellVertices, verticesOnCell, &
+ ! boundaryVertex, uvUcell, uvVcell, uvWcell)
+
+ ! no vertical motion, just horizontal motion
+ return
+ !}}}
+
+ case (3) verticalTreatmentCase !('passiveFloat') !{{{
+
+ ! interpolate the vertical velocity
+ vertVelocityInterp = interp_vert_velocity_to_zlevel( &
+ iLevel, zLoc, zTop, vertVelocityTop)
+
+ ! interpolate the horizontal velocity based on z-levels
+ call interp_nodal_vectors(ncellvertices, verticesoncell, &
+ ilevel, nVertLevels, zLoc, zmid, &
+ uvertexvelocity, vvertexvelocity, wvertexvelocity, uvCell)
+
+ !! ensure that there is zero nodal velocity on the boundary
+ !call zero_boundary_nodal_values(nCellVertices, verticesOnCell, &
+ ! boundaryVertex, uvUcell, uvVcell, uvWcell)
+
+ return
+ !}}}
+
+ case (4) verticalTreatmentCase !('buoyancySurface') !{{{
+ ! no vertical velocity required because there is not vertical integration for position
+
+ ! interpolate the horizontal velocity
+ call interp_nodal_vectors(ncellvertices, verticesoncell, &
+ ilevel, nVertLevels, phiInterp, phiMid, &
+ uvertexvelocity, vvertexvelocity, wvertexvelocity, uvCell)
+
+ ! ensure that there is zero nodal velocity on the boundary
+ !call zero_boundary_nodal_values(nCellVertices, verticesOnCell, &
+ ! boundaryVertex, uvUcell, uvVcell, uvWcell)
+
+ ! no vertical motion, just horizontal motion
+ return
+ !}}}
+
+ case (5) verticalTreatmentCase !('argoFloat') !{{{
+
+
+ !}}}
+
+ case default verticalTreatmentCase !{{{
+ LIGHT_ERROR_WRITE('Vertical treatment for particle integration unknown (' COMMA verticalTreatment COMMA ')!')
+ return
+ !}}}
+
+ end select verticalTreatmentCase
+
+ end subroutine particle_vertical_treatment!}}}
+
+!***********************************************************************
+!
+! routine velocity_time_interpolation
+!
+!> \brief Compute velocity interpolations, including in time
+!> \author Phillip Wolfram
+!> \date 09/12/2014
+!> \details
+!> This routine interpolates velocity in time and space to a particular
+!> location xSubStep
+!
+!-----------------------------------------------------------------------
+ subroutine velocity_time_interpolation(particleVelocity, particleVelocityVert, &
+ diagnosticsPool, lagrPartTrackFieldsPool, &
+ timeInterpOrder, timeCoeff, iCell, iLevel, buoyancyInterp, maxLevelCell, &
+ verticalTreatment, indexLevel, nCellVertices, verticesOnCell, boundaryVertex, &
+ xSubStep, zSubStep, zMid, zTop, vertVelocityTop, xVertex, yVertex, zVertex, meshPool, areaBArray) !{{{
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input variables
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), pointer, intent(in) :: diagnosticsPool, lagrPartTrackFieldsPool
+ integer, intent(in) :: timeInterpOrder
+ real (kind=RKIND), dimension(2), intent(in) :: timeCoeff
+ integer, intent(in) :: iCell
+ integer, dimension(:), intent(in) :: maxLevelCell
+ integer, intent(in) :: verticalTreatment
+ integer, pointer, intent(in) :: indexLevel
+ integer, intent(in) :: nCellVertices
+ integer, dimension(:,:), intent(in) :: verticesOnCell
+ integer, dimension(:,:), intent(in) :: boundaryVertex
+ real (kind=RKIND), intent(in) :: zSubStep
+ real (kind=RKIND), dimension(:,:), intent(in) :: zMid
+ real (kind=RKIND), dimension(:,:), intent(in) :: zTop
+ real (kind=RKIND), dimension(:,:), intent(in) :: vertVelocityTop
+ real (kind=RKIND), dimension(:,:), intent(in) :: areaBArray
+ real (kind=RKIND), dimension(:), intent(in) :: xVertex, yVertex, zVertex
+ real (kind=RKIND), dimension(3), intent(in) :: xSubStep
+ type (mpas_pool_type), pointer, intent(in) :: meshPool
+
+ !-----------------------------------------------------------------
+ ! input/output variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND), intent(in) :: buoyancyInterp
+ integer, intent(inout) :: iLevel
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(3), intent(out) :: particleVelocity
+ real (kind=RKIND), intent(out) :: particleVelocityVert
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ integer :: aVertex, aTimeLevel
+ real (kind=RKIND), dimension(:,:), pointer :: uVertexVelocityArray, vVertexVelocityArray, wVertexVelocityArray, buoyancy
+ real (kind=RKIND) :: verticalVelocityInterp
+ real(kind=RKIND), dimension(:), allocatable :: areaB
+ real(kind=RKIND), dimension(:,:), allocatable :: vertCoords
+ real(kind=RKIND), dimension(:,:), allocatable :: uvCell
+ logical, pointer :: on_a_sphere, is_periodic
+ real(kind=RKIND), pointer :: x_period, y_period
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("velocity_time_interpolationLPT")
+#endif
+
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+ call mpas_pool_get_config(meshPool, 'is_periodic', is_periodic)
+ call mpas_pool_get_config(meshPool, 'x_period', x_period)
+ call mpas_pool_get_config(meshPool, 'y_period', y_period)
+
+ ! allocations for particular cell !{{{
+ allocate(vertCoords(3,nCellVertices), uvCell(3,nCellVertices), areaB(nCellVertices))
+ !}}}
+
+ ! get horizontal vertex locations (noting that there may be a
+ ! bit of error because the particle could be at the top
+ ! of the cell or at the bottom of the cell)
+ do aVertex = 1, nCellVertices
+ if (on_a_sphere .or. .not. is_periodic) then
+ vertCoords(1,aVertex) = xVertex(verticesOnCell(aVertex,iCell))
+ vertCoords(2,aVertex) = yVertex(verticesOnCell(aVertex,iCell))
+ vertCoords(3,aVertex) = zVertex(verticesOnCell(aVertex,iCell))
+ else
+ vertCoords(1,aVertex) = mpas_fix_periodicity(xVertex(verticesOnCell(aVertex,iCell)), xSubStep(1), x_period)
+ vertCoords(2,aVertex) = mpas_fix_periodicity(yVertex(verticesOnCell(aVertex,iCell)), xSubStep(2), y_period)
+ vertCoords(3,aVertex) = zVertex(verticesOnCell(aVertex,iCell))
+ end if
+ areaB(aVertex) = areaBArray(iCell, aVertex)
+ end do
+
+ ! initialize velocities to 0
+ particleVelocity = 0.0_RKIND
+ particleVelocityVert = 0.0_RKIND
+
+ ! general interpolation for the velocity field
+ do aTimeLevel = 1, timeInterpOrder
+
+ ! define arrays!{{{
+ call mpas_pool_get_array(lagrPartTrackFieldsPool, 'uVertexVelocity', uVertexVelocityArray, timeLevel=aTimeLevel)
+ call mpas_pool_get_array(lagrPartTrackFieldsPool, 'vVertexVelocity', vVertexVelocityArray, timeLevel=aTimeLevel)
+ call mpas_pool_get_array(lagrPartTrackFieldsPool, 'wVertexVelocity', wVertexVelocityArray, timeLevel=aTimeLevel)
+ call mpas_pool_get_array(diagnosticsPool, 'potentialDensity', buoyancy)
+ !}}}
+
+ ! get final, interpolated particle velocity at this point (collapse to point)
+ if (verticalTreatment == 4) then
+ ! buoyancy case (not using zSubStep for interpolation / iLevel)
+ ! use existing code noting we need to flip the order to get the right iLevel
+
+ iLevel = mpas_get_vertical_id(maxLevelCell(iCell), buoyancyInterp, buoyancy(:,iCell))
+ LIGHT_DEBUG_WRITE('iLevel=' COMMA iLevel)
+ ! note, if buoyancyInterp out of range this will try to reorient the particle to the top / bottom but there
+ ! will definitely be some error with this type of computation because the buoyancy is not available at this location
+ ! the time interpolation, as a consequency, can mix velocities from different buoyancy surfaces in order to advect
+ ! the particle
+ !write(stderrUnit,*) 'iLevel = ', iLevel
+ end if
+
+ call particle_vertical_treatment(verticalTreatment, indexLevel, nCellVertices, verticesOnCell(:,iCell), &
+ uVertexVelocityArray, vVertexVelocityArray, wVertexVelocityArray, uvCell, boundaryVertex(iLevel,:), &
+ iLevel, maxLevelCell(iCell), zSubStep, zMid(:,iCell), zTop(:,iCell), buoyancyInterp, buoyancy(:,iCell), &
+ vertVelocityTop(:,iCell), verticalVelocityInterp)
+
+ ! vertical
+ particleVelocityVert = particleVelocityVert + &
+ timeCoeff(aTimeLevel) * verticalVelocityInterp
+
+ ! horizontal
+ ! timer commented out because it is used in more than just compute...
+#ifdef MPAS_DEBUG
+ call mpas_timer_start("part_horiz_interpLPT")
+#endif
+ LIGHT_DEBUG_WRITE('particleVelocityVert=' COMMA particleVelocityVert)
+ particleVelocity = particleVelocity + &
+ timeCoeff(aTimeLevel) * particle_horizontal_interpolation(nCellVertices, vertCoords, &
+ xSubStep, uvCell, meshPool, areaB)
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("part_horiz_interpLPT")
+#endif
+ LIGHT_DEBUG_WRITE('particleVelocity=' COMMA particleVelocity)
+
+
+ end do
+
+ ! deallocations of temp memory
+ deallocate(vertCoords, uvCell, areaB)
+
+#ifdef MPAS_DEBUG
+ call mpas_timer_stop("velocity_time_interpolationLPT")
+#endif
+
+ end subroutine velocity_time_interpolation !}}}
+
+ subroutine zero_autocorrelation_sums(domain) !{{{
+ implicit none
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+ ! local
+ type (block_type), pointer :: block
+ type (mpas_particle_list_type), pointer :: particlelist
+ type (mpas_particle_type), pointer :: particle
+ ! output variables (per particle)
+ real (kind=RKIND), pointer :: sumU, sumV, sumUU, sumUV, sumVV
+ integer, pointer :: currentCell
+
+ ! get the appropriate pools
+ block => domain % blocklist
+ do while (associated(block)) !{{{
+ particlelist => block % particlelist
+ do while(associated(particlelist)) !{{{
+ ! get pointers / option values
+ particle => particlelist % particle
+
+ ! get values (may want a flag for reinitialization in the future)
+ !call mpas_pool_get_array(particle % haloDataPool, 'sumU', sumU)
+ !call mpas_pool_get_array(particle % haloDataPool, 'sumV', sumV)
+ !call mpas_pool_get_array(particle % haloDataPool, 'sumUU', sumUU)
+ !call mpas_pool_get_array(particle % haloDataPool, 'sumUV', sumUV)
+ !call mpas_pool_get_array(particle % haloDataPool, 'sumVV', sumVV)
+ call mpas_pool_get_array(particle % haloDataPool, 'currentCell', currentCell)
+
+ ! initialize the values
+ !sumU = 0.0_RKIND
+ !sumV = 0.0_RKIND
+ !sumUU = 0.0_RKIND
+ !sumUV = 0.0_RKIND
+ !sumVV = 0.0_RKIND
+ currentCell = -1
+
+ ! get next particle to process on the list
+ particlelist => particlelist % next
+ end do !}}}
+
+ ! get next block
+ block => block % next
+ end do !}}}
+
+ end subroutine zero_autocorrelation_sums !}}}
+
+!***********************************************************************
+!
+! routine particle_horizontal_interpolation
+!
+!> \brief Horizontal treatment to obtain correct velocity field at point
+!> \author Phillip Wolfram
+!> \date 03/31/2014
+!> \details
+!> This routine returns the point values which will be used in the
+!> particle interpolation time integration based on
+!> vertex velocities uVertexVelocity, vVertexVelocity, wVertexVelocity
+!
+!-----------------------------------------------------------------------
+ function particle_horizontal_interpolation(nCellVertices, vertCoords, & !{{{
+ pointInterp, uVertex, meshPool, areaB)
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input variables
+ !-----------------------------------------------------------------
+ integer, intent(in) :: nCellVertices
+ real (kind=RKIND), dimension(3, nCellVertices), intent(in) :: vertCoords
+ real (kind=RKIND), dimension(3), intent(in) :: pointInterp
+ real (kind=RKIND), dimension(3, nCellVertices), intent(in) :: uVertex
+ real (kind=RKIND), dimension(nCellVertices), intent(in) :: areaB
+ type (mpas_pool_type), pointer :: meshPool
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(nCellVertices) :: lambda
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(3) :: particle_horizontal_interpolation
+
+
+ ! get lambda coordinate for particle
+ lambda = mpas_wachspress_coordinates(nCellVertices, vertCoords , &
+ pointInterp, meshPool, areaB)
+ LIGHT_DEBUG_ALL_WRITE('lambda=' COMMA lambda)
+ LIGHT_DEBUG_ALL_WRITE('uVertex=' COMMA uVertex(1,:))
+ LIGHT_DEBUG_ALL_WRITE('vVertex=' COMMA uVertex(2,:))
+ LIGHT_DEBUG_ALL_WRITE('wVertex=' COMMA uVertex(3,:))
+
+ ! update particle velocities via horizontal interpolation
+ particle_horizontal_interpolation(1) = mpas_wachspress_interpolate(lambda, uVertex(1,:))
+ particle_horizontal_interpolation(2) = mpas_wachspress_interpolate(lambda, uVertex(2,:))
+ particle_horizontal_interpolation(3) = mpas_wachspress_interpolate(lambda, uVertex(3,:))
+
+ end function particle_horizontal_interpolation !}}}
+
+!***********************************************************************
+!
+! routine particle_horizontal_movement
+!
+!> \brief Compute horizontal movement for particle so particle stays
+!> in spherical shell
+!> \author Phillip Wolfram
+!> \date 05/20/2014
+!> \details
+!> This routine returns the particle position pParticle corresponding
+!> to an initial particle position pParticle for a Cartesian movemnt
+!> dpParticle. If the calculation is onSphere, then the distance
+!> |dpParticle| must be along the great circle route of pParticle
+!> and the projection of pParticle + dpParticle on the spherical
+!> shell corresponding to pParticle.
+!
+!-----------------------------------------------------------------------
+ subroutine particle_horizontal_movement(meshPool, pParticle, dpParticle) !{{{
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(:), intent(in) :: dpParticle
+ type (mpas_pool_type), intent(in), pointer :: meshPool
+
+ !-----------------------------------------------------------------
+ ! input / output variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(:), intent(inout) :: pParticle
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND) :: lenPath, arcLen
+ real (kind=RKIND) :: radiusShell
+ real (kind=RKIND), dimension(size(pParticle)) :: pParticleTemp
+ real (kind=RKIND), dimension(size(pParticle)) :: pParticleInterp
+ real (kind=RKIND) :: alpha
+ real (kind=RKIND), parameter :: eps=1e-10_RKIND
+ logical, pointer :: onSphere, is_periodic
+ real(kind=RKIND), pointer :: x_period, y_period
+ character (len=StrKIND) :: message
+ ! choosen based on the parameters, note that we loose about 6 - 7 units of precision because R is so large!
+ ! therefore, eps = 1e-10 is conservative, if not too high! this just helps with numerical stability
+ !dpParticle = -4.2428037617887103E-011 4.3076544298828060E-011 5.0760704444480953E-011
+ !pParticle = 4444887.2990309987 -891565.00525021972 4476665.3916420965
+ !pParticleTemp = 4444887.2990309987 -891565.00525021972 4476665.3916420965
+ !mpas_arc_length = 0.0000000000000000 lenPath = 7.8945399869363434E-011
+
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', onSphere)
+ call mpas_pool_get_config(meshPool, 'is_periodic', is_periodic)
+ call mpas_pool_get_config(meshPool, 'x_period', x_period)
+ call mpas_pool_get_config(meshPool, 'y_period', y_period)
+
+ ! may need a condition to determine if we need to project back to the sphere
+ if(onSphere) then
+ ! need to make sure new point is on the spherical shell
+
+ ! get path length
+ LIGHT_DEBUG_ALL_WRITE('dpParticle = ' COMMA dpParticle)
+ lenPath = sqrt(sum(dpParticle*dpParticle))
+
+ ! consider case of particle not moving (need to have this code here in general)
+ !if (lenPath < eps) then
+ ! this is ok because this is only the case if the points are the same. If there is a
+ ! numerical instability it probably should be handled differently.
+ if (lenPath < eps) then
+ return
+ end if
+
+ ! get radius of particle's horizontal shell
+ radiusShell = sqrt(sum(pParticle*pParticle))
+
+ ! project endpoint to spherical shell containing pParticle
+ pParticleTemp = pParticle + dpParticle
+ pParticleTemp = ( radiusShell / sqrt(sum(pParticleTemp*pParticleTemp)) ) * pParticleTemp
+
+ ! compute alpha parameter for spherical interpolant / extrapolant
+ LIGHT_DEBUG_ALL_WRITE('dpParticle = ' COMMA dpParticle)
+ LIGHT_DEBUG_ALL_WRITE('pParticle = ' COMMA pParticle)
+ LIGHT_DEBUG_ALL_WRITE('pParticleTemp = ' COMMA pParticleTemp)
+ write(message, *) 'mpas_arc_length = ', mpas_arc_length( pParticle(1), pParticle(2), pParticle(3), &
+ pParticleTemp(1), pParticleTemp(2), pParticleTemp(3)), 'lenPath = ', lenPath
+ LIGHT_DEBUG_ALL_WRITE(message)
+ arcLen = mpas_arc_length(pParticle(1),pParticle(2),pParticle(3) , pParticleTemp(1),pParticleTemp(2),pParticleTemp(3))
+ if (arcLen > eps) then
+ alpha = lenPath / arcLen
+ else
+ return
+ endif
+
+ ! compute final position based on spherical interpolant
+ call mpas_spherical_linear_interp(pParticleInterp, pParticle, pParticleTemp, alpha)
+ pParticle = pParticleInterp
+ else
+ ! we are just on a plane so there is no need for spherical interpolation to keep
+ ! the new particle location on a spherical shell
+ pParticle = pParticle + dpParticle
+
+ ! periodic fix to make sure particle advection stays in domain
+ if (is_periodic) then
+ pParticle(1) = mpas_fix_periodicity(pParticle(1), x_period/2.0_RKIND, x_period)
+ pParticle(2) = mpas_fix_periodicity(pParticle(2), y_period/2.0_RKIND, y_period)
+ !pParticle(3) = pParticle(3)
+ end if
+ endif
+
+ end subroutine particle_horizontal_movement!}}}
+
+!***********************************************************************
+!
+! routine interp_cell_scalars
+!
+!> \brief Interpolate cell scalar vector based on a criteria (z-level, buoyancy, etc)
+!> \author Phillip Wolfram
+!> \date 06/18/2014
+!> \details
+!> This routine interpolates cell scalar vector to a particular scalar value
+!> depending upon a criteria such as z-level, buoyancy, etc.
+!
+!-----------------------------------------------------------------------
+ subroutine interp_cell_scalars(iLevel, nVertLevels, zInterp, zVals, & !{{{
+ phiVals, phiInterp)
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(:), intent(in) :: zVals !< scalar values (x) on cell for interpolant
+ integer, intent(in) :: iLevel !< vertical level / cell of phiInterp
+ integer, intent(in) :: nVertLevels !< number of vertical levels
+ real (kind=RKIND), intent(in) :: zInterp !< location to interpolate
+ real (kind=RKIND), dimension(:), intent(in) :: phiVals !< values at elevation of cell middle (where vertex
+ !< velocities are defined)
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND), intent(out) :: phiInterp !< interpolated cell scalar
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND) :: alpha
+ integer :: aVertex, theVertex, iHigh, iLow
+ real (kind=RKIND) :: eps=1e-14
+
+ if(iLevel < 1) then
+ ! top level
+ if (iLevel == 0) then
+ phiInterp = phiVals(nVertLevels)
+ ! bottom level
+ else if (iLevel == -1) then
+ phiInterp = phiVals(1)
+ end if
+ else
+ call get_bounding_indices(iLow, iHigh, zInterp, zVals, iLevel, nVertLevels)
+
+ ! interpolate to vertical level now
+ if(abs(zVals(iHigh) - zVals(iLow)) < eps) then
+ ! we really can't distinguish between each of these points numerically, just take the
+ ! average of both
+ alpha = 0.5_RKIND
+ else
+ ! interpolate to vertical level now
+ alpha = (zInterp - zVals(iLow))/(zVals(iHigh) - zVals(iLow))
+ end if
+
+ ! interpolate to the vertical level
+ phiInterp = alpha * phiVals(iHigh) + (1.0_RKIND - alpha) * phiVals(iLow)
+ end if
+
+ end subroutine interp_cell_scalars!}}}
+
+!***********************************************************************
+!
+! routine interp_nodal_scalars
+!
+!> \brief Interpolate nodal scalar vector based on a criteria (z-level, buoyancy, etc)
+!> \author Phillip Wolfram
+!> \date 05/27/2014
+!> \details
+!> This routine interpolates nodal scalar vector to a particular scalar value
+!> depending upon a criteria such as z-level, buoyancy, etc.
+!
+!-----------------------------------------------------------------------
+ subroutine interp_nodal_scalars(nCellVertices, verticesOnCell, & !{{{
+ iLevel, nVertLevels, phiInterp, phiVals, &
+ scalarVec, vertexScalar)
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(:,:), intent(in) :: scalarVec !< vertex scalar
+ integer, dimension(:), intent(in) :: verticesOnCell !< list of vertex indices on cell
+ integer, intent(in) :: nCellVertices !< number of cell vertices
+ integer, intent(in) :: iLevel !< vertical level / cell of phiInterp
+ integer, intent(in) :: nVertLevels !< number of vertical levels
+ real (kind=RKIND), intent(in) :: phiInterp !< location to interpolate
+ real (kind=RKIND), dimension(:), intent(in) :: phiVals !< values at elevation of cell middle (where vertex
+ !< velocities are defined)
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(:), intent(out) :: vertexScalar !< components of vertex scalar (interpolated)
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND) :: alpha
+ integer :: aVertex, theVertex, iHigh, iLow
+
+ call get_bounding_indices(iLow, iHigh, phiInterp, phiVals, iLevel, nVertLevels)
+
+ ! interpolate to vertical level now
+ alpha = (phiInterp - phiVals(iLow))/(phiVals(iHigh) - phiVals(iLow))
+
+ ! interpolate to the vertical level
+ do aVertex = 1, nCellVertices
+ theVertex = verticesOnCell(aVertex)
+ ! assume for now that we only care about the top level for a surface drifter
+ vertexScalar(aVertex) = alpha * scalarVec(iHigh, theVertex) + (1.0_RKIND - alpha) * scalarVec(iLow, theVertex)
+ end do
+
+ end subroutine interp_nodal_scalars!}}}
+
+!***********************************************************************
+!
+! routine interp_nodal_vectors
+!
+!> \brief Interpolate nodal vector to scalar based on a criteria (z-level, buoyancy, etc)
+!> \author Phillip Wolfram
+!> \date 05/27/2014
+!> \details
+!> This routine interpolates nodal vectors to a particular scalar value
+!> depending upon a criteria such as z-level, buoyancy, etc.
+!
+!-----------------------------------------------------------------------
+ subroutine interp_nodal_vectors(nCellVertices, verticesOnCell, & !{{{
+ iLevel, nVertLevels, phiInterp, phiVals, &
+ uVertexVelocity, vVertexVelocity, wVertexVelocity, uvCell)
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ uVertexVelocity, vVertexVelocity, wVertexVelocity !< vertex velocities
+ integer, dimension(:), intent(in) :: verticesOnCell !< list of vertex indices on cell
+ integer, intent(in) :: nCellVertices !< number of cell vertices
+ integer, intent(in) :: iLevel !< vertical level / cell of phiInterp
+ integer, intent(in) :: nVertLevels !< number of vertical levels
+ real (kind=RKIND), intent(in) :: phiInterp !< location to interpolate
+ real (kind=RKIND), dimension(:), intent(in) :: phiVals !< values at elevation of cell middle (where vertex
+ !< velocities are defined)
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(:,:), intent(out) :: uvCell !< components of vertex velocity (vertically selected)
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND) :: alpha
+ integer :: aVertex, theVertex, iHigh, iLow
+ real (kind=RKIND) :: eps=1e-14_RKIND
+
+ uvCell = 0.0_RKIND
+
+ !write(stderrUnit,*) 'interp'
+ if(iLevel < 1) then
+ if(iLevel == 0) then
+ !write(stderrUnit,*) 'nCellVertices = ', nCellVertices, 'buoyancyInterp= ', phiInterp
+ do aVertex = 1, nCellVertices
+ theVertex = verticesOnCell(aVertex)
+ !write(stderrUnit,*) maxloc(phiVals,1), phiVals(1:nVertLevels), uVertexVelocity(1:nVertLevels,theVertex)
+ uvCell(1,aVertex) = uVertexVelocity(maxloc(phiVals(1:nVertLevels),1), theVertex)
+ uvCell(2,aVertex) = vVertexVelocity(maxloc(phiVals(1:nVertLevels),1), theVertex)
+ uvCell(3,aVertex) = wVertexVelocity(maxloc(phiVals(1:nVertLevels),1), theVertex)
+ end do
+ else if(iLevel == -1) then
+ do aVertex = 1, nCellVertices
+ theVertex = verticesOnCell(aVertex)
+ uvCell(1,aVertex) = uVertexVelocity(minloc(phiVals(1:nVertLevels),1), theVertex)
+ uvCell(2,aVertex) = vVertexVelocity(minloc(phiVals(1:nVertLevels),1), theVertex)
+ uvCell(3,aVertex) = wVertexVelocity(minloc(phiVals(1:nVertLevels),1), theVertex)
+ end do
+ end if
+ else
+ call get_bounding_indices(iLow, iHigh, phiInterp, phiVals, iLevel, nVertLevels)
+
+ ! interpolate to vertical level now
+ if(abs(phiVals(iHigh) - phiVals(iLow)) < eps) then
+ ! we really can't distinguish between each of these points numerically, just take the
+ ! average of both
+ alpha = 0.5_RKIND
+ else
+ alpha = (phiInterp - phiVals(iLow))/(phiVals(iHigh) - phiVals(iLow))
+ end if
+
+ ! interpolate to the vertical level
+ do aVertex = 1, nCellVertices
+ theVertex = verticesOnCell(aVertex)
+ ! assume for now that we only care about the top level for a surface drifter
+ uvCell(1,aVertex) = alpha * uVertexVelocity(iHigh, theVertex) + &
+ (1.0_RKIND - alpha) * uVertexVelocity(iLow, theVertex)
+ uvCell(2,aVertex) = alpha * vVertexVelocity(iHigh, theVertex) + &
+ (1.0_RKIND - alpha) * vVertexVelocity(iLow, theVertex)
+ uvCell(3,aVertex) = alpha * wVertexVelocity(iHigh, theVertex) + &
+ (1.0_RKIND - alpha) * wVertexVelocity(iLow, theVertex)
+ end do
+ end if
+
+ end subroutine interp_nodal_vectors!}}}
+
+!***********************************************************************
+!
+! routine zero_boundary_nodal_values
+!
+!> \brief Enfore boundary condition for nodal value, setting to 0
+!> \author Phillip Wolfram
+!> \date 05/27/2014
+!> \details
+!> This routine ensures zero Dirchilet boundary conditions
+!> (commonly for the nodal velocity)
+!
+!-----------------------------------------------------------------------
+ subroutine zero_boundary_nodal_values(nCellVertices, verticesOnCell, & !{{{
+ boundaryVertex, uvCell)
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input variables
+ !-----------------------------------------------------------------
+ integer, dimension(:), intent(in) :: verticesOnCell !< list of vertex indices on cell
+ integer, intent(in) :: nCellVertices !< number of cell vertices
+ integer, dimension(:), intent(in) :: boundaryVertex !< boundary vertices for particular level
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(:,:), intent(out) :: uvCell !< components of vertex velocity (vertically selected)
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ integer :: aVertex, theVertex
+
+ ! make sure to mask all boundary vertexes to be zero to enforce boundary conditions
+ do aVertex = 1, nCellVertices
+ theVertex = verticesOnCell(aVertex)
+ !write(stderrUnit,*) boundaryVertex(theVertex)
+ ! make all the boundary values be zero to prevent particle from horizontally leaving cell
+ uvCell(1,aVertex) = uvCell(1,aVertex) * (1-boundaryVertex(theVertex))
+ uvCell(2,aVertex) = uvCell(2,aVertex) * (1-boundaryVertex(theVertex))
+ uvCell(3,aVertex) = uvCell(3,aVertex) * (1-boundaryVertex(theVertex))
+ end do
+
+ end subroutine zero_boundary_nodal_values!}}}
+
+!***********************************************************************
+!
+! routine get_bounding_indices
+!
+!> \brief Get indices for high and low values for interpolation
+!> \author Phillip Wolfram
+!> \date 05/28/2014
+!> \details
+!> This routine returns the indices (iLow, iHigh) on either side of phiInterp
+!
+!-----------------------------------------------------------------------
+ subroutine get_bounding_indices(iLow, iHigh, phiInterp, phiVals, iLevel, nVertLevels) !{{{
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input variables
+ !-----------------------------------------------------------------
+ integer, intent(in) :: iLevel !< vertical level / cell of phiInterp
+ integer, intent(in) :: nVertLevels !< number of vertical levels
+ real (kind=RKIND), intent(in) :: phiInterp !< location to interpolate
+ real (kind=RKIND), dimension(:), intent(in) :: phiVals !< values at elevation of cell middle (where vertex
+ !< velocities are defined)
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ integer, intent(out) :: iLow, iHigh !< interpolation indices
+
+ ! assumes increasing index is in decreasing phi space, and phiInterp in range of phiVals
+ !write(stderrUnit,*) 'phiInterp = ', phiInterp, 'phiVals = ', phiVals, 'nVertLevels = ', nVertLevels, 'iLevel = ', iLevel
+ if(phiInterp > phiVals(iLevel)) then
+ iHigh = iLevel + 1
+ iLow = iLevel
+ else
+ iHigh = iLevel
+ iLow = iLevel + 1
+ end if
+
+ ! check to make sure points are in range
+ ! optimization point: smarter algorithm won't have to call this ever
+ if(.not.((phiInterp <= phiVals(iHigh)) .and. (phiInterp >= phiVals(iLow)))) then
+ !write(stderrUnit,*) 'fast interpolation failed, trying general, brute force search for interpolation bounds'
+ !write(stderrUnit,*) 'iLow = ', iLow, ' iHigh = ', iHigh
+ !write(stderrUnit,*) 'phiInterp = ', phiInterp , ' phiLow =', phiVals(iLow), ' phiHigh = ', phiVals(iHigh)
+ call get_bounding_indices_brute_force(nVertLevels, phiInterp, phiVals, iLow, iHigh)
+ end if
+
+ end subroutine get_bounding_indices !}}}
+
+!***********************************************************************
+!
+! routine get_bounding_indices_brute_force
+!
+!> \brief Get the interpolation bounds via brute force
+!> \author Phillip Wolfram
+!> \date 05/27/2014
+!> \details
+!> This routine finds the interpolation bounds directly (brute force).
+!
+!-----------------------------------------------------------------------
+ subroutine get_bounding_indices_brute_force(nVertLevels, phiInterp, phiVals, iLow, iHigh) !{{{
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input variables
+ !-----------------------------------------------------------------
+ integer, intent(in) :: nVertLevels !< number of vertical levels
+ real (kind=RKIND), intent(in) :: phiInterp !< location to interpolate
+ real (kind=RKIND), dimension(:), intent(in) :: phiVals !< values at elevation of cell middle (where
+ !< vertex velocities are defined)
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ integer, intent(out) :: iLow, iHigh !< indexes for the high and low components for the interpolant
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ integer :: aLevel
+ character (len=StrKIND) :: message
+
+ ! make no assumptions
+ do aLevel = 1, nVertLevels-1
+ if(phiVals(aLevel) <= phiInterp .and. phiInterp <= phiVals(aLevel+1)) then
+ iLow = aLevel
+ iHigh = aLevel+1
+ exit
+ else if (phiVals(aLevel+1) <= phiInterp .and. phiInterp <= phiVals(aLevel)) then
+ iLow = aLevel+1
+ iHigh = aLevel
+ exit
+ end if
+ end do
+
+#ifdef MPAS_DEBUG
+ if(phiVals(iLow) <= phiInterp .and. phiInterp <= phiVals(iHigh)) then
+ ! we are ok
+ LIGHT_DEBUG_ALL_WRITE('brute force interpolation successful')
+ LIGHT_DEBUG_ALL_WRITE('iLow = ' COMMA iLow COMMA ' iHigh = ' COMMA iHigh)
+ write(message, *) 'phiInterp = ', phiInterp, ' phiLow =', phiVals(iLow), ' phiHigh = ', phiVals(iHigh)
+ LIGHT_DEBUG_ALL_WRITE(message)
+ else
+ write(stderrUnit,*) 'brute force interpolation failed with phiInterp = ', phiInterp, ' phiLow = ', phiVals(iLow), &
+ ' phiHigh = ', phiVals(iHigh)
+ LIGHT_DEBUG_ALL_WRITE(' phiVals = ' COMMA phiVals(1:nVertLevels))
+ end if
+
+ write(stderrUnit,*) 'Warning!: brute force interpolation used, boundary condition may be wrong!'
+#endif
+
+ end subroutine get_bounding_indices_brute_force!}}}
+
+!***********************************************************************
+!
+! routine interp_vert_velocity_to_zlevel
+!
+!> \brief Interpolate the vertical velcity to a z level
+!> \author Phillip Wolfram
+!> \date 05/08/2014
+!> \details
+!> This routine interpolates the vertical velocity to a particular
+!> z-level.
+!
+!-----------------------------------------------------------------------
+ real (kind=RKIND) function interp_vert_velocity_to_zlevel( & !{{{
+ iLevel, zSubStep, zTop, vertVelocityTop)
+
+ implicit none
+ !-----------------------------------------------------------------
+ ! input variables
+ !-----------------------------------------------------------------
+ integer, intent(in) :: iLevel !< vertical level / cell of zSubStep
+ real (kind=RKIND), intent(in) :: zSubStep !< location to interpolate
+ real (kind=RKIND), dimension(:), intent(in) :: zTop !< elevation of cell top
+ real (kind=RKIND), dimension(:), intent(in) :: vertVelocityTop !< vertical velocity at top of cell
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ !real (kind=RKIND), intent(out) :: interp_vert_velocity_to_zlevel
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ real (kind=RKIND) :: alpha
+
+ if(iLevel < 1) then
+ if(iLevel == 0) then
+ interp_vert_velocity_to_zlevel = vertVelocityTop(maxloc(zTop,1))
+ else if(iLevel == -1) then
+ interp_vert_velocity_to_zlevel = vertVelocityTop(minloc(zTop,1))
+ end if
+ else
+ ! interpolate the velocity [assumes zTop(iLevel+1) <= zSubStep <= zTop(iLevel)]
+ if (zTop(iLevel+1) <= zSubStep .and. zSubStep <= zTop(iLevel)) then
+ alpha = (zSubStep - zTop(iLevel+1))/(zTop(iLevel)- zTop(iLevel+1))
+ else if (zTop(iLevel) <= zSubStep .and. zSubStep <= zTop(iLevel+1)) then
+ alpha = (zSubStep - zTop(iLevel))/(zTop(iLevel+1)- zTop(iLevel))
+#ifdef MPAS_DEBUG
+ else
+ write(stderrUnit,*) 'Error with vertical velocity interpolation!'
+#endif
+ end if
+ interp_vert_velocity_to_zlevel = alpha * vertVelocityTop(iLevel)+ (1.0_RKIND - alpha) * vertVelocityTop(iLevel+1)
+ end if
+
+ end function interp_vert_velocity_to_zlevel!}}}
+
+!***********************************************************************
+!
+! routine time_interp_field
+!
+!> \brief Interpolate a field in time
+!> \author Phillip Wolfram
+!> \date 07/16/2014
+!> \details
+!> This routine interpolates a field in time over multiple levels.
+!
+!-----------------------------------------------------------------------
+ subroutine time_interp_field(basePool, timeInterpOrder, timeCoeff, field, fieldname) !{{{
+ implicit none
+
+ type (mpas_pool_type), pointer, intent(in) :: basePool
+ integer, intent(in) :: timeInterpOrder
+ real (kind=RKIND), dimension(:), intent(in) :: timeCoeff
+ real (kind=RKIND), dimension(:,:), pointer, intent(out) :: field
+ character(len=*), intent(in) :: fieldname
+
+ real (kind=RKIND), dimension(:,:), pointer :: tempfield
+ integer :: aTimeLevel
+
+ field = 0.0_RKIND
+ do aTimeLevel = 1, timeInterpOrder
+ call mpas_pool_get_array(basePool, trim(fieldname), tempfield, timeLevel=aTimeLevel)
+ field = field + timeCoeff(aTimeLevel) * tempfield
+ end do
+
+ end subroutine time_interp_field !}}}
+!}}}
+
+end module ocn_lagrangian_particle_tracking
+
+! vim: foldmethod=marker
diff --git a/src/core_ocean/analysis_members/mpas_ocn_lagrangian_particle_tracking_interpolations.F b/src/core_ocean/analysis_members/mpas_ocn_lagrangian_particle_tracking_interpolations.F
new file mode 100644
index 0000000000..c6611ce43f
--- /dev/null
+++ b/src/core_ocean/analysis_members/mpas_ocn_lagrangian_particle_tracking_interpolations.F
@@ -0,0 +1,646 @@
+! 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
+!
+!***********************************************************************
+!
+! ocn_lagrangian_particle_tracking_interpolations
+!
+!> \brief LIGHT Vector reconstruction and filtering module
+!> \author Phillip J. Wolfram
+!> \date 07/21/2015
+!> \details
+!> This module provides routines for performing vector interpolations
+!> and spatial filtering.
+!
+!-----------------------------------------------------------------------
+module ocn_lagrangian_particle_tracking_interpolations
+
+ use mpas_derived_types
+ use mpas_constants
+ use mpas_rbf_interpolation
+ use mpas_geometry_utils
+ use mpas_vector_reconstruction
+ use mpas_dmpar
+
+ implicit none
+
+ contains
+
+!***********************************************************************
+!
+! routine ocn_vertex_reconstruction
+!
+!> \brief Reconstruct vertex velocity driver / interface
+!> \author Phillip Wolfram
+!> \date 03/27/2014
+!> \details
+!> Purpose: reconstruct vector field at vertex locations based on
+!> particular choice of reconstruction method
+!> Input: mesh meta data and vector component data residing at cell edges
+!> initialize_weights logical is to determine if weights should be initialized
+!> Output: reconstructed vector field (measured in X,Y,Z) located at vertices
+!-----------------------------------------------------------------------
+ subroutine ocn_vertex_reconstruction(filterNum, meshPool, scratchPool, particleCellPool, layerThickness, u, & !{{{
+ uvReconstructX, uvReconstructY, uvReconstructZ )
+
+ implicit none
+
+ type (mpas_pool_type), pointer, intent(in) :: meshPool !< Input: Mesh information
+ type (mpas_pool_type), pointer, intent(in) :: scratchPool !< Input: Scratch variables
+ type (mpas_pool_type), pointer, intent(in) :: particleCellPool !< Input: particlefield variables
+ integer, intent(in) :: filterNum ! filtering strength employed
+ real (kind=RKIND), dimension(:,:), pointer, intent(in) :: layerThickness !< Input: layerThickness on cells
+ real (kind=RKIND), dimension(:,:), pointer, intent(in) :: u !< Input: Velocity field on edges (normalVelocity)
+ type (field2DReal), pointer, intent(out) :: uvReconstructX !< Output: X Component of velocity reconstructed to vertices
+ type (field2DReal), pointer, intent(out) :: uvReconstructY !< Output: Y Component of velocity reconstructed to vertices
+ type (field2DReal), pointer, intent(out) :: uvReconstructZ !< Output: Z Component of velocity reconstructed to vertices
+
+ ! could add additional reconstruction techniques here with switch if desired
+
+ ! assumption is made that mpas_init_reconstruct was previously called
+ call ocn_RBFvertex(meshPool, filterNum, layerThickness, u, uvReconstructX, uvReconstructY, uvReconstructZ, .false., &
+ scratchPool, particleCellPool)
+
+ end subroutine ocn_vertex_reconstruction!}}}
+
+!***********************************************************************
+!
+! routine ocn_RBFvertex
+!
+!> \brief Reconstruct vertex velocity using linear interpolation of
+!> RBFs reconstruction at cell centers
+!> \author Phillip Wolfram, Todd Ringler
+!> \date 03/26/2014
+!> \details
+!> Purpose: reconstruct vector field at vertex locations based on radial basis functions
+!> Input: mesh meta data and vector component data residing at cell edges
+!> initialize_weights logical is to determine if weights should be initialized
+!> Output: reconstructed vector field (measured in X,Y,Z) located at vertices
+!-----------------------------------------------------------------------
+ subroutine ocn_RBFvertex(meshPool, filterNum, layerThickness, u, uvReconstructX, uvReconstructY, uvReconstructZ, & !{{{
+ initialize_weights, scratchPool, particleCellPool)
+
+ implicit none
+
+ ! inputs
+ type (mpas_pool_type), pointer, intent(in) :: meshPool !< Input: Mesh information
+ type (mpas_pool_type), pointer, intent(in) :: scratchPool
+ type (mpas_pool_type), pointer, intent(in) :: particleCellPool !< Input: particlefield variables
+ real (kind=RKIND), dimension(:,:), pointer, intent(in) :: u !< Input: Velocity field on edges
+ real (kind=RKIND), dimension(:,:), pointer, intent(in) :: layerThickness !< Input: layerThickness on cells
+ integer, intent(in) :: filterNum !< number of times to filter
+ logical, intent(in) :: initialize_weights !< Input: Determine if weights for RBF should be pre-computed
+
+ ! outputs
+ type (field2DReal), pointer, intent(out) :: uvReconstructX !< Output: X Component of velocity reconstructed to vertices
+ type (field2DReal), pointer, intent(out) :: uvReconstructY !< Output: Y Component of velocity reconstructed to vertices
+ type (field2DReal), pointer, intent(out) :: uvReconstructZ !< Output: Z Component of velocity reconstructed to vertices
+
+ ! local / temporary arrays needed in the compute procedure
+ type (field2DReal), pointer :: &
+ ucReconstructX, ucReconstructY, ucReconstructZ, ucReconstructZonal, ucReconstructMeridional ! cell center values
+ type (field2DReal), pointer :: ucStore, vcStore, wcStore
+ type (field2DInteger), pointer :: boundaryVertex, boundaryCell, boundaryCellGlobal, boundaryVertexGlobal
+
+ ! get pointers
+ call mpas_pool_get_field(scratchPool, 'ucReconstructX', ucReconstructX)
+ call mpas_pool_get_field(scratchPool, 'ucReconstructY', ucReconstructY)
+ call mpas_pool_get_field(scratchPool, 'ucReconstructZ', ucReconstructZ)
+ call mpas_pool_get_field(scratchPool, 'ucReconstructZonal', ucReconstructZonal)
+ call mpas_pool_get_field(scratchPool, 'ucReconstructMeridional', ucReconstructMeridional)
+ call mpas_pool_get_field(scratchPool, 'boundaryVertexGlobal', boundaryVertexGlobal)
+
+ ! allocate memory
+ call mpas_allocate_scratch_field(ucReconstructX, .True.)
+ call mpas_allocate_scratch_field(ucReconstructY, .True.)
+ call mpas_allocate_scratch_field(ucReconstructZ, .True.)
+ call mpas_allocate_scratch_field(ucReconstructZonal, .True.)
+ call mpas_allocate_scratch_field(ucReconstructMeridional, .True.)
+ call mpas_allocate_scratch_field(boundaryVertexGlobal, .True.)
+
+ ucReconstructX % array = 0.0_RKIND
+ ucReconstructY % array = 0.0_RKIND
+ ucReconstructZ % array = 0.0_RKIND
+
+ ! initialize weights (should be pre-initialized)
+ if (initialize_weights) then
+ call mpas_init_reconstruct(meshPool)
+ end if
+
+ ! get cell center reconstructed RBF values
+ call mpas_reconstruct(meshPool, u, ucReconstructX % array, ucReconstructY % array, ucReconstructZ % array, &
+ ucReconstructZonal % array, ucReconstructMeridional % array)
+
+ ! need to do exchange for uc components (we don't use Zonal / Meridional for this calculation)
+ call mpas_dmpar_exch_halo_field(ucReconstructX)
+ call mpas_dmpar_exch_halo_field(ucReconstructY)
+ call mpas_dmpar_exch_halo_field(ucReconstructZ)
+
+ ! get boundaries
+ call mpas_pool_get_field(meshPool,'boundaryVertex', boundaryVertex)
+ call mpas_pool_get_field(meshPool,'boundaryCell', boundaryCell)
+
+
+ if (filternum > 0) then
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! filter the cell velocity field
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ call ocn_second_order_shapiro_filter_ops(filterNum, meshPool, scratchPool, boundaryVertex, boundaryCell, &
+ layerThickness, ucReconstructX, ucReconstructY, ucReconstructZ)
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! store filter data &
+ ! write data to file for output
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ call mpas_pool_get_field(particleCellPool, 'filteredVelocityU', ucStore)
+ call mpas_pool_get_field(particleCellPool, 'filteredVelocityV', vcStore)
+ call mpas_pool_get_field(particleCellPool, 'filteredVelocityW', wcStore)
+ ucStore % array = ucReconstructX % array
+ vcStore % array = ucReconstructY % array
+ wcStore % array = ucReconstructZ % array
+
+ end if
+
+ ! interpolate to vertex locations for use in Wachspress
+ call ocn_vector_cell_center_to_vertex(meshPool, boundaryVertex % array, boundaryCell % array, &
+ ucReconstructX % array, ucReconstructY % array, ucReconstructZ % array, &
+ uvReconstructX % array, uvReconstructY % array, uvReconstructZ % array)
+
+ ! handle boundary vertices (should be zero). Can potentially remove if mpas_init_block initializes to 0 vs -1e34
+ boundaryVertexGlobal % array = boundaryVertex % array
+ call mpas_dmpar_exch_halo_field(boundaryVertexGlobal)
+ ! definite change between these fields!
+ uvReconstructX % array = uvReconstructX % array * (1.0_RKIND - boundaryVertexGlobal % array)
+ uvReconstructY % array = uvReconstructY % array * (1.0_RKIND - boundaryVertexGlobal % array)
+ uvReconstructZ % array = uvReconstructZ % array * (1.0_RKIND - boundaryVertexGlobal % array)
+
+ ! do halo exchanges
+ call mpas_dmpar_exch_halo_field(uvReconstructX)
+ call mpas_dmpar_exch_halo_field(uvReconstructY)
+ call mpas_dmpar_exch_halo_field(uvReconstructZ)
+
+ ! deallocate memory
+ call mpas_deallocate_scratch_field(ucReconstructX, .True.)
+ call mpas_deallocate_scratch_field(ucReconstructY, .True.)
+ call mpas_deallocate_scratch_field(ucReconstructZ, .True.)
+ call mpas_deallocate_scratch_field(ucReconstructZonal, .True.)
+ call mpas_deallocate_scratch_field(ucReconstructMeridional, .True.)
+ call mpas_deallocate_scratch_field(boundaryVertexGlobal, .True.)
+
+ end subroutine ocn_RBFvertex!}}}
+
+!***********************************************************************
+!
+! routine ocn_vector_cell_center_to_vertex
+!
+!> \brief Interpolate cell center values to vertex values
+!> \author Phillip Wolfram
+!> \date 05/27/2014
+!> \details
+!> Purpose: interpolate vector field at vertex locations from cell center values
+!> using Barycentric (via Wachspress) interpolation
+!> Input: cell center data and mesh information
+!> Output: interpolated vertex values
+!-----------------------------------------------------------------------
+ subroutine ocn_vector_cell_center_to_vertex(meshPool, boundaryVertex, boundaryCell, & !{{{
+ ucReconstructX, ucReconstructY, ucReconstructZ, &
+ uvReconstructX, uvReconstructY, uvReconstructZ)
+
+ implicit none
+
+ ! input variables
+ type (mpas_pool_type), pointer, intent(in) :: meshPool !< Input: Mesh information
+ real (kind=RKIND), dimension(:,:), pointer, intent(in) :: ucReconstructX, & !< Input: X Cell center values
+ ucReconstructY, & !< Input: Y Cell center values
+ ucReconstructZ !< Input: z Cell center values
+ integer, dimension(:,:), pointer, intent(in) :: boundaryVertex, boundaryCell !< Input: Boundary flags
+
+ ! output variables
+ real (kind=RKIND), dimension(:,:), pointer, intent(out) :: uvReconstructX !< Output: Vertex Reconstructed X Velocity Component
+ real (kind=RKIND), dimension(:,:), pointer, intent(out) :: uvReconstructY !< Output: Vertex Reconstructed Y Velocity Component
+ real (kind=RKIND), dimension(:,:), pointer, intent(out) :: uvReconstructZ !< Output: Vertex Reconstructed Z Velocity Component
+
+ ! local variables
+ integer, pointer :: nVerticesSolve, nCells, vertexDegree, nVertLevels
+ integer :: aVertex, aCell, aLevel
+ integer, dimension(:,:), pointer :: cellsOnVertex
+ real (kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell, xVertex, yVertex, zVertex
+ real (kind=RKIND), dimension(:,:), pointer :: kiteAreasOnVertex
+ ! temporary arrays needed in the (to be constructed) init procedure
+ ! note that lambda is going to be constant for this and could be cached
+ real (kind=RKIND), dimension(:), allocatable :: lambda
+ real (kind=RKIND), dimension(:,:), allocatable :: pointVertex
+ real (kind=RKIND), dimension(3) :: pointInterp
+ real (kind=RKIND) :: xp,yp,zp , sumArea, kiteArea
+ logical, pointer :: is_periodic
+ real(kind=RKIND), pointer :: x_period, y_period
+
+ uvReconstructX = 0.0_RKIND
+ uvReconstructY = 0.0_RKIND
+ uvReconstructZ = 0.0_RKIND
+
+ call mpas_pool_get_dimension(meshPool, 'vertexDegree', vertexDegree)
+
+ allocate(lambda(vertexDegree), pointVertex(3,vertexDegree))
+
+ ! setup pointers
+ call mpas_pool_get_dimension(meshPool, 'nVerticesSolve', nVerticesSolve)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_array(meshPool, 'cellsOnVertex', cellsOnVertex)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'zCell', zCell)
+
+ call mpas_pool_get_array(meshPool, 'xVertex', xVertex)
+ call mpas_pool_get_array(meshPool, 'yVertex', yVertex)
+ call mpas_pool_get_array(meshPool, 'zVertex', zVertex)
+
+ call mpas_pool_get_array(meshPool, 'kiteAreasOnVertex', kiteAreasOnVertex)
+
+ call mpas_pool_get_config(meshPool, 'is_periodic', is_periodic)
+ call mpas_pool_get_config(meshPool, 'x_period', x_period)
+ call mpas_pool_get_config(meshPool, 'y_period', y_period)
+
+ ! loop over all vertices
+ do aVertex = 1, nVerticesSolve
+ ! could precompute the list as an optimization
+ ! really, condition is any boundaryVertex in column greater than 0
+ if(any(boundaryVertex(:,aVertex) < 1)) then
+ ! get vertex location and cell center locations
+ do aCell = 1, vertexDegree
+ ! logical could be moved outside of code block as an optimization
+ ! (then essentially would have two nearly identical code blocks...)
+ if (is_periodic) then
+ ! fix periodicity with respect to pointInterp (xVertex)
+ pointVertex(1,aCell) = mpas_fix_periodicity(xCell(cellsOnVertex(aCell, aVertex)), xVertex(aVertex), x_period)
+ pointVertex(2,aCell) = mpas_fix_periodicity(yCell(cellsOnVertex(aCell, aVertex)), yVertex(aVertex), y_period)
+ pointVertex(3,aCell) = zCell(cellsOnVertex(aCell, aVertex))
+ else
+ pointVertex(1,aCell) = xCell(cellsOnVertex(aCell, aVertex))
+ pointVertex(2,aCell) = yCell(cellsOnVertex(aCell, aVertex))
+ pointVertex(3,aCell) = zCell(cellsOnVertex(aCell, aVertex))
+ end if
+ end do
+ ! vertex point for reconstruction
+ pointInterp(1) = xVertex(aVertex)
+ pointInterp(2) = yVertex(aVertex)
+ pointInterp(3) = zVertex(aVertex)
+ ! get interpolation constants (could be cached / optimized with areaBin)
+ lambda = mpas_wachspress_coordinates(vertexDegree, pointVertex , pointInterp, meshPool)
+ else
+ lambda = 0.0_RKIND
+ end if
+
+ do aLevel = 1, nVertLevels
+ if(boundaryVertex(aLevel,aVertex) < 1) then
+ ! perform interpolation
+ uvReconstructX(aLevel,aVertex) = sum(ucReconstructX(aLevel,cellsOnVertex(:,aVertex)) * lambda)
+ uvReconstructY(aLevel,aVertex) = sum(ucReconstructY(aLevel,cellsOnVertex(:,aVertex)) * lambda)
+ uvReconstructZ(aLevel,aVertex) = sum(ucReconstructZ(aLevel,cellsOnVertex(:,aVertex)) * lambda)
+ end if
+ end do
+
+ ! need to specify boundary conditions for the vertexes (outside this subroutine)
+
+ end do
+
+ deallocate(lambda, pointVertex)
+
+ end subroutine ocn_vector_cell_center_to_vertex!}}}
+
+!***********************************************************************
+!
+! routine ocn_vector_vertex_to_cell_center
+!
+!> \brief Interpolate vertex values to cell center
+!> \author Phillip Wolfram
+!> \date 08/01/2014
+!> \details
+!> Purpose: interpolate vector field at cell center locations from vertex values
+!> using Wachspress interpolation
+!> Input: vertex vector data and mesh information
+!> Output: interpolated cell values
+!-----------------------------------------------------------------------
+ subroutine ocn_vector_vertex_to_cell_center(meshPool, & !{{{
+ uvReconstructX, uvReconstructY, uvReconstructZ, &
+ ucReconstructX, ucReconstructY, ucReconstructZ)
+
+ implicit none
+
+ ! input variables
+ type (mpas_pool_type), pointer, intent(in) :: meshPool !< Input: Mesh information
+ real (kind=RKIND), dimension(:,:), pointer, intent(in) :: uvReconstructX, & !< Input: Vertex x values
+ uvReconstructY, & !< Input: Vertex y values
+ uvReconstructZ !< Input: Vertex z values
+
+ ! output variables
+ real (kind=RKIND), dimension(:,:), pointer, intent(out) :: ucReconstructX !< Output: X Component of velocity
+ !< reconstructed to cells
+ real (kind=RKIND), dimension(:,:), pointer, intent(out) :: ucReconstructY !< Output: Y Component of velocity
+ !< reconstructed to cells
+ real (kind=RKIND), dimension(:,:), pointer, intent(out) :: ucReconstructZ !< Output: Z Component of velocity
+ !< reconstructed to cells
+
+ ! local variables
+ integer, pointer :: nCellsSolve, nVertLevels
+ integer, dimension(:), pointer :: nEdgesOnCell
+ integer :: aVertex, aCell, aLevel, nLocalVertices
+ integer, dimension(:,:), pointer :: verticesOnCell
+ real (kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell, xVertex, yVertex, zVertex
+ ! temporary arrays needed in the (to be constructed) init procedure
+ ! note that lambda is going to be constant for this and could be cached
+ real (kind=RKIND), dimension(:), allocatable :: lambda
+ real (kind=RKIND), dimension(3) :: pointInterp
+ real (kind=RKIND), dimension(:,:), allocatable :: pointVertex
+ real (kind=RKIND) :: xp,yp,zp
+
+ ucReconstructX = 0.0_RKIND
+ ucReconstructY = 0.0_RKIND
+ ucReconstructZ = 0.0_RKIND
+
+ ! setup pointers
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_array(meshPool, 'verticesOnCell', verticesOnCell)
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'zCell', zCell)
+
+ call mpas_pool_get_array(meshPool, 'xVertex', xVertex)
+ call mpas_pool_get_array(meshPool, 'yVertex', yVertex)
+ call mpas_pool_get_array(meshPool, 'zVertex', zVertex)
+
+
+ ! loop over all vertices
+ do aCell = 1, nCellsSolve
+ ! could precompute the list as an optimization to
+ ! remove the following lines !{{{
+ nLocalVertices = nEdgesOnCell(aCell)
+ ! really, condition is any boundaryVertex in column greater than 0
+ allocate(lambda(nLocalVertices), pointVertex(3,nLocalVertices))
+ ! get vertex location and cell center locations
+ do aVertex = 1, nLocalVertices
+ pointVertex(1,aVertex) = xVertex(verticesOnCell(aVertex, aCell))
+ pointVertex(2,aVertex) = yVertex(verticesOnCell(aVertex, aCell))
+ pointVertex(3,aVertex) = zVertex(verticesOnCell(aVertex, aCell))
+ end do
+ ! vertex point for reconstruction
+ pointInterp(1) = xCell(aCell)
+ pointInterp(2) = yCell(aCell)
+ pointInterp(3) = zCell(aCell)
+ ! get interpolation constants (should be cached as an optimization!)
+ lambda = mpas_wachspress_coordinates(nLocalVertices, pointVertex , pointInterp, meshPool)
+ !}}}
+
+ do aLevel = 1, nVertLevels
+ ! perform interpolation
+ ucReconstructX(aLevel,aCell) = sum(uvReconstructX(aLevel,verticesOnCell(1:nLocalVertices,aCell)) * lambda)
+ ucReconstructY(aLevel,aCell) = sum(uvReconstructY(aLevel,verticesOnCell(1:nLocalVertices,aCell)) * lambda)
+ ucReconstructZ(aLevel,aCell) = sum(uvReconstructZ(aLevel,verticesOnCell(1:nLocalVertices,aCell)) * lambda)
+ end do
+
+ deallocate(lambda, pointVertex)
+ end do
+
+ end subroutine ocn_vector_vertex_to_cell_center !}}}
+
+!***********************************************************************
+!
+! routine ocn_second_order_shapiro_filter_ops
+!
+!> \brief Do Ntimes simple shapiro filtering operations, but make
+!> higher order
+!> \author Phillip Wolfram
+!> \date 08/01/2014
+!> \details
+!> Purpose: multiple applications of digital shapiro filter (discrete Laplacian)
+!> Input: cell centered data and mesh information
+!> Output: filtered cell values
+!-----------------------------------------------------------------------
+ subroutine ocn_second_order_shapiro_filter_ops(Ntimes, meshPool, scratchPool, boundaryVertex, boundaryCell, &
+ layerThickness, ucReconstructX, ucReconstructY, ucReconstructZ) !{{{
+ implicit none
+
+ type (mpas_pool_type), pointer, intent(in) :: meshPool, scratchPool
+ type (field2DInteger), pointer, intent(in) :: boundaryVertex, boundaryCell
+ type (field2DReal), pointer, intent(inout) :: ucReconstructX, ucReconstructY, ucReconstructZ ! cell center values
+ integer, intent(in) :: Ntimes ! number of filter applications
+ real (kind=RKIND), dimension(:,:), pointer, intent(in) :: layerThickness
+
+ type (field2DReal), pointer :: ucStore, vcStore, wcStore
+
+ call mpas_pool_get_field(scratchPool,'ucX',ucStore)
+ call mpas_pool_get_field(scratchPool,'ucY',vcStore)
+ call mpas_pool_get_field(scratchPool,'ucZ',wcStore)
+ call mpas_allocate_scratch_field(ucStore,.True.)
+ call mpas_allocate_scratch_field(vcStore,.True.)
+ call mpas_allocate_scratch_field(wcStore,.True.)
+
+
+ call ocn_multiple_vector_shapiro_filter_ops(Ntimes, meshPool, scratchPool, boundaryVertex, boundaryCell, &
+ layerThickness, ucReconstructX, ucReconstructY, ucReconstructZ)
+ ucStore % array = 2.0_RKIND*ucReconstructX % array
+ vcStore % array = 2.0_RKIND*ucReconstructY % array
+ wcStore % array = 2.0_RKIND*ucReconstructZ % array
+ call ocn_multiple_vector_shapiro_filter_ops(Ntimes, meshPool, scratchPool, boundaryVertex, boundaryCell, &
+ layerThickness, ucReconstructX, ucReconstructY, ucReconstructZ)
+ ucStore % array = ucStore % array - ucReconstructX % array
+ vcStore % array = vcStore % array - ucReconstructY % array
+ wcStore % array = wcStore % array - ucReconstructZ % array
+
+ ! move temporary storage into final storage
+ ucReconstructX % array = ucStore % array
+ ucReconstructY % array = vcStore % array
+ ucReconstructZ % array = wcStore % array
+
+ ! deallocate temporary memory
+ call mpas_deallocate_scratch_field(ucStore,.True.)
+ call mpas_deallocate_scratch_field(vcStore,.True.)
+ call mpas_deallocate_scratch_field(wcStore,.True.)
+
+ end subroutine ocn_second_order_shapiro_filter_ops !}}}
+
+!***********************************************************************
+!
+! routine ocn_multiple_vector_shapiro_filter_ops
+!
+!> \brief Do Ntimes simple shapiro filtering operations
+!> \author Phillip Wolfram
+!> \date 08/01/2014
+!> \details
+!> Purpose: multiple applications of digital shapiro filter (discrete Laplacian)
+!> Input: cell centered data and mesh information
+!> Output: filtered cell values
+!-----------------------------------------------------------------------
+ subroutine ocn_multiple_vector_shapiro_filter_ops(Ntimes, meshPool, scratchPool, boundaryVertex, boundaryCell, &
+ layerThickness, ucReconstructX, ucReconstructY, ucReconstructZ) !{{{
+ implicit none
+
+ type (mpas_pool_type), pointer, intent(in) :: meshPool, scratchPool
+ type (field2DInteger), pointer, intent(in) :: boundaryVertex, boundaryCell
+ type (field2DReal), pointer, intent(inout) :: ucReconstructX, ucReconstructY, ucReconstructZ ! cell center values
+ real (kind=RKIND), dimension(:,:), pointer, intent(in) :: layerThickness
+ integer, intent(in) :: Ntimes ! number of filter applications
+
+ ! local variables
+ integer atime
+
+ do atime = 1,Ntimes
+ !call ocn_simple_vector_shapiro_filter(meshPool, scratchPool, boundaryVertex, boundaryCell, &
+ ! ucReconstructX, ucReconstructY, ucReconstructZ)
+ call ocn_simple_vector_laplacian_filter(meshPool, scratchPool, boundaryCell % array, layerThickness, &
+ ucReconstructX % array)
+ call ocn_simple_vector_laplacian_filter(meshPool, scratchPool, boundaryCell % array, layerThickness, &
+ ucReconstructY % array)
+ call ocn_simple_vector_laplacian_filter(meshPool, scratchPool, boundaryCell % array, layerThickness, &
+ ucReconstructZ % array)
+
+ end do
+
+ end subroutine ocn_multiple_vector_shapiro_filter_ops !}}}
+
+!***********************************************************************
+!
+! routine ocn_simple_vector_laplacian_filter
+!
+!> \brief Do 1 pass of simple laplacian filter
+!> \author Phillip Wolfram
+!> \date 08/01/2014
+!> \details
+!> Purpose: one pass of digital shapiro filter (discrete Laplacian)
+!> Input: cell centered data and mesh information
+!> Output: filtered cell values
+!-----------------------------------------------------------------------
+ subroutine ocn_simple_vector_laplacian_filter(meshPool, scratchPool, boundaryCell, layerThickness, ucReconstruct) !{{{
+ implicit none
+
+ type (mpas_pool_type), pointer, intent(in) :: meshPool, scratchPool
+ integer, dimension(:,:), pointer, intent(in) :: boundaryCell
+ real (kind=RKIND), dimension(:,:), pointer, intent(inout) :: ucReconstruct
+ real (kind=RKIND), dimension(:,:), pointer, intent(in) :: layerThickness
+
+ ! local variables
+ type (field2DReal), pointer :: ucTemp
+ integer :: aCell, aNeigh, aLevel
+ integer, pointer :: nCellsSolve, nVertLevels
+ integer, dimension(:), pointer :: nEdgesOnCell
+ integer, dimension(:,:), pointer :: cellsOnCell
+ real (kind=RKIND), dimension(:), pointer :: areaCell
+ real (kind=RKIND) :: volSum, cellVol
+
+ ! allocate scratch memory
+ call mpas_pool_get_field(scratchPool, 'ucTemp', ucTemp)
+ call mpas_allocate_scratch_field(ucTemp,.True.)
+
+ ! get values from pools
+ call mpas_pool_get_dimension(meshPool,'nCellsSolve',nCellsSolve)
+ call mpas_pool_get_dimension(meshPool,'nVertLevels',nVertLevels)
+ call mpas_pool_get_array(meshPool,'nEdgesOnCell',nEdgesOnCell)
+ call mpas_pool_get_array(meshPool,'cellsOnCell', cellsOnCell)
+ call mpas_pool_get_array(meshPool,'areaCell',areaCell)
+
+ ucTemp % array = 0.0_RKIND
+
+ ! perform laplacian filtering
+ do aCell = 1, nCellsSolve
+ do aLevel = 1, nVertLevels
+ volSum = nEdgesOnCell(aCell) * layerThickness(aLevel,aCell) * areaCell(aCell) * (1-boundaryCell(aLevel,aCell))
+ ucTemp % array(aLevel, aCell) = ucReconstruct(aLevel, aCell) * volSum
+ if (volSum /= 0 ) then
+ ! loop over all neighbors
+ do aNeigh = 1, nEdgesOnCell(aCell)
+ cellVol = layerThickness(aLevel,cellsOnCell(aNeigh,aCell)) * areaCell(cellsOnCell(aNeigh,aCell)) &
+ * (1-boundaryCell(aLevel, cellsOnCell(aNeigh,aCell)))
+ volSum = volSum + cellVol
+ ucTemp % array(aLevel, aCell) = ucTemp % array(aLevel, aCell) + ucReconstruct(aLevel,cellsOnCell(aNeigh,aCell)) &
+ * cellVol
+ end do
+ ucTemp % array(aLevel, aCell) = ucTemp % array(aLevel, aCell) / volSum
+ end if
+ end do
+ end do
+
+ ! exchange halo values
+ call mpas_dmpar_exch_halo_field(ucTemp)
+
+ ! replace input values with filtered values
+ ucReconstruct = ucTemp % array
+
+ ! deallocate scratch memory
+ call mpas_deallocate_scratch_field(ucTemp , .True.)
+
+ end subroutine ocn_simple_vector_laplacian_filter !}}}
+
+!***********************************************************************
+!
+! routine ocn_simple_vector_shapiro_filter
+!
+!> \brief Do 1 pass of simple shapiro filter
+!> \author Phillip Wolfram
+!> \date 08/01/2014
+!> \details
+!> Purpose: one pass of digital shapiro filter to vertexes, back to cells
+!> Input: cell centered data and mesh information
+!> Output: filtered cell values
+!-----------------------------------------------------------------------
+ subroutine ocn_simple_vector_shapiro_filter(meshPool, scratchPool, boundaryVertex, boundaryCell, &
+ ucReconstructX, ucReconstructY, ucReconstructZ) !{{{
+ implicit none
+
+ type (mpas_pool_type), pointer, intent(in) :: meshPool, scratchPool
+ type (field2DInteger), pointer, intent(in) :: boundaryVertex, boundaryCell
+ type (field2DReal), pointer, intent(inout) :: ucReconstructX, ucReconstructY, ucReconstructZ ! cell center values
+
+ ! local variables
+ type (field2DReal), pointer :: uvX , uvY, uvZ ! cell center values
+
+ ! allocate scratch memory
+ call mpas_pool_get_field(scratchPool, 'uvX', uvX)
+ call mpas_pool_get_field(scratchPool, 'uvY', uvY)
+ call mpas_pool_get_field(scratchPool, 'uvZ', uvZ)
+ call mpas_allocate_scratch_field(uvX,.True.)
+ call mpas_allocate_scratch_field(uvY,.True.)
+ call mpas_allocate_scratch_field(uvZ,.True.)
+
+ uvX % array = 0.0_RKIND
+ uvY % array = 0.0_RKIND
+ uvZ % array = 0.0_RKIND
+
+ ! perform filtering
+
+ ! CC -> vertices
+ call ocn_vector_cell_center_to_vertex(meshPool, boundaryVertex % array, boundaryCell % array, &
+ ucReconstructX % array, ucReconstructY % array, ucReconstructZ % array, &
+ uvX % array, uvY % array, uvZ % array)
+ ! do halo exchanges
+ call mpas_dmpar_exch_halo_field(uvX)
+ call mpas_dmpar_exch_halo_field(uvY)
+ call mpas_dmpar_exch_halo_field(uvZ)
+ ! vertices -> CC
+ call ocn_vector_vertex_to_cell_center(meshPool, &
+ uvX % array, uvY % array, uvZ % array, &
+ ucReconstructX % array, ucReconstructY % array, ucReconstructZ % array)
+ ! do halo exchanges
+ call mpas_dmpar_exch_halo_field(ucReconstructX)
+ call mpas_dmpar_exch_halo_field(ucReconstructY)
+ call mpas_dmpar_exch_halo_field(ucReconstructZ)
+
+ ! N.B., effect of forgetting halo exchange may be subtle for a single pass
+
+ ! deallocate scratch memory
+ call mpas_deallocate_scratch_field(uvX , .True.)
+ call mpas_deallocate_scratch_field(uvY , .True.)
+ call mpas_deallocate_scratch_field(uvZ , .True.)
+
+ end subroutine ocn_simple_vector_shapiro_filter !}}}
+
+end module ocn_lagrangian_particle_tracking_interpolations
+
diff --git a/src/core_ocean/analysis_members/mpas_ocn_lagrangian_particle_tracking_reset.F b/src/core_ocean/analysis_members/mpas_ocn_lagrangian_particle_tracking_reset.F
new file mode 100644
index 0000000000..3796536973
--- /dev/null
+++ b/src/core_ocean/analysis_members/mpas_ocn_lagrangian_particle_tracking_reset.F
@@ -0,0 +1,393 @@
+! 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
+!
+!***********************************************************************
+!
+! ocn_lagrangian_particle_tracking_reset
+!
+!> \brief LIGHT reset functionality
+!> \author Phillip J. Wolfram
+!> \date 10/28/2015
+!> \details
+!> This module provides routines for performing particle resets in LIGHT.
+!
+!-----------------------------------------------------------------------
+module ocn_lagrangian_particle_tracking_reset
+
+ use mpas_derived_types
+ use mpas_constants
+ use mpas_timekeeping
+ use mpas_stream_manager
+ use mpas_pool_routines
+
+ use ocn_constants
+
+ implicit none
+ private
+
+ !-----------------------------------------------------------------
+ ! public routines and interfaces
+ !-----------------------------------------------------------------
+ ! define publically accessible subroutines, functions, interfaces
+ public :: ocn_setup_particle_reset_condition
+ public :: ocn_evaluate_particle_reset_condition
+ public :: ocn_finalize_particle_reset_condition
+
+ contains
+
+!***********************************************************************
+!
+! routine ocn_setup_particle_reset_condition
+!
+!> \brief Set up needed information for particle resets
+!> \author Phillip Wolfram
+!> \date 10/28/2015
+!> \details
+!> Purpose: Perform set up for particle resets.
+!> Input: domain
+!-----------------------------------------------------------------------
+ subroutine ocn_setup_particle_reset_condition(domain, err) !{{{
+
+ implicit none
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: lagrPartTrackScalarPool, lagrPartTrackRegionsPool
+ real (kind=RKIND), pointer :: globalResetTimeValue
+ type (mpas_timeInterval_type) :: timeInterval
+ character (len=StrKIND), pointer :: config_AM_lagrPartTrack_reset_global_timestamp
+ character (len=StrKIND), pointer :: config_AM_lagrPartTrack_region_stream
+ character (len=StrKIND), pointer :: config_AM_lagrPartTrack_reset_criteria
+ type (field1DInteger), pointer :: resetInsideRegionMaskValue1Field, resetOutsideRegionMaskValue1Field
+ integer, dimension(:), pointer :: resetInsideRegionMaskValue1, resetOutsideRegionMaskValue1
+
+ err = 0
+
+ ! get the configuration options
+ call mpas_pool_get_config(ocnConfigs, 'config_AM_lagrPartTrack_reset_global_timestamp', &
+ config_AM_lagrPartTrack_reset_global_timestamp)
+ call mpas_pool_get_config(ocnConfigs, 'config_AM_lagrPartTrack_region_stream', &
+ config_AM_lagrPartTrack_region_stream)
+ call mpas_pool_get_config(ocnConfigs, 'config_AM_lagrPartTrack_reset_criteria', &
+ config_AM_lagrPartTrack_reset_criteria)
+
+ ! load in region masks streams (masks stored in pool)
+ if (trim(config_AM_lagrPartTrack_reset_criteria) == 'region' .or. &
+ trim(config_AM_lagrPartTrack_reset_criteria) == 'all' &
+ ) then
+ call MPAS_stream_mgr_read(domain % streamManager, streamID=trim(config_AM_lagrPartTrack_region_stream), ierr=err)
+ end if
+
+ ! convert input config_AM_lagrPartTrack_reset_global_timestamp into S for calculations
+ block => domain % blocklist
+ do while (associated(block))
+ ! setup pointers / get block
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackScalars', lagrPartTrackScalarPool)
+ call mpas_pool_get_array(lagrPartTrackScalarPool, 'globalResetTimeValue', globalResetTimeValue)
+
+ ! convert config_AM_lagrPartTrack_reset_global_timestamp into seconds and store in globalResetTimeValue
+ call mpas_set_timeInterval(timeInterval, timeString=trim(config_AM_lagrPartTrack_reset_global_timestamp))
+ call mpas_get_timeInterval(timeInterval, dt=globalResetTimeValue)
+
+ !write(stderrUnit,*) 'resetTimeValue = ', globalResetTimeValue
+
+ block => block % next
+ end do
+
+ end subroutine ocn_setup_particle_reset_condition!}}}
+
+!***********************************************************************
+!
+! routine ocn_evaluate_particle_reset_condition
+!
+!> \brief Evaluate needed information for particle resets
+!> \author Phillip Wolfram
+!> \date 10/30/2015
+!> \details
+!> Purpose: Evaluate if particle resets should occur for a particle
+!> Input: domain, particle
+!> Output: boolean specifying whether the particles should be reset.
+!-----------------------------------------------------------------------
+ subroutine ocn_evaluate_particle_reset_condition(domain, block, particle, dt, iCell, resetParticle, err) !{{{
+
+ implicit none
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), intent(in) :: dt
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ type (block_type), intent(inout), pointer :: block
+ type (mpas_particle_type), pointer, intent(inout) :: particle
+ integer, intent(inout) :: iCell
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ logical, intent(out) :: resetParticle
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mpas_pool_type), pointer :: lagrPartTrackScalarPool, lagrPartTrackRegionsPool
+ integer, pointer :: transfered, numTimesReset
+ integer, pointer :: currentBlock, currentBlockReset, currentCell, currentCellReset
+ real (kind=RKIND), pointer :: xParticleReset, yParticleReset, zParticleReset, zLevelParticleReset
+ real (kind=RKIND), pointer :: xParticle, yParticle, zParticle, zLevelParticle
+ real (kind=RKIND), pointer :: timeSinceReset
+ real (kind=RKIND), pointer :: sumU, sumV, sumUU, sumUV, sumVV
+ integer, pointer :: resetTime
+ real (kind=RKIND), pointer :: globalResetTimeValue
+
+ character (len=StrKIND), pointer :: config_AM_lagrPartTrack_reset_criteria
+ logical, pointer :: config_AM_lagrPartTrack_reset_if_outside_region
+ logical, pointer :: config_AM_lagrPartTrack_reset_if_inside_region
+ integer, dimension(:), pointer :: resetInsideRegionMaskValue1, resetOutsideRegionMaskValue1
+
+ ! initialize outputs
+ err = 0
+ resetParticle = .False.
+
+ ! get config options
+ call mpas_pool_get_config(ocnConfigs, 'config_AM_lagrPartTrack_reset_criteria', &
+ config_AM_lagrPartTrack_reset_criteria)
+ call mpas_pool_get_config(ocnConfigs, 'config_AM_lagrPartTrack_reset_if_outside_region', &
+ config_AM_lagrPartTrack_reset_if_outside_region)
+ call mpas_pool_get_config(ocnConfigs, 'config_AM_lagrPartTrack_reset_if_inside_region', &
+ config_AM_lagrPartTrack_reset_if_inside_region)
+
+ ! get variables
+ call mpas_pool_get_array(particle % haloDataPool, 'timeSinceReset', timeSinceReset)
+ call mpas_pool_get_array(particle % haloDataPool, 'resetTime', resetTime)
+
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackScalars', lagrPartTrackScalarPool)
+ call mpas_pool_get_array(lagrPartTrackScalarPool, 'globalResetTimeValue', globalResetTimeValue)
+
+ if (trim(config_AM_lagrPartTrack_reset_criteria) == 'region' .or. &
+ trim(config_AM_lagrPartTrack_reset_criteria) == 'all' &
+ ) then
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackRegions', lagrPartTrackRegionsPool)
+ call mpas_pool_get_array(lagrPartTrackRegionsPool, 'resetInsideRegionMaskValue1', resetInsideRegionMaskValue1)
+ call mpas_pool_get_array(lagrPartTrackRegionsPool, 'resetOutsideRegionMaskValue1', resetOutsideRegionMaskValue1)
+ end if
+
+ ! advance particle time
+ timeSinceReset = timeSinceReset + dt
+
+ ! determine whether reset should occur depending upon type of reset condition
+ select case (trim(config_AM_lagrPartTrack_reset_criteria))
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! time based
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !{{{
+
+ case ('particle_time')
+ ! use particle's value for resetTime and timeSinceReset
+ if (timeSinceReset > resetTime) then
+ resetParticle = .True.
+ end if
+
+ case ('global_time')
+ if (timeSinceReset > globalResetTimeValue) then
+ resetParticle = .True.
+ end if
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !}}}
+ ! region based
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !{{{
+
+ case ('region')
+ ! outside region
+ if (config_AM_lagrPartTrack_reset_if_outside_region .and. &
+ resetOutsideRegionMaskValue1(iCell) == 0) then
+ resetParticle = .True.
+ end if
+ ! inside region
+ if (config_AM_lagrPartTrack_reset_if_inside_region .and. &
+ resetInsideRegionMaskValue1(iCell) == 1) then
+ resetParticle = .True.
+ end if
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !}}}
+ ! all conditions
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !{{{
+
+ case ('all')
+ ! particle time
+ if ((timeSinceReset > resetTime) .or. &
+ ! global time
+ (timeSinceReset > globalResetTimeValue) .or. &
+ ! outside region
+ (config_AM_lagrPartTrack_reset_if_outside_region .and. &
+ resetOutsideRegionMaskValue1(iCell) == 0) .or. &
+ ! inside region
+ (config_AM_lagrPartTrack_reset_if_inside_region .and. &
+ resetInsideRegionMaskValue1(iCell) == 1)) then
+ resetParticle = .True.
+ end if
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !}}}
+ ! default
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ case default
+ write(stderrUnit,*) 'WARNING: reset criteria in config_AM_lagrPartTrack_reset_criteria=', &
+ trim(config_AM_lagrPartTrack_reset_criteria),' unknown! Cannot restart.'
+
+ end select
+
+ ! reset particle block, cell, and position to reset values
+ if (resetParticle) then
+
+ !write(stderrUnit,*) 'reseting particle'
+
+ ! get data
+ call mpas_pool_get_array(particle % haloDataPool, 'currentBlock', currentBlock)
+ call mpas_pool_get_array(particle % haloDataPool, 'currentBlockReset', currentBlockReset)
+ call mpas_pool_get_array(particle % haloDataPool, 'currentCellReset', currentCellReset)
+ call mpas_pool_get_array(particle % haloDataPool, 'xParticleReset', xParticleReset)
+ call mpas_pool_get_array(particle % haloDataPool, 'yParticleReset', yParticleReset)
+ call mpas_pool_get_array(particle % haloDataPool, 'zParticleReset', zParticleReset)
+ call mpas_pool_get_array(particle % haloDataPool, 'zLevelParticleReset', zLevelParticleReset)
+ call mpas_pool_get_array(particle % haloDataPool, 'xParticle', xParticle)
+ call mpas_pool_get_array(particle % haloDataPool, 'yParticle', yParticle)
+ call mpas_pool_get_array(particle % haloDataPool, 'zParticle', zParticle)
+ call mpas_pool_get_array(particle % haloDataPool, 'zLevelParticle', zLevelParticle)
+ call mpas_pool_get_array(particle % haloDataPool, 'numTimesReset', numTimesReset)
+ call mpas_pool_get_array(particle % haloDataPool, 'transfered', transfered)
+ call mpas_pool_get_array(particle % haloDataPool, 'sumU', sumU)
+ call mpas_pool_get_array(particle % haloDataPool, 'sumV', sumV)
+ call mpas_pool_get_array(particle % haloDataPool, 'sumUU', sumUU)
+ call mpas_pool_get_array(particle % haloDataPool, 'sumUV', sumUV)
+ call mpas_pool_get_array(particle % haloDataPool, 'sumVV', sumVV)
+
+ ! reset the time
+ timeSinceReset = 0.0_RKIND
+
+ ! increment counters
+ if (currentBlock /= currentBlockReset) then
+ transfered = transfered + 1
+ end if
+ numTimesReset = numTimesReset + 1
+
+ ! reset the block and the current cell
+ currentBlock = currentBlockReset
+ ! this should be a -1 in general but could precache based on an initial decomposition for performance
+ iCell = -1
+ !iCell = currentCellReset
+
+ ! reset positions
+ xParticle = xParticleReset
+ yParticle = yParticleReset
+ zParticle = zParticleReset
+ zLevelParticle = zLevelParticleReset
+
+ ! reset velocity sums
+ sumU = 0.0_RKIND
+ sumV = 0.0_RKIND
+ sumUU = 0.0_RKIND
+ sumUV = 0.0_RKIND
+ sumVV = 0.0_RKIND
+
+ ! more variables may need to be reset in the future
+
+ end if
+
+ end subroutine ocn_evaluate_particle_reset_condition!}}}
+
+!***********************************************************************
+!
+! routine ocn_finalize_particle_reset_condition
+!
+!> \brief Finalize information for particle resets
+!> \author Phillip Wolfram
+!> \date 10/30/2015
+!> \details
+!> Purpose: Finalize setup of particle resets
+!> Input: domain
+!-----------------------------------------------------------------------
+ subroutine ocn_finalize_particle_reset_condition(domain, err) !{{{
+
+ implicit none
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ ! particle reset cleanup
+
+ end subroutine ocn_finalize_particle_reset_condition!}}}
+
+end module ocn_lagrangian_particle_tracking_reset
+
diff --git a/src/core_ocean/analysis_members/mpas_ocn_layer_volume_weighted_averages.F b/src/core_ocean/analysis_members/mpas_ocn_layer_volume_weighted_averages.F
index 0d77586c53..1099e7081a 100644
--- a/src/core_ocean/analysis_members/mpas_ocn_layer_volume_weighted_averages.F
+++ b/src/core_ocean/analysis_members/mpas_ocn_layer_volume_weighted_averages.F
@@ -159,6 +159,7 @@ subroutine ocn_compute_layer_volume_weighted_averages(domain, timeLevel, err)!{{
type (mpas_pool_type), pointer :: scratchPool
type (mpas_pool_type), pointer :: diagnosticsPool
type (mpas_pool_type), pointer :: forcingPool
+ type (mpas_pool_type), pointer :: tracersPool
real (kind=RKIND), dimension(:,:,:), pointer :: minValueWithinOceanLayerRegion
real (kind=RKIND), dimension(:,:,:), pointer :: maxValueWithinOceanLayerRegion
@@ -175,14 +176,14 @@ subroutine ocn_compute_layer_volume_weighted_averages(domain, timeLevel, err)!{{
real (kind=RKIND), dimension(:,:), pointer :: velocityZonal
real (kind=RKIND), dimension(:,:), pointer :: velocityMeridional
real (kind=RKIND), dimension(:,:), pointer :: vertVelocityTop
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
real (kind=RKIND), dimension(:,:), pointer :: kineticEnergyCell
real (kind=RKIND), dimension(:,:), pointer :: relativeVorticityCell
real (kind=RKIND), dimension(:,:), pointer :: divergence
! pointers to data in mesh pool
integer, pointer :: nVertLevels, nCells, nCellsSolve, nLayerVolWeightedAvgFields, nOceanRegionsTmp
- integer, pointer :: indexTemperature, indexSalinity
+ integer, pointer :: index_temperature, index_salinity
integer, dimension(:), pointer :: maxLevelCell
real (kind=RKIND), dimension(:), pointer :: areaCell, lonCell, latCell
@@ -196,9 +197,6 @@ subroutine ocn_compute_layer_volume_weighted_averages(domain, timeLevel, err)!{{
integer :: iDataField, nDefinedDataFields
integer :: iCell, iLevel, iRegion, iTracer, err_tmp
- ! package flag
- logical, pointer :: layerVolumeWeightedAverageAMPKGActive
-
! buffers data for message passaging
integer :: kBuffer, kBufferLength
real (kind=RKIND), dimension(:), allocatable :: workBufferSum, workBufferSumReduced
@@ -237,9 +235,12 @@ subroutine ocn_compute_layer_volume_weighted_averages(domain, timeLevel, err)!{{
call mpas_pool_get_array(layerVolumeWeightedAverageAMPool, 'minValueWithinOceanLayerRegion', minValueWithinOceanLayerRegion)
call mpas_pool_get_array(layerVolumeWeightedAverageAMPool, 'maxValueWithinOceanLayerRegion', maxValueWithinOceanLayerRegion)
call mpas_pool_get_array(layerVolumeWeightedAverageAMPool, 'avgValueWithinOceanLayerRegion', avgValueWithinOceanLayerRegion)
- call mpas_pool_get_array(layerVolumeWeightedAverageAMPool, 'minValueWithinOceanVolumeRegion', minValueWithinOceanVolumeRegion)
- call mpas_pool_get_array(layerVolumeWeightedAverageAMPool, 'maxValueWithinOceanVolumeRegion', maxValueWithinOceanVolumeRegion)
- call mpas_pool_get_array(layerVolumeWeightedAverageAMPool, 'avgValueWithinOceanVolumeRegion', avgValueWithinOceanVolumeRegion)
+ call mpas_pool_get_array(layerVolumeWeightedAverageAMPool, 'minValueWithinOceanVolumeRegion', &
+ minValueWithinOceanVolumeRegion)
+ call mpas_pool_get_array(layerVolumeWeightedAverageAMPool, 'maxValueWithinOceanVolumeRegion', &
+ maxValueWithinOceanVolumeRegion)
+ call mpas_pool_get_array(layerVolumeWeightedAverageAMPool, 'avgValueWithinOceanVolumeRegion', &
+ avgValueWithinOceanVolumeRegion)
! loop over blocks
! NOTE: code is not valid for multiple blocks !
@@ -269,6 +270,7 @@ subroutine ocn_compute_layer_volume_weighted_averages(domain, timeLevel, err)!{{
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
! get pointers to mesh
call mpas_pool_get_dimension(block % dimensions, 'nCellsSolve', nCellsSolve)
@@ -276,8 +278,8 @@ subroutine ocn_compute_layer_volume_weighted_averages(domain, timeLevel, err)!{{
call mpas_pool_get_dimension(block % dimensions, 'nVertLevels', nVertLevels)
call mpas_pool_get_dimension(block % dimensions, 'nLayerVolWeightedAvgFields', nLayerVolWeightedAvgFields)
call mpas_pool_get_dimension(block % dimensions, 'nOceanRegionsTmp', nOceanRegionsTmp)
- call mpas_pool_get_dimension(statePool, 'index_temperature', indexTemperature)
- call mpas_pool_get_dimension(statePool, 'index_salinity', indexSalinity)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', index_temperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', index_salinity)
call mpas_pool_get_array(meshPool, 'areaCell', areaCell)
call mpas_pool_get_array(meshPool, 'lonCell', lonCell)
call mpas_pool_get_array(meshPool, 'latCell', latCell)
@@ -288,7 +290,7 @@ subroutine ocn_compute_layer_volume_weighted_averages(domain, timeLevel, err)!{{
if (nDefinedDataFields > nLayerVolWeightedAvgFields) then
write (stderrUnit,*) 'Abort: nDefinedDataFields > nLayerVolWeightedAvgFields'
write (stderrUnit,*) ' : increase size of ocn_layer_volume_weighted_averages scratch space'
- call mpas_dmpar_abort(dminfo)
+ call mpas_dmpar_global_abort('MPAS-ocean: Abort: nDefinedDataFields > nLayerVolWeightedAvgFields')
endif
! get pointers to data that will be analyzed
@@ -300,10 +302,10 @@ subroutine ocn_compute_layer_volume_weighted_averages(domain, timeLevel, err)!{{
call mpas_pool_get_array(diagnosticsPool, 'velocityZonal', velocityZonal)
call mpas_pool_get_array(diagnosticsPool, 'velocityMeridional', velocityMeridional)
call mpas_pool_get_array(diagnosticsPool, 'vertVelocityTop', vertVelocityTop)
- call mpas_pool_get_array(statePool, 'tracers', tracers, 1)
call mpas_pool_get_array(diagnosticsPool, 'kineticEnergyCell', kineticEnergyCell)
call mpas_pool_get_array(diagnosticsPool, 'relativeVorticityCell', relativeVorticityCell)
call mpas_pool_get_array(diagnosticsPool, 'divergence', divergence)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
! initialize buffers
workBufferSum(:) = 0.0_RKIND
@@ -320,7 +322,7 @@ subroutine ocn_compute_layer_volume_weighted_averages(domain, timeLevel, err)!{{
call compute_mask(iLevel, maxLevelCell, nCells, nCellsSolve, iRegion, lonCell, latCell, workMask)
! copy data into work array
- workArray( :,:) = 0.0
+ workArray( :,:) = 0.0_RKIND
workArray( 1,:) = workMask(:)
workArray( 2,:) = areaCell(:)
workArray( 3,:) = layerThickness(iLevel,:)
@@ -330,8 +332,8 @@ subroutine ocn_compute_layer_volume_weighted_averages(domain, timeLevel, err)!{{
workArray( 7,:) = velocityZonal(iLevel,:)
workArray( 8,:) = velocityMeridional(iLevel,:)
workArray( 9,:) = vertVelocityTop(iLevel,:)
- workArray(10,:) = tracers(indexTemperature,iLevel,:)
- workArray(11,:) = tracers(indexSalinity,iLevel,:)
+ if ( associated(activeTracers) ) workArray(10,:) = activeTracers(index_temperature,iLevel,:)
+ if ( associated(activeTracers) ) workArray(11,:) = activeTracers(index_salinity,iLevel,:)
workArray(12,:) = kineticEnergyCell(iLevel,:)
workArray(13,:) = relativeVorticityCell(iLevel,:)
workArray(14,:) = divergence(iLevel,:)
@@ -387,16 +389,20 @@ subroutine ocn_compute_layer_volume_weighted_averages(domain, timeLevel, err)!{{
do iRegion=1,nOceanRegionsTmp
do iDataField=1,nDefinedDataFields
do iLevel=1,nVertLevels
- avgValueWithinOceanVolumeRegion(iDataField, iRegion) = avgValueWithinOceanVolumeRegion(iDataField, iRegion) + avgValueWithinOceanLayerRegion(iDataField,iLevel,iRegion)
+ avgValueWithinOceanVolumeRegion(iDataField, iRegion) = avgValueWithinOceanVolumeRegion(iDataField, iRegion) &
+ + avgValueWithinOceanLayerRegion(iDataField,iLevel,iRegion)
enddo
enddo
do iDataField=4,nDefinedDataFields
- avgValueWithinOceanVolumeRegion(iDataField, iRegion) = avgValueWithinOceanVolumeRegion(iDataField, iRegion) / max(avgValueWithinOceanVolumeRegion(3,iRegion),1.0e-8_RKIND)
+ avgValueWithinOceanVolumeRegion(iDataField, iRegion) = avgValueWithinOceanVolumeRegion(iDataField, iRegion) &
+ / max(avgValueWithinOceanVolumeRegion(3,iRegion),1.0e-8_RKIND)
enddo
! normalize total region volume by total volume cell area
- avgValueWithinOceanVolumeRegion(3,iRegion) = avgValueWithinOceanVolumeRegion(3,iRegion) / max(avgValueWithinOceanVolumeRegion(2,iRegion),1.0e-8_RKIND)
+ avgValueWithinOceanVolumeRegion(3,iRegion) = avgValueWithinOceanVolumeRegion(3,iRegion) &
+ / max(avgValueWithinOceanVolumeRegion(2,iRegion),1.0e-8_RKIND)
! normalize total volume cell area by total number of cells
- avgValueWithinOceanVolumeRegion(2,iRegion) = avgValueWithinOceanVolumeRegion(2,iRegion) / max(avgValueWithinOceanVolumeRegion(1,iRegion),1.0e-8_RKIND)
+ avgValueWithinOceanVolumeRegion(2,iRegion) = avgValueWithinOceanVolumeRegion(2,iRegion) &
+ / max(avgValueWithinOceanVolumeRegion(1,iRegion),1.0e-8_RKIND)
enddo
! find min/max with region volume
@@ -412,12 +418,15 @@ subroutine ocn_compute_layer_volume_weighted_averages(domain, timeLevel, err)!{{
do iLevel=1,nVertLevels
! normalize all field by total volume in each layer
do iDataField=4,nDefinedDataFields
- avgValueWithinOceanLayerRegion(iDataField,iLevel,iRegion) = avgValueWithinOceanLayerRegion(iDataField,iLevel,iRegion) / max(avgValueWithinOceanLayerRegion(3,iLevel,iRegion),1.0e-8_RKIND)
+ avgValueWithinOceanLayerRegion(iDataField,iLevel,iRegion) = avgValueWithinOceanLayerRegion(iDataField,iLevel,iRegion) &
+ / max(avgValueWithinOceanLayerRegion(3,iLevel,iRegion),1.0e-8_RKIND)
enddo
! normalize total layer volume by layer area
- avgValueWithinOceanLayerRegion(3,iLevel,iRegion) = avgValueWithinOceanLayerRegion(3,iLevel,iRegion) / max(avgValueWithinOceanLayerRegion(2,iLevel,iRegion),1.0e-8_RKIND)
+ avgValueWithinOceanLayerRegion(3,iLevel,iRegion) = avgValueWithinOceanLayerRegion(3,iLevel,iRegion) &
+ / max(avgValueWithinOceanLayerRegion(2,iLevel,iRegion),1.0e-8_RKIND)
! normalize total layer area by number of cells in region
- avgValueWithinOceanLayerRegion(2,iLevel,iRegion) = avgValueWithinOceanLayerRegion(2,iLevel,iRegion) / max(avgValueWithinOceanLayerRegion(1,iLevel,iRegion),1.0e-8_RKIND)
+ avgValueWithinOceanLayerRegion(2,iLevel,iRegion) = avgValueWithinOceanLayerRegion(2,iLevel,iRegion) &
+ / max(avgValueWithinOceanLayerRegion(1,iLevel,iRegion),1.0e-8_RKIND)
enddo
enddo
@@ -441,7 +450,7 @@ subroutine compute_mask(iLevel, maxLevelCell, nCells, nCellsSolve, iRegion, lonC
integer :: iCell
real(kind=RKIND) :: dtr
- dtr = 4.0_RKIND*atan(1.0_RKIND) / 180.0_RKIND
+ dtr = 4.0_RKIND*atan(1.0_RKIND) / 180.0_RKIND
workMask(:) = 0.0_RKIND
do iCell=1,nCellsSolve
if(iLevel.le.maxLevelCell(iCell)) workMask(iCell) = 1.0_RKIND
@@ -505,7 +514,7 @@ subroutine compute_statistics(nDefinedDataFields, nCellsSolve, workArray, workMa
integer :: iCell, iDataField
real(kind=RKIND) :: cellMask, cellArea, cellVolume
- workSum = 0.0
+ workSum = 0.0_RKIND
do iCell=1,nCellsSolve
cellMask = workMask(iCell) ! mask
cellArea = cellMask * workArray(2,iCell) ! area
diff --git a/src/core_ocean/analysis_members/mpas_ocn_meridional_heat_transport.F b/src/core_ocean/analysis_members/mpas_ocn_meridional_heat_transport.F
index 64bc16b483..39233f1d1f 100644
--- a/src/core_ocean/analysis_members/mpas_ocn_meridional_heat_transport.F
+++ b/src/core_ocean/analysis_members/mpas_ocn_meridional_heat_transport.F
@@ -133,9 +133,12 @@ subroutine ocn_init_meridional_heat_transport(domain, err)!{{{
call mpas_pool_get_dimension(domain % blocklist % dimensions, 'nMerHeatTransBins', nMerHeatTransBins)
call mpas_pool_get_subpool(domain % blocklist % structs, 'meridionalHeatTransportAM', meridionalHeatTransportAMPool)
- call mpas_pool_get_config(domain % configs, 'config_AM_meridionalHeatTransport_num_bins', config_AM_meridionalHeatTransport_num_bins)
- call mpas_pool_get_config(domain % configs, 'config_AM_meridionalHeatTransport_min_bin', config_AM_meridionalHeatTransport_min_bin)
- call mpas_pool_get_config(domain % configs, 'config_AM_meridionalHeatTransport_max_bin', config_AM_meridionalHeatTransport_max_bin)
+ call mpas_pool_get_config(domain % configs, 'config_AM_meridionalHeatTransport_num_bins', &
+ config_AM_meridionalHeatTransport_num_bins)
+ call mpas_pool_get_config(domain % configs, 'config_AM_meridionalHeatTransport_min_bin', &
+ config_AM_meridionalHeatTransport_min_bin)
+ call mpas_pool_get_config(domain % configs, 'config_AM_meridionalHeatTransport_max_bin', &
+ config_AM_meridionalHeatTransport_max_bin)
nMerHeatTransBinsUsed = config_AM_meridionalHeatTransport_num_bins
@@ -163,7 +166,7 @@ subroutine ocn_init_meridional_heat_transport(domain, err)!{{{
call mpas_dmpar_min_real_array(dminfo, 1, minBin, minBinDomain)
call mpas_dmpar_max_real_array(dminfo, 1, maxBin, maxBinDomain)
- ! Set up bins.
+ ! Set up bins.
binBoundaryMerHeatTrans = -1.0e34_RKIND
! Change min and max bin bounds to configuration settings, if applicable.
@@ -240,6 +243,7 @@ subroutine ocn_compute_meridional_heat_transport(domain, timeLevel, err)!{{{
type (block_type), pointer :: block
type (mpas_pool_type), pointer :: meridionalHeatTransportAMPool
type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: tracersPool
type (mpas_pool_type), pointer :: meshPool
type (mpas_pool_type), pointer :: scratchPool
type (mpas_pool_type), pointer :: diagnosticsPool
@@ -255,7 +259,7 @@ subroutine ocn_compute_meridional_heat_transport(domain, timeLevel, err)!{{{
real (kind=RKIND), dimension(:), pointer :: meridionalHeatTransportLat
real (kind=RKIND), dimension(:,:), pointer :: layerThicknessEdge, normalTransportVelocity
real (kind=RKIND), dimension(:,:), pointer :: meridionalHeatTransportLatZ
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
real (kind=RKIND), dimension(:,:), allocatable :: mht_meridional_integral
real (kind=RKIND), dimension(:,:,:), allocatable :: sumMerHeatTrans, totalSumMerHeatTrans
@@ -287,9 +291,11 @@ subroutine ocn_compute_meridional_heat_transport(domain, timeLevel, err)!{{{
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
call mpas_pool_get_dimension(block % dimensions, 'nCellsSolve', nCellsSolve)
- call mpas_pool_get_dimension(statePool, 'index_temperature', indexTemperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', indexTemperature)
call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
@@ -300,7 +306,7 @@ subroutine ocn_compute_meridional_heat_transport(domain, timeLevel, err)!{{{
call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge)
call mpas_pool_get_array(meshPool, 'edgeSignOnCell', edgeSignOnCell)
call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
- call mpas_pool_get_array(statePool, 'tracers', tracers, timeLevel)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, timeLevel)
call mpas_pool_get_array(diagnosticsPool, 'layerThicknessEdge', layerThicknessEdge)
call mpas_pool_get_array(diagnosticsPool, 'normalTransportVelocity', normalTransportVelocity)
@@ -332,7 +338,8 @@ subroutine ocn_compute_meridional_heat_transport(domain, timeLevel, err)!{{{
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
div_huT = div_huT - layerThicknessEdge(k, iEdge) * normalTransportVelocity(k, iEdge) &
- * 0.5_RKIND * (tracers(indexTemperature,k,cellsOnEdge(1,iEdge)) + tracers(indexTemperature,k,cellsOnEdge(2,iEdge))) &
+ * 0.5_RKIND * (activeTracers(indexTemperature,k,cellsOnEdge(1,iEdge)) &
+ + activeTracers(indexTemperature,k,cellsOnEdge(2,iEdge))) &
* edgeSignOnCell(i, iCell) * dvEdge(iEdge)
end do
sumMerHeatTrans(iField,k,iBin) = sumMerHeatTrans(iField,k,iBin) + div_huT
@@ -351,7 +358,8 @@ subroutine ocn_compute_meridional_heat_transport(domain, timeLevel, err)!{{{
! mpi summation over all processors
! Note the input and output arrays are of the same dimension, so summation is
! over the domain decompositon (by processor), not over an array index.
- call mpas_dmpar_sum_real_array(dminfo, nVertLevels*nMerHeatTransBinsUsed*nMerHeatTransVariables, sumMerHeatTrans, totalSumMerHeatTrans)
+ call mpas_dmpar_sum_real_array(dminfo, nVertLevels*nMerHeatTransBinsUsed*nMerHeatTransVariables, &
+ sumMerHeatTrans, totalSumMerHeatTrans)
! Even though these variables do not include an index that is decomposed amongst
! domain partitions, we assign them within a block loop so that all blocks have the
diff --git a/src/core_ocean/analysis_members/mpas_ocn_mixed_layer_depths.F b/src/core_ocean/analysis_members/mpas_ocn_mixed_layer_depths.F
new file mode 100644
index 0000000000..c072c28541
--- /dev/null
+++ b/src/core_ocean/analysis_members/mpas_ocn_mixed_layer_depths.F
@@ -0,0 +1,652 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_mixed_layer_depths
+!
+!> \brief MPAS ocean analysis mode member: mixed_layer_depths
+!> \author Luke Van Roekel
+!> \date August 2015
+!> \details
+!> MPAS ocean analysis mode member: mixed_layer_depths
+!>
+! Computes mixed layer depths via a gradient method and threshold method
+! may add more methods from Holte and Talley (2009) at a future time
+!-----------------------------------------------------------------------
+
+module ocn_mixed_layer_depths
+
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_dmpar
+ use mpas_timekeeping
+ use mpas_stream_manager
+
+ use ocn_constants
+ use ocn_diagnostics_routines
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_mixed_layer_depths, &
+ ocn_compute_mixed_layer_depths, &
+ ocn_restart_mixed_layer_depths, &
+ ocn_finalize_mixed_layer_depths
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_mixed_layer_depths
+!
+!> \brief Initialize MPAS-Ocean analysis member
+!> \author Luke Van Roekel
+!> \date August 2015
+!> \details
+!> This routine conducts all initializations required for the
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_mixed_layer_depths(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ end subroutine ocn_init_mixed_layer_depths!}}}
+
+!***********************************************************************
+!
+! routine ocn_compute_mixed_layer_depths
+!
+!> \brief Compute MPAS-Ocean analysis member
+!> \author Luke Van Roekel
+!> \date August 2015
+!> \details
+!> This routine conducts all computation required for this
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_compute_mixed_layer_depths(domain, timeLevel, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(in) :: timeLevel
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mpas_pool_type), pointer :: mixedLayerDepthsAMPool
+ type (dm_info) :: dminfo
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: diagnosticsPool
+ type (mpas_pool_type), pointer :: tracersPool
+ type (mpas_pool_type), pointer :: mixedLayerDepthsAM
+
+ ! Here are some example variables which may be needed for your analysis member
+ integer, pointer :: nVertLevels, nCellsSolve
+ integer :: k, iCell, i, refIndex, refLevel(1)
+ integer, pointer :: index_temperature
+ integer, dimension(:), pointer :: maxLevelCell
+
+ logical :: found_temp_mld, found_den_mld
+ logical,pointer :: tThresholdFlag, dThresholdFlag
+ logical,pointer :: tGradientFlag, dGradientFlag
+! real (kind=RKIND), dimension(:), pointer :: areaCell
+ real (kind=RKIND), dimension(:), pointer :: tThresholdMLD, tGradientMLD
+ real (kind=RKIND), dimension(:), pointer :: dThresholdMLD, dGradientMLD
+ real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+ real (kind=RKIND), dimension(:,:), pointer :: zTop, zMid, pressure
+ real (kind=RKIND), dimension(:,:), pointer :: potentialDensity
+ real (kind=RKIND), pointer :: tempThresh
+ real (kind=RKIND), pointer :: tempGrad
+ real (kind=RKIND), pointer :: denThresh
+ real (kind=RKIND), pointer :: denGrad
+ integer, pointer :: interp_type
+ integer :: interp_local
+ real (kind=RKIND), pointer :: refPress
+ real (kind=RKIND), allocatable, dimension(:,:) :: densityGradient, temperatureGradient
+ real (kind=RKIND) :: mldTemp,dTempThres, dDenThres, dTempGrad, dDenGrad
+ real (kind=RKIND) :: dz,temp_ref_lev, den_ref_lev, dV, dVm1, dVp1, localVals(6)
+ real (kind=RKIND), dimension(:), pointer :: latCell, lonCell
+ err = 0
+
+ dminfo = domain % dminfo
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mixedLayerDepthsAM', mixedLayerDepthsAMPool)
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'state', statePool)
+
+ call mpas_pool_get_config(domain % configs, 'config_AM_mixedLayerDepths_Tthreshold', tThresholdFlag)
+ call mpas_pool_get_config(domain % configs, 'config_AM_mixedLayerDepths_Dthreshold', dThresholdFlag)
+ call mpas_pool_get_config(domain % configs, 'config_AM_mixedLayerDepths_Tgradient', tGradientFlag)
+ call mpas_pool_get_config(domain % configs, 'config_AM_mixedLayerDepths_Dgradient', dGradientFlag)
+ call mpas_pool_get_config(domain % configs, 'config_AM_mixedLayerDepths_crit_temp_threshold', tempThresh)
+ call mpas_pool_get_config(domain % configs, 'config_AM_mixedLayerDepths_crit_dens_threshold', denThresh)
+ call mpas_pool_get_config(domain % configs, 'config_AM_mixedLayerDepths_temp_gradient_threshold', tempGrad)
+ call mpas_pool_get_config(domain % configs, 'config_AM_mixedLayerDepths_den_gradient_threshold', denGrad)
+ call mpas_pool_get_config(domain % configs, 'config_AM_mixedLayerDepths_interp_method', interp_type)
+ call mpas_pool_get_config(domain % configs, 'config_AM_mixedLayerDepths_reference_pressure', refPress)
+
+ if (interp_type == 1) interp_local = 1
+ if (interp_type == 2) interp_local = 2
+ if (interp_type == 3) interp_local = 3
+
+ block => domain % blocklist
+ do while (associated(block))
+
+ call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(block % structs, 'mixedLayerDepthsAM', mixedLayerDepthsAMPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
+ call mpas_pool_get_dimension(block % dimensions, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(block % dimensions, 'nCellsSolve', nCellsSolve)
+
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', index_temperature)
+
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+
+ call mpas_pool_get_array(tracersPool, 'activeTracers', tracers, timeLevel)
+ call mpas_pool_get_array(diagnosticsPool, 'potentialDensity', &
+ potentialDensity)
+ call mpas_pool_get_array(diagnosticsPool, 'pressure', pressure)
+ call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
+ call mpas_pool_get_array(diagnosticsPool, 'zTop', zTop)
+ call mpas_pool_get_array(meshPool, 'latCell', latCell)
+ call mpas_pool_get_array(meshPool, 'lonCell', lonCell)
+
+
+ if(tThresholdFlag) then
+ call mpas_pool_get_array(mixedLayerDepthsAMPool, 'tThreshMLD',tThresholdMLD)
+ do iCell = 1,nCellsSolve
+
+ found_temp_mld = .false.
+
+ do k=1, maxLevelCell(iCell)-1
+ if(pressure(k+1,iCell) > refPress) then
+ localvals(2:3)=tracers(index_temperature,k:k+1,iCell)
+ localvals(5:6)=pressure(k:k+1,iCell)
+
+ call interp_bw_levels(localVals(2),localVals(3), &
+ localVals(5),localVals(6),refPress,interp_local, &
+ temp_ref_lev)
+ refIndex=k
+ exit
+ endif
+ enddo
+
+ do k=refIndex,maxLevelCell(iCell)-1
+
+ if(.not. found_temp_mld .and. abs(tracers(index_temperature,k+1,iCell) - temp_ref_lev) .ge. tempThresh) then
+ dVp1 = abs(tracers(index_temperature,k+1,iCell) - temp_ref_lev)
+ dV = abs(tracers(index_temperature,k ,iCell) - temp_ref_lev)
+
+ localVals(2:3)=zMid(k:k+1,iCell)
+ call interp_bw_levels(localVals(2),localVals(3), dV, dVp1, tempThresh, &
+ interp_local, mldTemp)!,dVm1, localVals(1))
+ mldTemp=max(mldTemp,zMid(k+1,iCell)) !make sure MLD isn't deeper than zMid(k+1)
+ tThresholdMLD(iCell)=abs(min(mldTemp,zMid(k,iCell))) !MLD should be deeper than zMid(k)
+ found_temp_mld = .true.
+ exit
+ endif
+ enddo
+
+! if the mixed layer depth is not found, it is set to the depth of the bottom most level
+ if(.not. found_temp_mld) tThresholdMLD(iCell) = abs(zMid(maxLevelCell(iCell),iCell))
+ enddo !iCell
+ endif !end tThresh MLD search
+
+ if(dThresholdFlag) then
+ call mpas_pool_get_array(mixedLayerDepthsAMPool, 'dThreshMLD',dThresholdMLD)
+
+ do iCell = 1,nCellsSolve
+
+ found_den_mld = .false.
+
+ do k=1, maxLevelCell(iCell)-1
+ if(pressure(k+1,iCell) > refPress) then
+ localvals(2:3)=potentialDensity(k:k+1,iCell)
+ localvals(5:6)=pressure(k:k+1,iCell)
+
+ call interp_bw_levels(localVals(2),localVals(3), &
+ localVals(5),localVals(6),refPress,interp_local, &
+ den_ref_lev)
+ refIndex=k
+ exit
+ endif
+ enddo
+
+ do k=refIndex,maxLevelCell(iCell)-1
+
+ if(.not. found_den_mld .and. abs(potentialDensity(k+1,iCell) - den_ref_lev) .ge. denThresh) then
+ dVp1 = abs(potentialDensity(k+1,iCell) - den_ref_lev)
+ dV = abs(potentialDensity(k ,iCell) - den_ref_lev)
+ localVals(2:3)=zMid(k:k+1,iCell)
+ call interp_bw_levels(localVals(2),localVals(3), dV, dVp1, denThresh, &
+ interp_local, mldTemp)!, dVm1, localVals(1))
+ mldTemp=max(mldTemp,zMid(k+1,iCell)) !make sure MLD isn't deeper than zMid(k+1)
+ dThresholdMLD(iCell)=abs(min(mldTemp,zMid(k,iCell))) !MLD should be deeper than zMid(k)
+ found_den_mld = .true.
+ exit
+ endif
+ enddo
+
+! if the mixed layer depth is not found, it is set to the depth of the bottom most level
+
+ if(.not. found_den_mld) dThresholdMLD(iCell) = abs(zMid(maxLevelCell(iCell),iCell))
+
+ enddo !iCell
+
+ endif !end dThresh MLD search
+
+
+! Compute the mixed layer depth based on a gradient threshold in temperature and density
+ if(tGradientFlag) then
+ call mpas_pool_get_array(mixedLayerDepthsAMPool, 'tGradMLD',tGradientMLD)
+
+ allocate(temperatureGradient(nVertLevels,2))
+
+ do iCell = 1,nCellsSolve
+
+ temperatureGradient(:,1) = 0.0_RKIND
+ temperatureGradient(1,2) = 1
+
+ found_temp_mld=.false.
+
+ do k=2,maxLevelCell(iCell)-1
+ dz=abs(pressure(k-1,iCell)-pressure(k,iCell))
+ temperatureGradient(k,1) = abs(tracers(index_temperature,k-1,iCell) - tracers(index_temperature,k,iCell)) / dz
+ temperatureGradient(k,2) = k
+ enddo
+
+! smooth the gradients to eliminate reduce single point maxima
+
+ do k=2,maxLevelCell(iCell)-1
+ temperatureGradient(k,1) = (temperatureGradient(k-1,1) + temperatureGradient(k,1) &
+ + temperatureGradient(k+1,1)) / float(3)
+ enddo
+
+
+ do k=2, maxLevelCell(iCell)-1
+ if(.not. found_temp_mld .and. temperatureGradient(k+1,1) .ge. tempGrad) then
+ call interp_bw_levels(zTop(k,iCell),zTop(k+1,iCell),temperatureGradient(k,1),temperatureGradient(k+1,1), &
+ tempGrad, interp_local,mldTemp,temperatureGradient(k-1,1),zTop(k-1,iCell))
+
+ mldTemp=max(mldTemp,zTop(k+1,iCell)) !make sure MLD isn't deeper than zMid(k+1)
+ tGradientMLD(iCell)=abs(min(mldTemp,zTop(k,iCell))) !MLD should be deeper than zMid(k)
+
+ found_temp_mld=.true.
+ exit
+ endif
+
+ enddo !maxLevelCell
+
+ if(.not. found_temp_mld) then
+ refLevel=maxloc(temperatureGradient(:,1))
+ tGradientMLD(iCell) = abs(zTop(refLevel(1),iCell))
+ endif
+
+ enddo !icell
+
+ deallocate(temperatureGradient)
+
+ endif !if(temperaturegradientflag)
+
+ if(dGradientFlag) then
+ call mpas_pool_get_array(mixedLayerDepthsAMPool, 'dGradMLD',dGradientMLD)
+
+ allocate(densityGradient(nVertLevels,2))
+
+ do iCell = 1,nCellsSolve
+
+ densityGradient(:,1)=0.0_RKIND
+ densityGradient(1,2) = 1
+
+ found_den_mld=.false.
+
+ do k=2,maxLevelCell(iCell)-1
+ dz=abs(pressure(k-1,iCell)-pressure(k,iCell))
+ densityGradient(k,1) = abs(potentialDensity(k-1,iCell)-potentialDensity(k,iCell)) / dz
+ densityGradient(k,2) = k
+ enddo
+
+! smooth the gradients to eliminate reduce single point maxima
+
+ do k=2,maxLevelCell(iCell)-1
+ densityGradient(k,1) = (densityGradient(k-1,1) + densityGradient(k,1) + densityGradient(k+1,1)) / float(3)
+ enddo
+
+
+ do k=2, maxLevelCell(iCell)-1
+ if(.not. found_den_mld .and. densityGradient(k+1,1) .ge. denGrad) then
+ call interp_bw_levels(zTop(k,iCell),zTop(k+1,iCell),densityGradient(k,1),densityGradient(k+1,1), &
+ denGrad, interp_local,mldTemp,densityGradient(k-1,1),zTop(k-1,iCell))
+ mldTemp=max(mldTemp,zTop(k+1,iCell)) !make sure MLD isn't deeper than zMid(k+1)
+ dGradientMLD(iCell)=abs(min(mldTemp,zTop(k,iCell))) !MLD should be deeper than zMid(k)
+ found_den_mld=.true.
+ exit
+ endif
+
+ enddo !maxLevelCell
+
+
+ if(.not. found_den_mld) then
+ refLevel=maxloc(densityGradient(:,2))
+ dGradientMLD(iCell) = abs(zTop(refLevel(1),iCell))
+ endif
+
+ enddo !icell
+
+ deallocate(densityGradient)
+ endif !if(densitygradientflag)
+
+ block => block % next
+ end do
+
+
+ ! Even though some variables do not include an index that is decomposed amongst
+ ! domain partitions, we assign them within a block loop so that all blocks have the
+ ! correct values for writing output.
+! block => domain % blocklist
+! do while (associated(block))
+! call mpas_pool_get_subpool(block % structs, 'temPlateAM', temPlateAMPool)
+!
+! ! assignment of final temPlateAM variables could occur here.
+!
+! block => block % next
+! end do
+
+ end subroutine ocn_compute_mixed_layer_depths!}}}
+
+!***********************************************************************
+!
+! routine interp_bw_levels
+!
+!> \brief Interpolates between model layers
+!> \author Luke Van Roekel
+!> \date September 2015
+!> \details
+!> This routine conducts computations to compute various field values
+!> between model levels (in pressure or depth) or could interpolate
+!> between temperature/salinity/density values. Interpolations are
+!> of the form
+!> y = coeffs(1)*x^3 + coeffs(2)*x^2 + coeffs(3)*x + coeffs(4)
+!
+!-----------------------------------------------------------------------
+
+ subroutine interp_bw_levels(y0,y1,x0,x1,xT,interp_f,yT,xm1,ym1)!{{{
+
+ integer,intent(in) :: interp_f ! linear, quadratic, or spline
+ real(kind=RKIND),intent(in) :: y0,y1,x0,x1,xT
+ real(kind=RKIND),intent(inout) :: yT
+ real(kind=RKIND),optional,intent(in) :: xm1,ym1
+ ! these values are to match the slope at a given point
+
+!------------------------------------------------------------------------
+!
+! Local variables for the interpolations
+!
+!------------------------------------------------------------------------
+
+ real(kind=RKIND) :: coeffs(4) ! stores the coefficients for the interp
+ real(kind=RKIND) :: Minv(4,4) ! holds values for computing quad and spline
+ real(kind=RKIND) :: det
+ real(kind=RKIND) :: rhs(4)
+ integer :: k,k2
+
+ coeffs(:) = 0.0_RKIND
+ Minv(:,:) = 0.0_RKIND
+ rhs(:) = 0.0_RKIND
+
+
+ select case (interp_f)
+
+ case (1)
+
+ coeffs(2) = (y1-y0)/(x1-x0)
+ coeffs(1) = y0 - coeffs(2)*x0
+ case (2)
+
+ det = -(x1-x0)**2
+ rhs(1) = y0
+ rhs(2) = y1
+
+ if(present(xm1) .and. present(ym1)) then
+ rhs(3) = (y0-ym1)/(x0-xm1)
+ else
+ rhs(3) = 0.0_RKIND
+ endif
+
+ Minv(1,1) = -1.0_RKIND/det
+ Minv(1,2) = 1.0_RKIND/det
+ Minv(1,3) = -1.0_RKIND/(x1-x0)
+ Minv(2,1) = 2.0_RKIND*x0/det
+ Minv(2,2) = -2.0_RKIND*x0/det
+ Minv(2,3) = (x1+x0)/(x1-x0)
+ Minv(3,1) = -(x0**2)/det
+ Minv(3,2) = x1*(2.0_RKIND*x0-x1)/det
+ Minv(3,3) = -x1*x0/(x1-x0)
+
+ do k=1,3
+ do k2=1,3
+ coeffs(k2) = coeffs(k2) + Minv(4-k2,k)*rhs(k)
+ enddo
+ enddo
+
+ case (3)
+ det = -(x1-x0)**3
+ rhs(1) = y1
+ rhs(2) = y0
+ if(present(xm1) .and. present(ym1)) then
+ rhs(3) = (y0-ym1)/(x0-xm1)
+ else
+ rhs(3) = 0.0_RKIND
+ endif
+
+ rhs(4) = (y1-y0)/(x1-x0)
+
+ Minv(1,1) = 2.0_RKIND/det
+ Minv(1,2) = -2.0_RKIND/det
+ Minv(1,3) = (x0-x1)/det
+ Minv(1,4) = (x0-x1)/det
+ Minv(2,1) = -3.0_RKIND * (x1+x0)/det
+ Minv(2,2) = 3.0_RKIND*(x1+x0)/det
+ Minv(2,3) = (x1-x0)*(2.0_RKIND*x1+x0)/det
+ Minv(2,4) = (x1-x0)*(2.0_RKIND*x0+x1)/det
+ Minv(3,1) = 6.0_RKIND*x1*x0/det
+ Minv(3,2) = -6.0_RKIND*x1*x0/det
+ Minv(3,3) = -x1*(x1-x0)*(2.0_RKIND*x0+x1)/det
+ Minv(3,4) = -x0*(x1-x0)*(2.0_RKIND*x1+x0)/det
+ Minv(4,1) = -(x0**2)*(3.0_RKIND*x1-x0)/det
+ Minv(4,2) = -(x1**2)*(-3.0_RKIND*x0+x1)/det
+ Minv(4,3) = x0*(x1**2)*(x1-x0)/det
+ Minv(4,4) = x1*(x0**2)*(x1-x0)/det
+
+ do k=1,4
+ do k2=1,4
+ coeffs(k2) = coeffs(k2) + Minv(5-k2,k)*rhs(k)
+ enddo
+ enddo
+
+ end select
+
+ yT = coeffs(4)*xT**3 + coeffs(3)*xT**2 + coeffs(2)*xT + coeffs(1)
+ end subroutine interp_bw_levels!}}}
+
+!***********************************************************************
+!
+! routine ocn_restart_mixed_layer_depths
+!
+!> \brief Save restart for MPAS-Ocean analysis member
+!> \author Luke Van Roekel
+!> \date September 2015
+!> \details
+!> This routine conducts computation required to save a restart state
+!> for the MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_restart_mixed_layer_depths(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ end subroutine ocn_restart_mixed_layer_depths!}}}
+
+!***********************************************************************
+!
+! routine ocn_finalize_mixed_layer_depths
+!
+!> \brief Finalize MPAS-Ocean analysis member
+!> \author Luke Van Roekel
+!> \date August 2015
+!> \details
+!> This routine conducts all finalizations required for this
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_finalize_mixed_layer_depths(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ end subroutine ocn_finalize_mixed_layer_depths!}}}
+
+end module ocn_mixed_layer_depths
+
+! vim: foldmethod=marker
diff --git a/src/core_ocean/analysis_members/mpas_ocn_moc_streamfunction.F b/src/core_ocean/analysis_members/mpas_ocn_moc_streamfunction.F
new file mode 100644
index 0000000000..07b4101cf8
--- /dev/null
+++ b/src/core_ocean/analysis_members/mpas_ocn_moc_streamfunction.F
@@ -0,0 +1,719 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_TEM_PLATE
+!
+!> \brief MPAS ocean analysis mode member: TEM_PLATE
+!> \author FILL_IN_AUTHOR
+!> \date FILL_IN_DATE
+!> \details
+!> MPAS ocean analysis mode member: TEM_PLATE
+!> In order to add a new analysis member, do the following:
+!> 1. Copy these to your new analysis member name:
+!> cp mpas_ocn_TEMPLATE.F mpas_ocn_your_new_name.F
+!> cp Registry_ocn_TEMPLATE.xml Registry_ocn_your_new_name.xml
+!>
+!> 2. In those two new files, replace the following text:
+!> temPlate, TEM_PLATE, FILL_IN_AUTHOR, FILL_IN_DATE
+!> Typically temPlate uses camel case (variable names), like yourNewName,
+!> while TEM_PLATE uses underscores (subroutine names), like your_new_name.
+!> note: do not replace 'filename_template' in Registry_ocn_yourNewName.xml
+!>
+!> 3. Add a #include line for your registry to
+!> Registry_analysis_members.xml
+!>
+!> 4. In mpas_ocn_analysis_driver.F, add a use statement for your new analysis member.
+!> In addition, add lines for your analysis member, and replace TEM_PLATE
+!> and temPlate as described in step 2. There should be 5 places that need additions:
+!> - Adding the analysis member name to the analysis member list
+!> - Adding an init if test can subroutine call
+!> - Adding a compute if test can subroutine call
+!> - Adding a restart if test can subroutine call
+!> - Adding a finalize if test can subroutine call
+!>
+!> 5. In src/core_ocean/analysis_members/Makefile, add your
+!> new analysis member to the list of members. See another analysis member
+!> in that file for an example.
+!> NOTE: If your analysis member depends on other files, add a dependency
+!> line for the member and list them there. See okubo weiss for an example.
+!>
+!-----------------------------------------------------------------------
+
+module ocn_moc_streamfunction
+
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_dmpar
+ use mpas_timekeeping
+ use mpas_stream_manager
+
+ use ocn_constants
+ use ocn_diagnostics_routines
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_moc_streamfunction, &
+ ocn_compute_moc_streamfunction, &
+ ocn_restart_moc_streamfunction, &
+ ocn_finalize_moc_streamfunction
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ integer :: nMocStreamfunctionBinsUsed
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_moc_streamfunction
+!
+!> \brief Initialize MPAS-Ocean analysis member
+!> \author Nils H. Feige
+!> \date 2016-04-08
+!> \details
+!> This routine conducts all initializations required for the
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_moc_streamfunction(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ type (dm_info) :: dminfo
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: mocStreamfunctionAMPool
+ type (mpas_pool_type), pointer :: meshPool
+
+ integer :: iBin
+
+ real (kind=RKIND) :: binWidth
+ ! These are array size 1 because mpas_dmpar_min_real_array calls require arrays.
+ real (kind=RKIND), dimension(1) :: minBin, maxBin, minBinDomain, maxBinDomain
+ ! the variable used to discriminate cells into Bins (either the y-value or the latitude)
+ real (kind=RKIND), dimension(:), pointer :: binVariable, binBoundaryMocStreamfunction
+
+ !number of latitude bins specified in the config
+ integer, pointer :: config_AM_mocStreamfunction_num_bins
+ !smallest and highest latitude specified in the config
+ real (kind=RKIND), pointer :: config_AM_mocStreamfunction_min_bin, config_AM_mocStreamfunction_max_bin
+
+ !determines if the simulation was run on a sphere or on a plane
+ logical, pointer :: on_a_sphere
+
+ !!!! REGION STUFF
+ !! region moc calculation variables
+ integer :: currentRegion, i, iCell
+
+ !! region arrays/variables
+ character (len=STRKIND), dimension(:), pointer :: regionGroupNames
+ integer, dimension(:, :), pointer :: regionCellMasks, regionsInGroup
+ integer, dimension(:), pointer :: nRegionsInGroup
+ integer, pointer :: nRegions, nRegionGroups, maxRegionsInGroup, nCellsSolve
+ real (kind=RKIND), dimension(:,:), pointer :: minMaxLatRegion
+ real (kind=RKIND), dimension(:) , pointer :: minLatRegionLocal, maxLatRegionLocal
+ character (len=STRKIND), pointer :: additionalRegion
+
+ !! region preliminary variables
+ integer :: regionGroupNumber, regionsInAddGroup
+
+ !!region pool
+ type (mpas_pool_type), pointer :: regionPool
+
+ !! region dimensions
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, 'nRegions', nRegions)
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, 'nRegionGroups', nRegionGroups)
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, 'maxRegionsInGroup', maxRegionsInGroup)
+
+ !! region config for moc
+ call mpas_pool_get_config(domain % configs, 'config_AM_mocStreamfunction_region_group', &
+ additionalRegion)
+
+ !! get region values
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'regions', regionPool)
+ call mpas_pool_get_array(regionPool, 'regionsInGroup', regionsInGroup)
+ call mpas_pool_get_array(regionPool, 'nRegionsInGroup', nRegionsInGroup)
+ call mpas_pool_get_array(regionPool, 'regionGroupNames', regionGroupNames)
+
+ !!! region preliminaries
+ do i = 1, nRegionGroups
+ if (regionGroupNames(i) .eq. additionalRegion) then
+ regionGroupNumber = i
+ end if
+ end do
+
+ regionsInAddGroup = nRegionsInGroup(regionGroupNumber)
+ !!!! END REGION STUFF
+
+ allocate(minLatRegionLocal(maxRegionsInGroup))
+ allocate(maxLatRegionLocal(maxRegionsInGroup))
+
+ dminfo = domain % dminfo
+
+ err = 0
+
+ minBin = 1.0e34_RKIND
+ maxBin = -1.0e34_RKIND
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mocStreamfunctionAM', mocStreamfunctionAMPool)
+
+ call mpas_pool_get_config(domain % configs, 'config_AM_mocStreamfunction_num_bins', &
+ config_AM_mocStreamfunction_num_bins)
+ call mpas_pool_get_config(domain % configs, 'config_AM_mocStreamfunction_min_bin', &
+ config_AM_mocStreamfunction_min_bin)
+ call mpas_pool_get_config(domain % configs, 'config_AM_mocStreamfunction_max_bin', &
+ config_AM_mocStreamfunction_max_bin)
+
+ call mpas_pool_get_array(mocStreamfunctionAMPool, 'minMaxLatRegion', minMaxLatRegion)
+
+ minLatRegionLocal(:) = 4.0_RKIND
+ maxLatRegionLocal(:) = -4.0_RKIND
+
+ nMocStreamfunctionBinsUsed = config_AM_mocStreamfunction_num_bins
+
+ call mpas_pool_get_array(mocStreamfunctionAMPool, 'binBoundaryMocStreamfunction', binBoundaryMocStreamfunction)
+
+ ! Find min and max values of binning variable. For the whole domain as well as for each region
+ ! in the current region group.
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+ call mpas_pool_get_dimension(block % dimensions, 'nCellsSolve', nCellsSolve)
+
+ call mpas_pool_get_array(regionPool, 'regionCellMasks', regionCellMasks)
+
+ ! Bin by latitude on a sphere, by yCell otherwise.
+ if (on_a_sphere) then
+ call mpas_pool_get_array(meshPool, 'latCell', binVariable)
+ else
+ call mpas_pool_get_array(meshPool, 'yCell', binVariable)
+ end if
+
+ minBin = min(minBin, minval(binVariable) )
+ maxBin = max(maxBin, maxval(binVariable) )
+
+ do i = 1, regionsInAddGroup
+ currentRegion = regionsInGroup(i, regionGroupNumber)
+ do iCell = 1, nCellsSolve
+ if (regionCellMasks(currentRegion, iCell) .eq. 1) then
+ minLatRegionLocal(i) = min(minLatRegionLocal(i), binVariable(iCell))
+ maxLatRegionLocal(i) = max(maxLatRegionLocal(i), binVariable(iCell))
+ end if
+ end do
+ end do
+
+ block => block % next
+ end do
+
+ call mpas_dmpar_min_real_array(dminfo, 1, minBin, minBinDomain)
+ call mpas_dmpar_max_real_array(dminfo, 1, maxBin, maxBinDomain)
+
+ call mpas_dmpar_min_real_array(dminfo, maxRegionsInGroup, minLatRegionLocal(:), minLatRegionLocal(:))
+ call mpas_dmpar_max_real_array(dminfo, maxRegionsInGroup, maxLatRegionLocal(:), maxLatRegionLocal(:))
+
+ minMaxLatRegion(1, :) = minLatRegionLocal(:)
+ minMaxLatRegion(2, :) = maxLatRegionLocal(:)
+
+ deallocate(minLatRegionLocal)
+ deallocate(maxLatRegionLocal)
+
+ !print *, 'mins:', minMaxLatRegion(1,:)
+ !print *, 'maxs:', minMaxLatRegion(2,:)
+
+ ! Set up bins.
+ binBoundaryMocStreamfunction = -1.0e34_RKIND
+
+ ! Change min and max bin bounds to configuration settings, if applicable.
+ if (config_AM_mocStreamfunction_min_bin > -1.0e33_RKIND) then
+ minBinDomain(1) = config_AM_mocStreamfunction_min_bin
+ else
+ ! use measured min value, but decrease slightly to include least value.
+ minBinDomain(1) = minBinDomain(1) - 1.0e-10_RKIND * abs(minBinDomain(1))
+ end if
+
+ if (config_AM_mocStreamfunction_max_bin > -1.0e33_RKIND) then
+ maxBinDomain(1) = config_AM_mocStreamfunction_max_bin
+ else
+ ! use measured max value, but increase slightly to include max value.
+ maxBinDomain(1) = maxBinDomain(1) + 1.0e-10_RKIND * abs(maxBinDomain(1))
+ end if
+
+ binBoundaryMocStreamfunction(1) = minBinDomain(1)
+ binWidth = (maxBinDomain(1) - minBinDomain(1)) / nMocStreamfunctionBinsUsed
+
+ ! Use the same bin boundaries for the regions and the global MOC.
+ do iBin = 2, nMocStreamfunctionBinsUsed
+ binBoundaryMocStreamfunction(iBin) = binBoundaryMocStreamfunction(iBin-1) + binWidth
+ end do
+ binBoundaryMocStreamfunction(nMocStreamfunctionBinsUsed+1) = binBoundaryMocStreamfunction(nMocStreamfunctionBinsUsed) + binWidth
+
+ end subroutine ocn_init_moc_streamfunction!}}}
+
+!***********************************************************************
+!
+! routine ocn_compute_moc_streamfunction
+!
+!> \brief Compute MPAS-Ocean analysis member
+!> \author Nils H. Feige
+!> \date 2016-04-08
+!> \details
+!> This routine conducts all computation required for this
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_compute_moc_streamfunction(domain, timeLevel, err)!{{{
+ implicit none
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(in) :: timeLevel
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mpas_pool_type), pointer :: mocStreamfunctionAMPool
+ type (dm_info) :: dminfo
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: diagnosticsPool
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: regionPool
+
+ integer, pointer :: nVertLevels, nCellsSolve
+ integer :: iCell, iBin, genericCounter, k
+ real (kind=RKIND) :: binWidth
+ real (kind=RKIND), dimension(:,:), pointer :: mocStreamValLatAndDepthLocal
+ real (kind=RKIND), dimension(:), pointer :: latCell
+ real (kind=RKIND), dimension(:), pointer :: areaCell, binBoundaryMocStreamfunction
+ real (kind=RKIND), dimension(:,:), pointer :: mocStreamvalLatAndDepth, mocStreamValLatAndDepthTotal
+ real (kind=RKIND), dimension(:,:), pointer :: vertVelocityTop
+ real (kind=RKIND), dimension(:,:), pointer :: sumVertBinVelocity
+ character (len=STRKIND), pointer :: verticalVelocityArrayName, normalVelocityArrayName
+
+ !!!! TRANSECT VARIABLES !!!!
+ integer, pointer :: nEdgesSolve, num_tracers, nTransects
+ integer :: iEdge, iTransect, c1, c2
+ integer, dimension(:), pointer :: maxLevelEdgeTop, transectEdgeMasksMax
+ integer, dimension(:,:), pointer :: transectEdgeMasks, transectEdgeMaskSigns, cellsOnEdge
+
+ real (kind=RKIND) :: m3ps_to_Sv
+ real (kind=RKIND), dimension(:), pointer :: dvEdge, transectVolumeTransport,refLayerThickness
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness, normalVelocity, transectVolumeTransportZ
+ real (kind=RKIND), dimension(:,:), allocatable :: sumTransport, totalSumTransport
+ character (len=STRKIND), pointer :: additionalTransect
+ !!!! END TRANSECT VARIABLES !!!!
+
+ !!!! REGION VARIABLES
+ real (kind=RKIND) :: maskFactor
+ integer :: currentRegion, i
+ real (kind=RKIND), dimension(:,:,:), pointer :: mocStreamValLatAndDepthRegionLocal, &
+ mocStreamvalLatAndDepthRegion, mocStreamValLatAndDepthRegionTotal, &
+ sumVertBinVelocityRegion
+ character (len=STRKIND), dimension(:), pointer :: regionNames, regionGroupNames
+ integer, dimension(:, :), pointer :: regionCellMasks, regionVertexMasks, regionsInGroup
+ integer, dimension(:), pointer :: nRegionsInGroup
+ integer, pointer :: nRegions, nRegionGroups, maxRegionsInGroup
+ character (len=STRKIND), pointer :: additionalRegion
+ integer :: regionGroupNumber, regionsInAddGroup
+
+ !!!! END REGION VARIABLES
+
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, 'nVertLevels', nVertLevels)
+
+ !!!! REGION INITIALIZATION
+ !! region dimensions
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, 'nRegions', nRegions)
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, 'nRegionGroups', nRegionGroups)
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, 'maxRegionsInGroup', maxRegionsInGroup)
+
+ !! region config for moc
+ call mpas_pool_get_config(domain % configs, 'config_AM_mocStreamfunction_region_group', &
+ additionalRegion)
+
+ !! get region values
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'regions', regionPool)
+ call mpas_pool_get_array(regionPool, 'regionsInGroup', regionsInGroup)
+ call mpas_pool_get_array(regionPool, 'nRegionsInGroup', nRegionsInGroup)
+ call mpas_pool_get_array(regionPool, 'regionNames', regionNames)
+ call mpas_pool_get_array(regionPool, 'regionGroupNames', regionGroupNames)
+
+ !print *, 'nRegions', nRegions
+ !print *, 'nRegionGroups', nRegionGroups
+ !print *, 'maxRegionsInGroup', maxRegionsInGroup
+ !print *, 'regionsInGroup', regionsInGroup
+ !print *, 'regionNames', regionNames
+ !print *, 'regionGroupNames', regionGroupNames
+
+ !!! region preliminaries
+ !print *, 'additional Region: ', additionalRegion
+ do i = 1, nRegionGroups
+ if (regionGroupNames(i) .eq. additionalRegion) then
+ regionGroupNumber = i
+ ! print *, 'found region with the same name:', regionGroupNames(i)
+ end if
+ end do
+
+ regionsInAddGroup = nRegionsInGroup(regionGroupNumber)
+ !print *, 'the region group has', regionsInAddGroup, ' regions'
+
+ !print *, 'the numbers of the regions in the group are:'
+ !do i = 1, regionsInAddGroup
+ ! print *, regionsInGroup(i, regionGroupNumber)
+ !end do
+
+ !print *, 'the names of the regions are:'
+ !do i = 1, regionsInAddGroup
+ ! print *, regionNames(regionsInGroup(i, regionGroupNumber))
+ !end do
+
+ !! allocate regional moc calculation arrays
+ allocate(mocStreamValLatAndDepthRegionLocal(nMocStreamfunctionBinsUsed + 1, nVertLevels, maxRegionsInGroup))
+ allocate(sumVertBinVelocityRegion(nMocStreamfunctionBinsUsed + 1, nVertLevels, maxRegionsInGroup))
+ allocate(mocStreamValLatAndDepthRegionTotal(nMocStreamfunctionBinsUsed + 1, nVertLevels, maxRegionsInGroup))
+
+ mocStreamValLatAndDepthRegionLocal = 0.0_RKIND
+ mocStreamValLatAndDepthRegionTotal = 0.0_RKIND
+ sumVertBinVelocityRegion = 0.0_RKIND
+ !!!! END REGION INITIALIZATION
+
+ !!!! TRANSECT INITIALIZATION
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, 'nTransects',nTransects)
+
+ allocate(sumTransport(nVertLevels,nTransects))
+ allocate(totalSumTransport(nVertLevels,nTransects))
+
+ m3ps_to_Sv = 1e-6
+
+ call mpas_pool_get_config(domain % configs, 'config_AM_mocStreamfunction_transect_group', &
+ additionalTransect)
+
+ !!!! END TRANSECT INITIALIZATION
+
+ err = 0
+
+ dminfo = domain % dminfo
+
+ allocate(mocStreamValLatAndDepthLocal(nMocStreamfunctionBinsUsed + 1, nVertLevels))
+ allocate(sumVertBinVelocity(nMocStreamfunctionBinsUsed + 1, nVertLevels))
+ allocate(mocStreamValLatAndDepthTotal(nMocStreamfunctionBinsUsed + 1, nVertLevels))
+
+ mocStreamValLatAndDepthLocal = 0.0_RKIND
+ mocStreamValLatAndDepthTotal = 0.0_RKIND
+ sumVertBinVelocity = 0.0_RKIND
+
+ call mpas_pool_get_config(domain % configs, 'config_AM_mocStreamfunction_vertical_velocity_value', &
+ verticalVelocityArrayName)
+
+ call mpas_pool_get_config(domain % configs, 'config_AM_mocStreamfunction_normal_velocity_value', &
+ normalVelocityArrayName)
+
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block % structs, 'mocStreamfunctionAM', mocStreamfunctionAMPool)
+ call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
+
+ call mpas_pool_get_array(mocStreamfunctionAMPool, 'binBoundaryMocStreamfunction', binBoundaryMocStreamfunction)
+
+ binWidth = (binBoundaryMocStreamfunction(nMocStreamfunctionBinsUsed + 1) - binBoundaryMocStreamfunction(1)) &
+ / nMocStreamfunctionBinsUsed
+
+ call mpas_pool_get_dimension(block % dimensions, 'nCellsSolve', nCellsSolve)
+
+ call mpas_pool_get_array(diagnosticsPool, verticalVelocityArrayName, vertVelocityTop)
+ call mpas_pool_get_array(meshPool, 'latCell', latCell)
+ call mpas_pool_get_array(meshPool, 'areaCell', areaCell)
+
+ call mpas_pool_get_array(regionPool, 'regionCellMasks', regionCellMasks)
+
+ !!!! TRANSECT DOMAINSPLIT VARIABLES
+ call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge)
+ call mpas_pool_get_dimension(block % dimensions, 'nEdgesSolve', nEdgesSolve)
+ call mpas_pool_get_array(mocStreamfunctionAMPool,'transectEdgeMaskSigns',transectEdgeMaskSigns)
+ call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_array(statePool, normalVelocityArrayName, normalVelocity)
+ call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
+ call mpas_pool_get_array(meshPool, 'maxLevelEdgeTop', maxLevelEdgeTop)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness)
+
+
+ !!!! TRANSECT CALCULATION
+ !!!! NOTE: iTransect == iRegion !!!! This might have to change!
+ !!!! Define transect group, find current transect group number, find
+ !!!! nTransects in that group, find transects in group. THEN for each
+ !!!! transect in the group, there should be a region in the region
+ !!!! group so that the region number equals the transect number
+
+ sumTransport = 0.0_RKIND
+ do iTransect = 1,nTransects
+
+ do iEdge = 1,nEdgesSolve
+ c1 = cellsOnEdge(1,iEdge)
+ c2 = cellsOnEdge(2,iEdge)
+ do k = 1, maxLevelEdgeTop(iEdge)
+ sumTransport(k,iTransect) = sumTransport(k,iTransect) + &
+ transectEdgeMaskSigns(iTransect,iEdge) &
+ * normalVelocity(k,iEdge)*dvEdge(iEdge) &
+ * 0.5_RKIND*(layerThickness(k,c1) + layerThickness(k,c2))
+ end do
+ end do
+ do k = 2, nVertLevels
+ mocStreamValLatAndDepthRegionLocal(1, k, iTransect) = &
+ mocStreamValLatAndDepthRegionLocal(1, k - 1, iTransect) &
+ + sumTransport(k - 1, iTransect)
+ end do
+ end do
+
+ !!!! END TRANSECT CALCULATION
+
+ do iCell = 1,nCellsSolve
+ do iBin = 1, nMocStreamfunctionBinsUsed
+ if (latCell(iCell) .gt. binBoundaryMocStreamfunction(iBin) .and. latCell(iCell) .lt. binBoundaryMocStreamfunction(iBin + 1)) then
+
+ !!!! TESTING CODE. THIS CODE ALTERS THE VERTICAL VELOCITY TO PRODUCE A PREDICTABLE
+ ! PATTERN IF THE CALCULATION IS CORRECT. TESTS SHOW THIS PREDICTABLE PATTERN SO THIS
+ ! IS NOT USED ANYMORE.
+ !
+ ! if (latCell(iCell) .lt. -0.785398_RKIND .or. latCell(iCell) .gt. 0.785398_RKIND) then
+ ! vertVelocityTop(:, iCell) = 0.0_RKIND
+ ! else
+ ! vertVelocityTop(1:25, iCell) = 0.0_RKIND
+ ! vertVelocityTop(76:100, iCell) = 0.0_RKIND
+ ! if (latCell(iCell) .lt. 0.0_RKIND) then
+ ! do k = 26, 75
+ ! vertVelocityTop(k, iCell) = 1.0_RKIND + k - 26
+ ! end do
+ ! else
+ ! do k = 26, 75
+ ! vertVelocityTop(k, iCell) = -1.0_RKIND - k + 26
+ ! end do
+ ! end if
+ ! end if
+ !!!! END TESTING CODE
+
+ !!!!! REGION STUFF
+
+ do i = 1, regionsInAddGroup
+ currentRegion = regionsInGroup(i, regionGroupNumber)
+ sumVertBinVelocityRegion(iBin, :, i) = sumVertBinVelocityRegion(iBin, :, i) + (vertVelocityTop(:, iCell) * &
+ areaCell(iCell) * regionCellMasks(currentRegion, iCell))
+ end do
+
+ !!!!! END REGION STUFF
+ sumVertBinVelocity(iBin, :) = sumVertBinVelocity(iBin, :) + (vertVelocityTop(:, iCell) * areaCell(iCell))
+ end if
+ end do
+ end do
+
+ do iBin = 2, nMocStreamfunctionBinsUsed + 1
+ do k = 1, nVertLevels
+ mocStreamValLatAndDepthLocal(iBin, k) = mocStreamValLatAndDepthLocal(iBin-1, k) &
+ + sumVertBinVelocity(iBin, k)
+ do i = 1, regionsInAddGroup
+ mocStreamValLatAndDepthRegionLocal(iBin, k, i) = mocStreamValLatAndDepthRegionLocal(iBin-1, k, i) &
+ + sumVertBinVelocityRegion(iBin, k, i)
+ end do
+ end do
+ end do
+
+ block => block % next
+ end do
+
+ call mpas_dmpar_sum_real_array(dminfo, nVertLevels * (nMocStreamfunctionBinsUsed + 1), mocStreamValLatAndDepthLocal, &
+ mocStreamvalLatAndDepthTotal)
+
+ call mpas_dmpar_sum_real_array(dminfo, nVertLevels * (nMocStreamfunctionBinsUsed + 1) * maxRegionsInGroup, mocStreamValLatAndDepthRegionLocal, &
+ mocStreamvalLatAndDepthRegionTotal)
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mocStreamfunctionAM', mocStreamfunctionAMPool)
+ call mpas_pool_get_array(mocStreamfunctionAMPool, 'mocStreamvalLatAndDepth', mocStreamvalLatAndDepth)
+ mocStreamvalLatAndDepth = mocStreamvalLatAndDepthTotal * m3ps_to_Sv
+
+ call mpas_pool_get_array(mocStreamfunctionAMPool, 'mocStreamvalLatAndDepthRegion', mocStreamvalLatAndDepthRegion)
+ mocStreamvalLatAndDepthRegion = mocStreamvalLatAndDepthRegionTotal * m3ps_to_Sv
+
+ deallocate(mocStreamvalLatAndDepthTotal)
+ deallocate(mocStreamvalLatAndDepthLocal)
+ deallocate(sumVertBinVelocity)
+
+ deallocate(mocStreamvalLatAndDepthRegionTotal)
+ deallocate(mocStreamvalLatAndDepthRegionLocal)
+ deallocate(sumVertBinVelocityRegion)
+
+ !!!! TRANSECT CELANUP
+ deallocate(sumTransport)
+ deallocate(totalSumTransport)
+
+ end subroutine ocn_compute_moc_streamfunction!}}}
+
+!***********************************************************************
+!
+! routine ocn_restart_moc_streamfunction
+!
+!> \brief Save restart for MPAS-Ocean analysis member
+!> \author Nils H. Feige
+!> \date 2016-04-08
+!> \details
+!> This routine conducts computation required to save a restart state
+!> for the MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_restart_moc_streamfunction(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ end subroutine ocn_restart_moc_streamfunction!}}}
+
+!***********************************************************************
+!
+! routine ocn_finalize_moc_streamfunction
+!
+!> \brief Finalize MPAS-Ocean analysis member
+!> \author Nils H. Feige
+!> \date 2016-04-08
+!> \details
+!> This routine conducts all finalizations required for this
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_finalize_moc_streamfunction(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ end subroutine ocn_finalize_moc_streamfunction!}}}
+
+end module ocn_moc_streamfunction
diff --git a/src/core_ocean/analysis_members/mpas_ocn_okubo_weiss.F b/src/core_ocean/analysis_members/mpas_ocn_okubo_weiss.F
index adf6a8b483..ad992bf717 100644
--- a/src/core_ocean/analysis_members/mpas_ocn_okubo_weiss.F
+++ b/src/core_ocean/analysis_members/mpas_ocn_okubo_weiss.F
@@ -657,7 +657,7 @@ subroutine ocn_compute_OW_component_IDs(dminfo, block, meshPool, processorId, nV
call mpas_timer_start("CC eddy stats")
call ocn_compute_eddy_stats(dminfo, block, nVertLevels, nCells, nCellsSolve, nLocalCCs, &
nEdgesOnCell, cellsOnCell, OW_cc_id, OW_thresh)
- call mpas_timer_stop("CC local")
+ call mpas_timer_stop("CC eddy stats")
end subroutine ocn_compute_OW_component_IDs!}}}
@@ -1041,7 +1041,7 @@ subroutine ocn_aggregate_eddy_stats(dmInfo, use_lat_lon_coords, min_cells, &!{{{
offset = 9 * maxCCsPerDomain * (dmInfo % my_proc_id)
- aggregated = -1.0e34
+ aggregated = -1.0e34_RKIND
do i = 1, numCCs
aggregated(9*(i-1) + 1 + offset) = origCCId(i)
aggregated(9*(i-1) + 2 + offset) = sumVol(i)
@@ -1129,12 +1129,12 @@ subroutine ocn_aggregate_eddy_stats(dmInfo, use_lat_lon_coords, min_cells, &!{{{
call mpas_timer_stop("sort/reduce")
! only output if IO node
+ call mpas_timer_start("output")
if (dminfo % my_proc_id == IO_NODE) then
! Output aggregated
- call mpas_timer_start("output")
call ocn_output_eddy_stats(listIdx, aggregated, use_lat_lon_coords,xtime)
- call mpas_timer_stop("output")
end if
+ call mpas_timer_stop("output")
end subroutine ocn_aggregate_eddy_stats!}}}
@@ -1233,12 +1233,17 @@ subroutine ocn_output_eddy_stats(numEddies, aggData, use_lat_lon_coords,xtime)!{
fileID = mpas_get_free_unit()
! Create output file.
- open(fileID, file=trim(config_AM_okuboWeiss_directory)//'/eddy_census_'//trim(xtime)//'.txt', STATUS='UNKNOWN', POSITION='rewind')
+ open(fileID, file=trim(config_AM_okuboWeiss_directory)//'/eddy_census_'//trim(xtime)//'.txt', STATUS='UNKNOWN', &
+ POSITION='rewind')
if (use_lat_lon_coords) then
- write (fileID, '(10A)') '"eddy ID", "number of cells", "volume sum, m^3", "average longitude, degrees", "average latitude, degrees", "average depth, m", "average zonal velocity, m/s", "average meridional velocity, m/s", "average vertical velocity, m/s"'
+ write (fileID, '(10A)') '"eddy ID", "number of cells", "volume sum, m^3", "average longitude, degrees", "average ' &
+ // 'latitude, degrees", "average depth, m", "average zonal velocity, m/s", "average ' &
+ // 'meridional velocity, m/s", "average vertical velocity, m/s"'
else
- write (fileID, '(10A)') '"eddy ID", "number of cells", "volume sum, m^3", "average x-position, m", "average y-position, m", "average depth, m", "average x-velocity, m/s", "average y-velocity, m/s", "average z-velocity, m/s"'
+ write (fileID, '(10A)') '"eddy ID", "number of cells", "volume sum, m^3", "average x-position, m", "average ' &
+ // 'y-position, m", "average depth, m", "average x-velocity, m/s", "average y-velocity, ' &
+ // 'm/s", "average z-velocity, m/s"'
end if
! Output number of eddies and statistics for each eddy
@@ -1247,8 +1252,10 @@ subroutine ocn_output_eddy_stats(numEddies, aggData, use_lat_lon_coords,xtime)!{
v = aggData(9*(i-1)+2)
write (fileID, '(I10, A)', advance='no') int(aggData(9*(i-1)+9)), ', '
write (fileID, '(ES12.5, A)', advance='no') v, ', '
- write (fileID, '(ES12.5, A, ES12.5, A, ES12.5, A)', advance='no') aggData(9*(i-1)+3)/v, ', ', aggData(9*(i-1)+4)/v, ', ', aggData(9*(i-1)+5)/v, ', '
- write (fileID, '(ES12.5, A, ES12.5, A, ES12.5)') aggData(9*(i-1)+6)/v, ', ', aggData(9*(i-1)+7)/v, ', ', aggData(9*(i-1)+8)/v
+ write (fileID, '(ES12.5, A, ES12.5, A, ES12.5, A)', advance='no') aggData(9*(i-1)+3)/v, ', ', aggData(9*(i-1)+4)/v, &
+ ', ', aggData(9*(i-1)+5)/v, ', '
+ write (fileID, '(ES12.5, A, ES12.5, A, ES12.5)') aggData(9*(i-1)+6)/v, ', ', aggData(9*(i-1)+7)/v, ', ', &
+ aggData(9*(i-1)+8)/v
end do
close(fileID)
@@ -1380,9 +1387,9 @@ subroutine mpas_velocity_gradient_R3Cell(normalVelocity, tangentialVelocity, &!{
enddo
enddo
- velocityGradient = 0.0
+ velocityGradient = 0.0_RKIND
do iCell = 1, nCellsCompute
- invAreaCell = 1.0 / areaCell(iCell)
+ invAreaCell = 1.0_RKIND / areaCell(iCell)
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
do k = 1, maxLevelCell(iCell)
diff --git a/src/core_ocean/analysis_members/mpas_ocn_particle_list.F b/src/core_ocean/analysis_members/mpas_ocn_particle_list.F
new file mode 100644
index 0000000000..6c878cda01
--- /dev/null
+++ b/src/core_ocean/analysis_members/mpas_ocn_particle_list.F
@@ -0,0 +1,4137 @@
+! Copyright (c) 2014, 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_particle_list
+!
+!> \brief Particle framework
+!> \author Phillip Wolfram
+!> \date 04/10/2014
+!> \details
+!> This module contains a general definition of particles which can be
+!> used in implementation of Lagrangian Particles Tracking.
+!-----------------------------------------------------------------------
+#define COMMA ,
+#define LIGHT_DEBUG_WRITE(M) ! write(stderrUnit,*) M
+#define LIGHT_DEBUG_ALL_WRITE(M) ! write(stderrUnit,*) M
+#define LIGHT_WARNING_WRITE(M) write(stderrUnit,*) 'WARNING: '//M
+#define LIGHT_ERROR_WRITE(M) write(stderrUnit,*) 'ERROR: '//M
+
+module ocn_particle_list
+
+ ! declare general packages used
+#ifdef _MPI
+ use mpi
+#endif
+ use mpas_kind_types
+ use mpas_io_units
+ use mpas_derived_types
+ use mpas_dmpar
+ use mpas_block_decomp
+ use mpas_pool_routines
+
+ ! blanket statments to restrict implicit module's scope
+ implicit none
+ private
+
+ ! mpi defines
+#ifdef _MPI
+ integer, parameter :: MPI_INTEGERKIND = MPI_INTEGER
+ integer, parameter :: MPI_2INTEGERKIND = MPI_2INTEGER
+
+#ifdef SINGLE_PRECISION
+ integer, parameter :: MPI_REALKIND = MPI_REAL
+ integer, parameter :: MPI_2REALKIND = MPI_2REAL
+#else
+ integer, parameter :: MPI_REALKIND = MPI_DOUBLE_PRECISION
+ integer, parameter :: MPI_2REALKIND = MPI_2DOUBLE_PRECISION
+#endif
+#endif
+
+ ! custom structures defined in mpas_grid_types
+
+ ! define private interfaces
+
+ ! add routines
+ interface add_halo_data_to_particle_list
+ !(particlelist, dataName, data)
+ module procedure add_halo_data_to_particle_list_1Dreal
+ module procedure add_halo_data_to_particle_list_1Dint
+ end interface
+
+ interface add_halo_data_to_particle_list_array
+ module procedure add_halo_data_to_particle_list_1Dreal_array
+ module procedure add_halo_data_to_particle_list_1Dint_array
+ end interface
+
+ interface add_nonhalo_data_to_particle_list
+ !(particlelist, dataName, data)
+ module procedure add_nonhalo_data_to_particle_list_1Dreal
+ module procedure add_nonhalo_data_to_particle_list_1Dint
+ end interface
+
+ interface add_nonhalo_data_to_particle_list_array
+ module procedure add_nonhalo_data_to_particle_list_1Dreal_array
+ module procedure add_nonhalo_data_to_particle_list_1Dint_array
+ end interface
+
+ ! get routines
+ interface get_halo_data_from_particle_list
+ !(particlelist, dataName, data)
+ module procedure get_halo_data_from_particle_list_1Dreal
+ module procedure get_halo_data_from_particle_list_1Dint
+ end interface
+
+ interface get_halo_data_from_particle_list_array
+ module procedure get_halo_data_from_particle_list_1Dreal_array
+ module procedure get_halo_data_from_particle_list_1Dint_array
+ end interface
+
+ interface get_nonhalo_data_from_particle_list
+ !(particlelist, dataName, data)
+ module procedure get_nonhalo_data_from_particle_list_1Dreal
+ module procedure get_nonhalo_data_from_particle_list_1Dint
+ end interface
+
+ interface get_nonhalo_data_from_particle_list_array
+ !(particlelist, dataName, data)
+ module procedure get_nonhalo_data_from_particle_list_1Dreal_array
+ module procedure get_nonhalo_data_from_particle_list_1Dint_array
+ end interface
+
+ !-----------------------------------------------------------------
+ ! public routines and interfaces
+ !-----------------------------------------------------------------
+ ! define publically accessible subroutines, functions, interfaces
+ public :: mpas_particle_list_build_and_assign_particle_list
+ public :: mpas_particle_list_destroy_particle_list, mpas_particle_list_remove_particles_not_on_current_block
+ public :: mpas_particle_list_build_computation_halos, mpas_particle_list_build_halos
+ public :: mpas_particle_list_update_particle_block
+ public :: mpas_particle_list_update_halos_start, mpas_particle_list_update_halos_end
+ public :: mpas_particle_list_transfer_particles_from_block_to_named_block
+ public :: mpas_particle_list_write_halo_data, mpas_particle_list_write_nonhalo_data
+ public :: mpas_particle_list_test_neighscalc, mpas_particle_list_test_numparticles_to_neighprocs
+ public :: mpas_particle_list_test_num_current_particlelist
+ public :: mpas_particle_list_self_union_halo_lists
+
+ ! subroutine / function definition
+contains
+
+!***********************************************************************
+!
+! routine mpas_particle_list_build_and_assign_particle_list
+!
+!> \brief Allocates particles for initialization
+!> \author Phillip Wolfram
+!> \date 07/01/2014
+!> \details
+!> This routine builds and allocates particlces following initalization
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_particle_list_build_and_assign_particle_list(domain,err) !{{{
+ implicit none
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ err = 0
+ ! build / allocate the listPLSend, setting ioProc (currentBlock read in as haloData)
+ call build_block_particlelists(domain, err)
+
+
+ ! read in data from netCDF-injected data structures
+ ! nonhalo-data is diagnostic
+ call read_haloData(domain, err)
+
+ ! note that nonhalo data is just initialized with 0
+ ! values are not imported from netCDF input file
+ call read_nonhaloData(domain, err)
+
+#ifdef MPAS_DEBUG
+ call mpas_particle_list_test_num_current_particlelist(domain)
+#endif
+ !! test to make sure deallocation is ok before transfer...!{{{
+#ifdef MPAS_DEBUG
+ LIGHT_DEBUG_ALL_WRITE(' Trying to clear particlelist memory on blocks')
+ call clear_block_particlelists(domain,err)
+ call build_block_particlelists(domain, err)
+ call read_haloData(domain, err)
+ call read_nonhaloData(domain, err)
+ call mpas_particle_list_test_num_current_particlelist(domain)
+ call test_currentBlock(domain)
+ LIGHT_DEBUG_ALL_WRITE(' Rebuilt data structures-- ok')
+#endif
+ !}}}
+ end subroutine mpas_particle_list_build_and_assign_particle_list !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_particle_list_destroy_particle_list
+!
+!> \brief MPAS destroy particlelist
+!> \author Phillip Wolfram
+!> \date 06/27/2014
+!> \details
+!> This routine destroys a particlelist, deallocating its memory
+!> including that of all pointers it contains
+!
+!-----------------------------------------------------------------------
+subroutine mpas_particle_list_destroy_particle_list(particlelist) !{{{
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ type (mpas_particle_list_type), pointer :: pLCurr, pLCurrTemp
+
+ if(associated(particlelist)) then
+ plCurr => particlelist
+ do while(associated(plCurr))
+ pLCurrTemp => pLCurr
+ pLCurr => pLCurr % next
+ ! destroy the particle too
+ if(associated(pLCurrTemp % particle)) then
+ call destroy_particle(pLCurrTemp % particle)
+ end if
+ deallocate(pLCurrTemp)
+ end do
+ end if
+
+end subroutine mpas_particle_list_destroy_particle_list !}}}
+
+!***********************************************************************
+!
+! routine mpas_particle_list_remove_particles_not_on_current_block
+!
+!> \brief Remove particles on block % particlelist that are not on currentBlock
+!> \author Phillip Wolfram
+!> \date 07/03/2014
+!> \details
+!> This routine removes particles that were transfered strictly for IO.
+!> If the particle's currentBlock is not the same as the current block,
+!> the particle is removed.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_particle_list_remove_particles_not_on_current_block(domain, err) !{{{
+ implicit none
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+ type (block_type), pointer :: block
+ type (mpas_particle_list_type), pointer :: particlelist, particlelisttemp, particlelisttemp2
+ integer :: thisBlock
+ integer, pointer :: particleBlock
+ integer :: arrayIndex
+ !type (mpas_pool_type), pointer :: lagrPartTrackPool
+ type (mpas_particle_type), pointer :: particle
+
+ err = 0
+
+ block => domain % blocklist
+ do while(associated(block))
+ ! for each particle on each block
+ particlelist => block % particlelist
+ do while(associated(particlelist))
+ particle => particlelist % particle
+ call mpas_pool_get_array(particle % haloDataPool, 'currentBlock', particleBlock)
+
+ if(particleBlock /= block % blockID) then
+ ! REMOVE PARTICLE FROM EXISTING PARTICLELIST
+ ! remove particle and particle reference from existing particle list
+ ! 3 cases: head, middle, tail
+
+ call destroy_particle(particle)
+
+ if(associated(particlelist % prev)) then
+ particlelisttemp => particlelist % prev
+ if (associated(particlelist % next)) then
+ ! case of the middle
+ particlelisttemp % next => particlelist % next
+ particlelisttemp2 => particlelisttemp
+ ! want to keep particle memory intact because their pointers were passed previously,
+ ! so just empty the list, don't destroy it and its contents
+ particlelisttemp => particlelist % next
+ particlelisttemp % prev => particlelisttemp2
+ ! just need to remove the single link, particle memory needs to stay intact
+ !deallocate(particlelist % particle)
+ deallocate(particlelist)
+ ! get next pointer
+ particlelist => particlelisttemp
+ else
+ ! case of tail
+ nullify(particlelisttemp % next)
+ !deallocate(particlelist % particle)
+ deallocate(particlelist)
+ ! set back to final
+ end if
+ else
+ if(associated(particlelist % next)) then
+ ! case of head, set new head (assumes more than one particle)
+ particlelisttemp => particlelist % next
+ nullify(particlelisttemp % prev)
+ block % particlelist => particlelisttemp
+ !deallocate(particlelist % particle)
+ deallocate(particlelist)
+ particlelist => particlelisttemp
+ else
+ ! case of single link / particle
+ !deallocate(particlelist % particle)
+ deallocate(particlelist)
+ nullify(block % particlelist)
+ end if
+ end if
+ else
+ particlelist => particlelist % next
+ end if
+ end do
+
+ ! this is done for each block because we want processor - processor communication
+ block => block % next
+ end do
+
+ end subroutine mpas_particle_list_remove_particles_not_on_current_block !}}}
+
+!***********************************************************************
+!
+! routine mpas_particle_list_build_computation_halos
+!
+!> \brief Build up necessary info for communication of particle in
+!> halo to neighboring cell during computation step.
+!> \author Phillip Wolfram
+!> \date 07/02/2014
+!> \details
+!> This routine builds g_compProcNeighs which is the neighboring processor
+!> list needed to process MPI communication, assuming a list of
+!> particlelists is built up corresponding to the processors in this
+!> array. The end result is that g_compProcNeighs is populated.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_particle_list_build_computation_halos(domain, err, procNeighs) !{{{
+ implicit none
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+ integer, dimension(:), pointer :: procNeighs
+
+ err = 0
+
+ ! compute the cellOwnerBlock for cells
+ ! owning processor can be obtained from
+ ! mpas_get_owning_proc in mpas_block_decomp (src/framework)
+ call compute_cellOwnerBlock(domain, err)
+
+ ! in order to mediate MPI exchanges, need to determine
+ ! 1. list of blockNeighs (global)
+ ! stored in block % blockNeighs
+ ! basically Neighs are processors who own the halo including itself
+ call compute_blockNeighs(domain, err)
+
+ ! 2. list of procNeighs (extracted from blockNeighs, also global)
+ ! this information is necessary in order to know where to send data
+ ! (this is like a block exchange list for particles)
+ ! stored in block % procNeighs
+ ! this is just the list of processors who own blockNeighs
+ call compute_block_procNeighs(domain, err)
+
+ ! need to aggregate procNeighs to be global for the processor (over each block on the
+ ! processor), total number of neighboring processors to a particular processor
+ call compute_procNeighs(domain, err, procNeighs)
+
+ end subroutine mpas_particle_list_build_computation_halos !}}}
+
+!***********************************************************************
+!
+! routine mpas_particle_list_build_halos
+!
+!> \brief Build the IO halo information to transmit particles from their
+!> initial host IO processor to the appropriate currentBlock
+!> processor.
+!> \author Phillip Wolfram
+!> \date 07/02/2014
+!> \details
+!> This routine builds the IO halo information to transmit particles
+!> from their initial host IO processor to the appropriate currentBlock
+!> processor. The end result is that g_ioProcNeighs is populated.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_particle_list_build_halos(domain, err, namedBlock, ioProcNeighs) !{{{
+ !{{{ initialization
+ implicit none
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+ character(len=*), intent(in) :: namedBlock
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, dimension(:), pointer, intent(out) :: ioProcNeighs
+ integer, intent(out) :: err !< Output: error flag
+
+ !}}}
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+ integer, dimension(:), pointer :: currentBlocks, tempInt
+ integer :: i, nBlocks, nTotProcs, mpi_ierr
+ logical, dimension(:), pointer :: sendNeigh, recvNeigh
+
+ err = 0
+
+ ! get unique list of currentBlock to determine all currentProcs
+ ! that the particles must be communicated to
+ ! determine complete set of ioProcs, which are assigned based on the
+ ! way that PIO decomposes the nParticle dimension.
+ ! at this point, processors owning the particle (at read-in) are
+ ! assumed to be the ioProcessor
+ call compute_all_particle_values_unique_int(domain, err, namedBlock, currentBlocks)
+
+ nTotProcs = domain % dminfo % nprocs
+ allocate(sendNeigh(nTotProcs))
+ allocate(recvNeigh(nTotProcs))
+ sendNeigh = .false.
+ recvNeigh = .false.
+
+ ! Get processors for currentBlocks. Note, however, this is one-sided because
+ ! only the IO processors know their send location, the receivers don't know
+ ! their sending processors
+ if(associated(currentBlocks)) then
+ nBlocks = size(currentBlocks)
+ !write(stderrUnit,*) 'nBlocks = ', nBlocks, ' currentBlocks = ', currentBlocks
+ allocate(ioProcNeighs(nBlocks))
+ do i=1, nBlocks
+ call mpas_get_owning_proc(domain % dminfo, currentBlocks(i), ioProcNeighs(i))
+ end do
+
+ ! note, each ioProc knows where it is sending data. However, those processors
+ ! do not know they should receive data (their halos are empty). The halos
+ ! are not symmetric and the communication cannot occur unless this is fixed.
+ ! this is fixed via an all-to-all communication (only at initialization, otherwise
+ ! parallelism can be broken)
+ ! set counter for connectivity
+ do i=1,size(ioProcNeighs)
+ sendNeigh(ioProcNeighs(i)+1) = .true.
+ end do
+ deallocate(ioProcNeighs)
+ end if
+
+ LIGHT_DEBUG_WRITE('sendNeigh = ' COMMA sendNeigh)
+ LIGHT_DEBUG_WRITE('recvNeigh= ' COMMA recvNeigh)
+#ifdef _MPI
+ !call MPI_Barrier(domain % dminfo % comm, mpi_ierr)
+#endif
+ ! send with MPI all to update in recvNeigh (should only have to be done once)
+#ifdef _MPI
+ call MPI_Alltoall(sendNeigh, 1, MPI_LOGICAL, recvNeigh, 1, MPI_LOGICAL, domain % dminfo % comm, mpi_ierr)
+#endif
+#ifdef _MPI
+ !call MPI_Barrier(domain % dminfo % comm, err)
+#endif
+ LIGHT_DEBUG_WRITE('Finished all to all with mpi_ierr = ' COMMA mpi_ierr)
+ LIGHT_DEBUG_WRITE('sendNeigh = ' COMMA sendNeigh)
+ LIGHT_DEBUG_WRITE('recvNeigh= ' COMMA recvNeigh)
+ LIGHT_DEBUG_WRITE('communicate = ' COMMA sendNeigh .or. recvNeigh)
+
+ ! could possibly optimize here by keeping track of send / recv lists separately
+ ! however, if there is nothing to be sent the only message that is sent
+ ! is the number of particles to be transferred...
+ ! update ioProcNeighs from logical lists
+ ! "add" the lists
+ recvNeigh = recvNeigh .or. sendNeigh
+ allocate(tempInt(nTotProcs))
+ ! this can artificially create a problem if there isn't a single block to a processor
+ tempInt = domain % dminfo % my_proc_id
+ do i=1,nTotProcs
+ if (recvNeigh(i)) tempInt(i) = i-1
+ end do
+ deallocate(sendNeigh)
+ deallocate(recvNeigh)
+
+ ! get a complete list of the processors (including itself)
+ call uniqueIntegerList(tempInt,ioProcNeighs)
+ call removeValueFromIntList(ioProcNeighs, domain % dminfo % my_proc_id)
+ LIGHT_DEBUG_WRITE('ioProcNeighs = ' COMMA ioProcNeighs)
+ deallocate(tempInt)
+
+ end subroutine mpas_particle_list_build_halos !}}}
+
+!***********************************************************************
+!
+! routine mpas_particle_list_update_halos_end
+!
+!> \brief Updates halo processors for communication, noting that
+!> the receiving processors must be informed of changes
+!> \author Phillip Wolfram
+!> \date 07/08/2014
+!> \details
+!> This routine transmits a logical list of processors that will
+!> transmit data for each compProc or ioProc. On the compProcs or
+!> ioProcs, these lists must be aggregated to build out the full list
+!> of processors from which data will be received.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_particle_list_update_halos_end(domain, err, destinationName, sendProcNeighs, sendProcSendList, & !{{{
+ sendProcRecvList)
+ implicit none
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ logical, dimension(:,:), intent(in) :: sendProcRecvList !< x: sendProcNeighs for send. y: each receiving
+ !< processors on x denoted by true
+ ! 'ioBlock' and 'currentBlock' are options for destinationName
+ character(len=*), intent(in) :: destinationName
+ logical, dimension(:), pointer, intent(inout) :: sendProcSendList !< location of true indicates processors to send data to
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, dimension(:), pointer, intent(inout) :: sendProcNeighs !< list of io halo processors
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: i, nsendProcNeighs, nProcs
+ logical, dimension(:), pointer :: completeList
+ logical, dimension(:,:), pointer :: recvList
+ integer, dimension(:), pointer :: intArray
+ integer, dimension(:), pointer :: sendRequestID, recvRequestID
+ integer :: mpi_ierr
+ logical :: firstTime
+
+ err = 0
+
+ ! compute send list now that all particles reside on correct block (processor) 'currentBlock'
+ ! didn't show up with serial IO because all computational processors sent data to proc 0
+ ! note that this could be missing communication where before transfer particle on proc A
+ ! has sendProc of A and is sent to B (must have previously kept a record that B is in A's halo list
+ ! note, may be slightly redundant because we could update sendProcSendList once particles are transfered
+ call compute_additional_particle_send_list(domain, destinationName, sendProcSendList)
+
+ ! need to update IO processors as to the change also so that they know where to get data from!!!
+ LIGHT_DEBUG_WRITE('destinationName= ' COMMA destinationName)
+ LIGHT_DEBUG_WRITE('sendProcSendList = ' COMMA sendProcSendList)
+ LIGHT_DEBUG_WRITE('sendProcRecvList = ' COMMA sendProcRecvList)
+ LIGHT_DEBUG_WRITE('sendProcNeighs before = ' COMMA sendProcNeighs)
+
+ ! proceed to update the halo
+ nProcs = domain % dminfo % nprocs
+ nsendProcNeighs = size(sendProcNeighs)
+ allocate(completeList(nProcs), recvList(nProcs,nsendProcNeighs))
+ allocate(sendRequestID(nsendProcNeighs), recvRequestID(nsendProcNeighs))
+
+ completeList = .False.
+ recvList = .False.
+ ! for each sendProc, send logical array information
+ do i = 1, nsendProcNeighs
+#ifdef _MPI
+ call MPI_ISend(sendProcRecvList(:,i), nProcs, MPI_LOGICAL, sendProcNeighs(i), domain % dminfo % my_proc_id, &
+ domain % dminfo % comm, sendRequestID(i), mpi_ierr)
+#endif
+ LIGHT_DEBUG_WRITE('sendProcNeigh= ' COMMA sendProcNeighs(i))
+ LIGHT_DEBUG_WRITE('send data = ' COMMA sendProcRecvList(i,:))
+#ifdef _MPI
+ call MPI_IRecv(recvList(:,i), nProcs, MPI_LOGICAL, sendProcNeighs(i), sendProcNeighs(i), &
+ domain % dminfo % comm, recvRequestID(i), mpi_ierr)
+#endif
+ end do
+
+#ifdef _MPI
+ ! wait until the data is in the buffer
+ call MPI_WaitAll(nsendProcNeighs,recvRequestID, MPI_STATUSES_IGNORE, mpi_ierr)
+#endif
+
+ do i = 1, nsendProcNeighs
+ ! aggregate results after wait, making sure that we have the most
+ ! comprehensive list of sendProcs for receiving
+ LIGHT_DEBUG_WRITE('sendProcNeigh= ' COMMA sendProcNeighs(i))
+ LIGHT_DEBUG_WRITE('recvList before = ' COMMA recvList(:,i))
+ LIGHT_DEBUG_WRITE('completeList before = ' COMMA completeList)
+ completeList = completeList .or. recvList(:,i)
+ LIGHT_DEBUG_WRITE('recvList after = ' COMMA recvList(:,i))
+ LIGHT_DEBUG_WRITE('completeList after = ' COMMA completeList)
+ end do
+
+ ! wait to make sure (just in case) that all sends have completed
+#ifdef _MPI
+ call MPI_WaitAll(nsendProcNeighs, sendRequestID, MPI_STATUSES_IGNORE, mpi_ierr)
+#endif
+
+ ! "add" receiving and sending lists into a complete list
+ completeList = completeList .or. sendProcSendList
+ !write(stderrUnit,*) 'completeList = ', completeList
+
+ ! convert complete list into a unique list of processor numbers
+ allocate(intArray(nProcs))
+ firstTime = .True.
+ do i = 1, nProcs
+ if (completeList(i)) then
+ if (firstTime) then
+ intArray = i - 1
+ firstTime = .False.
+ else
+ intArray(i) = i - 1
+ end if
+ end if
+ end do
+
+ ! now get the desired integer halo list
+ deallocate(sendProcNeighs)
+ call uniqueIntegerList(intArray, sendProcNeighs)
+ call removeValueFromIntList(sendProcNeighs, domain % dminfo % my_proc_id)
+
+ deallocate(intArray, completeList, sendRequestID, recvRequestID)
+ ! need to update IO processors as to the change also so that they know where to get data from!!!
+ ! should uncomment for testing when multiple sendProcs are utilized (parallel IO)
+ LIGHT_DEBUG_WRITE('sendProcSendList after = ' COMMA sendProcSendList)
+ LIGHT_DEBUG_WRITE('sendProcRecvList after = ' COMMA sendProcRecvList)
+ LIGHT_DEBUG_WRITE('sendProcNeighs after = ' COMMA sendProcNeighs)
+
+ end subroutine mpas_particle_list_update_halos_end !}}}
+
+!***********************************************************************
+!
+! routine mpas_particle_list_transfer_particles_from_block_to_named_block
+!
+!> \brief Move particles to the appropriate currentBlock
+!> \author Phillip Wolfram
+!> \date 07/01/2014
+!> \details
+!> This routine uses MPI communication to ensure particles end up
+!> on their appropriate currentBlock.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_particle_list_transfer_particles_from_block_to_named_block(domain, err, & !{{{
+ haloOnly, copyOnly, namedBlock, procNeighs)
+ implicit none
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+ integer, dimension(:), pointer, intent(in) :: procNeighs
+ character(len=*), intent(in) :: namedBlock
+ logical, intent(in) :: copyOnly, haloOnly
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+ integer, dimension(:), pointer :: nPartSend => NULL(), nPartRecv => NULL()
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: lagrPartTrackPool
+ type (mpas_list_of_particle_list_type), dimension(:), pointer :: listPLSend => NULL(), listPLRecv => NULL()
+
+ err = 0
+
+ ! allocate particle list in terms of its communication dimesion to other processors
+ allocate(listPLSend(size(procNeighs)),listPLRecv(size(procNeighs)))
+ allocate(nPartSend(size(procNeighs)),nPartRecv(size(procNeighs)))
+
+ ! if statement inside each of the group's subroutines needs removed for parallel IO which
+ ! assumes a high-level nParticle decomposition which will allocate IO blocks via the
+ ! decomposition
+
+
+ ! this is the communication list and it needs to be a bi-directional graph so that
+ ! sending processors have their receiving processor listening, even if there is no
+ ! data transfer required
+
+ ! presently don't distribute particles from each block to correct, owning blocks
+ !1. communicating from block to block (basically like make_proc_to_proc_particlelists but for blocks)
+ ! this is all done locally and all it will do is affect the particlelists on each block, forming temporary lists,
+ ! and then appending particles on these temporary lists back to block % particlelist
+ !this doesn't have to be tested unless there is more than one block per processor,
+ !which presently is not how things are done
+ ! this takes the block % particlelist on the first block and makes sure
+ ! it is appropriately distributed on other blocks on the same processor
+ ! call make_block_to_block_particlelists(domain)
+
+
+ ! 1. Make temporary particle lists for transfers based on currentBock of cells in halo.
+ ! These lists live on each block and correspond to other
+ ! blocks that the list must be moved to. The particle must end up on its currentBlock specified.
+ ! convention on particles lists is that g_compProcNeighs specifies the processor neighbor numbers
+ ! corresponding to each index in the particlelists pointer array. Should use linked-list
+ ! because processor neighbors are typically going to be somewhere less than 10
+ ! (perfect partitioning of plane gives hexagons with 6 cell neighbors, for instance).
+ ! strategy is to make linked list corresponding to each gProcNeigh and then append
+ ! particles beloning to the list on the list
+ LIGHT_DEBUG_WRITE('before make_proc_to_proc_particlelists')
+#ifdef MPAS_DEBUG
+ call mpas_particle_list_test_numparticles_to_neighprocs(domain % dminfo % my_proc_id, procNeighs, procNeighs)
+#endif
+ call make_proc_to_proc_particlelists(domain, copyOnly, namedBlock, listPLSend, procNeighs, err)
+ LIGHT_DEBUG_WRITE('after make_proc_to_proc_particlelists')
+#ifdef MPAS_DEBUG
+ call mpas_particle_list_test_numparticles_to_neighprocs(domain % dminfo % my_proc_id, procNeighs, procNeighs)
+#endif
+ LIGHT_DEBUG_WRITE('finished make_proc_to_proc_particlelists')
+#ifdef MPAS_DEBUG
+ call mpas_particle_list_test_num_current_particlelist(domain)
+ call test_num_particles_on_particlelist(listPLSend, size(procNeighs))
+#endif
+
+ ! now move data from one proc to another, assuming that data is move to 1st block
+ ! on foreign processor
+ ! tell other processors how many particles are going to be communicated to them
+ call get_num_particlelists(listPLSend, size(procNeighs), nPartSend)
+ LIGHT_DEBUG_WRITE('finished get_num_particlelists')
+ LIGHT_DEBUG_WRITE('proc id=' COMMA domain % dminfo % my_proc_id COMMA ' comm=' COMMA domain % dminfo % comm)
+ call communicate_num_particles_send_recv(domain, procNeighs, nPartSend, nPartRecv)
+ LIGHT_DEBUG_WRITE('finished communicate_num_particles_send_recv')
+
+ !2. communicating from processor to processor
+ ! make appropriate list
+ call allocate_list_particlelists(nPartRecv, listPLRecv)
+
+ ! communicate data (assumes that each processor has knowledge about construction of the pool lagrPartTrackPoolHalo,
+ ! from the registry. If this changes, this will break this member... It also assumes the code is deterministic
+ ! and that pools are built and computed the exact same way on each processor.
+ call communicate_particle_halo_data(domain, procNeighs, nPartSend, nPartRecv, listPLSend, listPLRecv)
+ LIGHT_DEBUG_WRITE('finished communicate_particle_halo_data')
+
+ if(haloOnly) then
+ ! need to also allocate the nonHalo data somehow, it just needs initialized so that it can be "filled in" when
+ ! necessary for output
+ ! can utilize empty 0'd fields for the nonhalo data portion to initialize the field for all the processors
+ call allocate_list_nonHalo_data(domain, listPLRecv)
+ else
+ call communicate_particle_nonhalo_data(domain, procNeighs, nPartSend, nPartRecv, listPLSend, listPLRecv)
+ end if
+
+ ! now there should be the complete particles on listPLRecv. These, however, need moved to the blocks of the processor
+ ! for use in calculations
+ !3. communicating from block to block
+ call distribute_particlelist_to_blocks(domain, namedBlock, listPLRecv)
+
+ LIGHT_DEBUG_WRITE('finished distributing particlelist')
+ LIGHT_DEBUG_WRITE('halo procs = ' COMMA procNeighs)
+ LIGHT_DEBUG_WRITE('nSend = ' COMMA nPartSend COMMA ' nRecv = ' COMMA nPartRecv)
+
+ ! deallocate listPLSend and listPLRecv
+ if (copyOnly) then
+ ! just empty the list without destroying the particle data
+ !write(stderrUnit,*) 'just emptying the particlelist'
+ call empty_list_particlelists(listPLSend)
+ else
+ ! remove list of particles as well as particle data because it was just sent to the other processors
+ call destory_list_particlelists(listPLSend)
+ endif
+ ! just empty the list without destroying the particle data (because we need particles that were just transferred!)
+ call empty_list_particlelists(listPLRecv)
+
+ deallocate(nPartSend, nPartRecv)
+
+ LIGHT_DEBUG_WRITE('finished mpas_particle_list_test_num_current_particlelist')
+
+ end subroutine mpas_particle_list_transfer_particles_from_block_to_named_block !}}}
+
+!***********************************************************************
+!
+! routine mpas_particle_list_write_halo_data
+!
+!> \brief Writes haloData to struct arrays for output
+!> \author Phillip Wolfram
+!> \date 06/03/2014
+!> \details
+!> This routine writes haloData output for this MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_particle_list_write_halo_data(domain, err)!{{{
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input variables
+ !-----------------------------------------------------------------
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ type (block_type), pointer :: block
+ type (mpas_particle_list_type), pointer :: particlelist
+ type (mpas_pool_type), pointer :: lagrPartTrackPool
+ type (mpas_pool_iterator_type) :: dimItr
+ type (field1DReal), pointer :: field1DRealPointer
+ type (field1DInteger), pointer :: field1DIntPointer
+ real (kind=RKIND), dimension(:), pointer :: Array1DRealPointer => NULL()
+ integer, dimension(:), pointer :: Array1DIntPointer => NULL()
+ integer, dimension(:), pointer :: indexToParticleIDOriginal => NULL(), &
+ indexToParticleIDNew => NULL(), &
+ orderingVector => NULL()
+ character (len=StrKIND) :: message
+
+ err = 0
+
+ block => domain % blocklist
+ do while (associated(block))
+ ! particle related pointers
+ particlelist => block % particlelist
+ ! iterate over each member of the pool and make the relevant assignment
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackHalo', lagrPartTrackPool)
+ ! need to compute the ordering matrices
+ call mpas_pool_get_array(lagrPartTrackPool, 'indexToParticleID', indexToParticleIDOriginal)
+ call get_halo_data_from_particle_list_array(particlelist, 'indexToParticleID', indexToParticleIDNew)
+ ! note: orderingVector can be a subset of indexToParticleIDNew because this index can include compute as well
+ ! as IO particles however, it must be of the same size as indexToParticleIDOriginal
+ call compute_ordering_vector(indexToParticleIDOriginal, indexToParticleIDNew, orderingVector)
+ LIGHT_DEBUG_WRITE('write halo data')
+ LIGHT_DEBUG_WRITE('indexToParticleIDOriginal =' COMMA indexToParticleIDOriginal)
+ LIGHT_DEBUG_WRITE('indexToParticleIDNew =' COMMA indexToParticleIDNew)
+ LIGHT_DEBUG_WRITE('ordering vector=' COMMA orderingVector)
+
+ ! iterate over contents of pool and transfer
+ call mpas_pool_begin_iteration(lagrPartTrackPool)
+ do while(mpas_pool_get_next_member(lagrPartTrackPool, dimItr))
+ ! determine the type of data
+ if (dimItr % memberType == MPAS_POOL_FIELD) then
+ if (dimItr % dataType == MPAS_POOL_REAL) then
+ ! get data and place it in appropriate array
+ call mpas_pool_get_field(lagrPartTrackPool, dimItr % memberName, field1DRealPointer)
+ !{{{
+ LIGHT_DEBUG_WRITE('write halo data')
+ LIGHT_DEBUG_WRITE('member name =' COMMA trim(dimItr % memberName))
+ LIGHT_DEBUG_WRITE('particlelistSize= ' COMMA count_particlelist(particlelist))
+ LIGHT_DEBUG_WRITE('memory arraysize= ' COMMA size(field1DRealPointer % array))
+ LIGHT_DEBUG_WRITE(trim(dimItr % memberName) COMMA ' = ' COMMA field1DRealPointer % array)
+ !}}}
+ allocate(Array1DRealPointer(count_particlelist(particlelist)))
+ call get_halo_data_from_particle_list_array(particlelist, dimItr % memberName, Array1DRealPointer)
+ ! reorder
+ field1DRealPointer % array = Array1DRealPointer(orderingVector)
+ deallocate(Array1DRealPointer)
+ elseif (dimItr % dataType == MPAS_POOL_INTEGER) then
+ ! get data and place it in appropriate array
+ call mpas_pool_get_field(lagrPartTrackPool, dimItr % memberName, field1DIntPointer)
+ allocate(Array1DIntPointer(count_particlelist(particlelist)))
+ call get_halo_data_from_particle_list_array(particlelist, dimItr % memberName, Array1DIntPointer)
+ ! reorder
+ field1DIntPointer % array = Array1DIntPointer(orderingVector)
+ deallocate(Array1DIntPointer)
+ else
+ LIGHT_DEBUG_ALL_WRITE("Different field type than implemented in nonHalo write!")
+ end if
+ elseif (dimItr % memberType == MPAS_POOL_DIMENSION) then
+ ! ignore dimensions for now and have this code so they aren't printed as an error message
+ else
+ write(message, *) "Different type expected in registry for key ", trim(dimItr % memberName), &
+ " in nonHalo data for write-- don't know what to do!"
+ LIGHT_DEBUG_ALL_WRITE(message)
+ end if
+ end do
+
+ ! free memory for the next loop
+ deallocate(indexToParticleIDNew)
+ deallocate(orderingVector)
+
+ block => block % next
+ end do
+
+ end subroutine mpas_particle_list_write_halo_data!}}}
+
+!***********************************************************************
+!
+! routine mpas_particle_list_write_nonhalo_data
+!
+!> \brief Writes nonhaloData to struct arrays for output
+!> \author Phillip Wolfram
+!> \date 06/03/2014
+!> \details
+!> This routine writes nonhaloData output for this MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_particle_list_write_nonhalo_data(domain, err)!{{{
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input variables
+ !-----------------------------------------------------------------
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ type (block_type), pointer :: block
+ type (mpas_particle_list_type), pointer :: particlelist
+ type (mpas_pool_type), pointer :: lagrPartTrackPool
+ type (mpas_pool_iterator_type) :: dimItr
+ type (field1DReal), pointer :: field1DRealPointer
+ type (field1DInteger), pointer :: field1DIntPointer
+ real (kind=RKIND), dimension(:), pointer :: Array1DRealPointer => NULL()
+ integer, dimension(:), pointer :: Array1DIntPointer => NULL()
+ integer, dimension(:), pointer :: indexToParticleIDOriginal => NULL(), &
+ indexToParticleIDNew => NULL(), &
+ orderingVector =>NULL()
+ character (len=StrKIND) :: message
+
+ err = 0
+
+ block => domain % blocklist
+ do while (associated(block))
+ ! particle related pointers
+ particlelist => block % particlelist
+ ! iterate over each member of the pool and make the relevant assignment
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackHalo', lagrPartTrackPool)
+ ! need to compute the ordering matrices
+ call mpas_pool_get_array(lagrPartTrackPool, 'indexToParticleID', indexToParticleIDOriginal)
+ call get_halo_data_from_particle_list_array(particlelist, 'indexToParticleID', indexToParticleIDNew)
+ ! note: orderingVector can be a subset of indexToParticleIDNew because this index can include compute as well as
+ ! IO particles however, it must be of the same size as indexToParticleIDOriginal
+ call compute_ordering_vector(indexToParticleIDOriginal, indexToParticleIDNew, orderingVector)
+
+ ! iterate over each member of the pool and make the relevant assignment
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackNonHalo', lagrPartTrackPool)
+ call mpas_pool_begin_iteration(lagrPartTrackPool)
+ do while(mpas_pool_get_next_member(lagrPartTrackPool, dimItr))
+ ! determine the type of data
+ if (dimItr % memberType == MPAS_POOL_FIELD) then
+ if (dimItr % dataType == MPAS_POOL_REAL) then
+ ! get data and place it in appropriate array
+ call mpas_pool_get_field(lagrPartTrackPool, dimItr % memberName, field1DRealPointer)
+ !{{{
+ LIGHT_DEBUG_WRITE('write nonhalo data')
+ LIGHT_DEBUG_WRITE('member name =' COMMA dimItr % memberName)
+ LIGHT_DEBUG_WRITE('particlelistSize= ' COMMA count_particlelist(particlelist))
+ LIGHT_DEBUG_WRITE('memory arraysize= ' COMMA size(field1DRealPointer % array))
+ !}}}
+ allocate(Array1DRealPointer(count_particlelist(particlelist)))
+ call get_nonhalo_data_from_particle_list_array(particlelist, dimItr % memberName, Array1DRealPointer)
+ ! reorder
+ field1DRealPointer % array = Array1DRealPointer(orderingVector)
+ deallocate(Array1DRealPointer)
+ elseif (dimItr % dataType == MPAS_POOL_INTEGER) then
+ write(message, *) "Integer type in registry for key ", dimItr % memberName, &
+ " in nonHalo data for write, not yet tested!"
+ LIGHT_DEBUG_ALL_WRITE(message)
+ ! get data and place it in appropriate array
+ call mpas_pool_get_field(lagrPartTrackPool, dimItr % memberName, field1DIntPointer)
+ allocate(Array1DIntPointer(count_particlelist(particlelist)))
+ call get_nonhalo_data_from_particle_list_array(particlelist, dimItr % memberName, Array1DIntPointer)
+ ! reorder
+ field1DIntPointer % array = Array1DIntPointer(orderingVector)
+ deallocate(Array1DIntPointer)
+ else
+ LIGHT_DEBUG_ALL_WRITE("Different field type than implemented in nonHalo write!")
+ end if
+ elseif (dimItr % memberType == MPAS_POOL_DIMENSION) then
+ ! ignore dimensions for now and have this code so they aren't printed as an error message
+ else
+ write(message, *) "Different type expected in registry for key ", trim(dimItr % memberName), &
+ " in nonHalo data for write-- don't know what to do!"
+ LIGHT_DEBUG_ALL_WRITE(message)
+ end if
+ end do
+
+ ! free memory for the next loop
+ deallocate(indexToParticleIDNew)
+ deallocate(orderingVector)
+
+ block => block % next
+ end do
+
+ end subroutine mpas_particle_list_write_nonhalo_data!}}}
+
+!-----------------------------------------------------------------------
+!
+! PRIVATE SUBROUTINES
+!
+!-----------------------------------------------------------------------
+!{{{
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine append_particle_to_particlelist
+!
+!> \brief MPAS add particle to particlelist, starting new list if
+!> not allocated
+!> \author Phillip Wolfram
+!> \date 06/26/2014
+!> \details
+!> This routine takes a particle and places it on an existing particlelist,
+!> or in the event of no list, initializes the list with the particle
+!
+!-----------------------------------------------------------------------
+subroutine append_particle_to_particlelist(particle, particlelist)!{{{
+ implicit none
+ type (mpas_particle_type), pointer, intent(in) :: particle
+ type (mpas_particle_list_type), pointer, intent(inout) :: particlelist
+ type (mpas_particle_list_type), pointer :: headPL=>NULL(), tempPL=>NULL()
+
+ ! case where particeList needs to be created and populated by particle
+ if(.not.associated(particlelist)) then
+ allocate(particlelist)
+ nullify(particlelist % next)
+ nullify(particlelist % prev)
+ particlelist % particle => particle
+ else
+ ! case where list exists get the head
+ headPL => particlelist
+ if (.not.associated(headPL % particle)) then
+ ! populate empty link
+ headPL % particle => particle
+ else
+ ! build new link
+ allocate(tempPL)
+ tempPL % particle => particle
+ nullify(tempPL % prev)
+ tempPL % next => headPL
+ ! connect to the list
+ headPL % prev => tempPL
+ particlelist => tempPL
+ end if
+ end if
+
+end subroutine append_particle_to_particlelist !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_get_halodata_to_particlelist_1Dreal_array
+!
+!> \brief MPAS get halodata to particle contained in a list
+!> \author Phillip Wolfram
+!> \date 07/01/2014
+!> \details
+!> This routine reads 0D real arrays in each particle of the particlelist
+!> and places the data into a 1D real field output.
+!
+!-----------------------------------------------------------------------
+subroutine get_halo_data_from_particle_list_1Dreal_array & !{{{
+ (particlelist, dataName, array1DRealPointer)
+ ! input data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ character(len=*), intent(in) :: dataName
+ real (kind=RKIND), dimension(:), pointer, intent(out) :: array1DRealPointer
+
+ ! subroutine data
+ integer :: dataNumber
+ type (mpas_particle_list_type), pointer :: particlelistCurr
+ type (field0DReal), pointer :: field0DRealPointer
+
+ ! allocate the array if it isn't allocated
+ if(.not.associated(array1DRealPointer)) then
+ allocate(array1DRealPointer(count_particlelist(particlelist)))
+ end if
+
+ ! loop over all elements of the list and insert the data
+ dataNumber = 1
+ particlelistCurr => particlelist
+ ! while we have a real link
+ do while(associated(particlelistCurr))
+
+ call mpas_pool_get_field(particlelistCurr % particle % haloDataPool, dataName, field0DRealPointer)
+ array1DRealPointer(dataNumber) = field0DRealPointer % scalar
+
+ ! increment for new dataNumber
+ dataNumber = dataNumber + 1
+ ! get next link
+ particlelistCurr => particlelistCurr % next
+ end do
+
+end subroutine get_halo_data_from_particle_list_1Dreal_array !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_get_halodata_to_particlelist_1Dreal
+!
+!> \brief MPAS get halodata to particle contained in a list
+!> \author Phillip Wolfram
+!> \date 06/03/2014
+!> \details
+!> This routine reads 0D real arrays in each particle of the particlelist
+!> and places the data into a 1D real field output.
+!
+!-----------------------------------------------------------------------
+subroutine get_halo_data_from_particle_list_1Dreal & !{{{
+ (particlelist, dataName, field1DRealPointer)
+ ! input data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ character(len=*), intent(in) :: dataName
+ type (field1DReal), pointer, intent(out) :: field1DRealPointer
+
+ ! subroutine data
+ integer :: dataNumber
+ type (mpas_particle_list_type), pointer :: particlelistCurr
+ type (field0DReal), pointer :: field0DRealPointer
+
+ ! loop over all elements of the list and insert the data
+ dataNumber = 1
+ particlelistCurr => particlelist
+ ! while we have a real link
+ do while(associated(particlelistCurr))
+
+ call mpas_pool_get_field(particlelistCurr % particle % haloDataPool, dataName, field0DRealPointer)
+ field1DRealPointer % array(dataNumber) = field0DRealPointer % scalar
+
+ ! increment for new dataNumber
+ dataNumber = dataNumber + 1
+ ! get next link
+ particlelistCurr => particlelistCurr % next
+ end do
+
+end subroutine get_halo_data_from_particle_list_1Dreal !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_get_nonhalodata_to_particlelist_1Dint
+!
+!> \brief MPAS get nonhalodata to particle contained in a list
+!> \author Phillip Wolfram
+!> \date 07/07/2014
+!> \details
+!
+!-----------------------------------------------------------------------
+subroutine get_nonhalo_data_from_particle_list_1Dint& !{{{
+ (particlelist, dataName, field1DIntPointer)
+ ! input data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ character(len=*), intent(in) :: dataName
+ type (field1DInteger), pointer, intent(out) :: field1DIntPointer
+
+ ! subroutine data
+ integer :: dataNumber
+ type (mpas_particle_list_type), pointer :: particlelistCurr
+ type (field0DInteger), pointer :: field0DIntPointer
+
+ ! loop over all elements of the list and insert the data
+ dataNumber = 1
+ particlelistCurr => particlelist
+ ! while we have a real link
+ do while(associated(particlelistCurr))
+ call mpas_pool_get_field(particlelistCurr % particle % nonhaloDataPool, dataName, field0DIntPointer)
+ field1DIntPointer % array(dataNumber) = field0DIntPointer % scalar
+
+ ! increment for new dataNumber
+ dataNumber = dataNumber + 1
+ ! get next link
+ particlelistCurr => particlelistCurr % next
+ end do
+
+end subroutine get_nonhalo_data_from_particle_list_1Dint !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_get_nonhalodata_to_particlelist_1Dint_array
+!
+!> \brief MPAS get nonhalodata to particle contained in a list
+!> \author Phillip Wolfram
+!> \date 07/07/2014
+!> \details
+!
+!-----------------------------------------------------------------------
+subroutine get_nonhalo_data_from_particle_list_1Dint_array & !{{{
+ (particlelist, dataName, array1DIntPointer)
+ ! input data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ character(len=*), intent(in) :: dataName
+ integer, dimension(:), pointer, intent(out) :: array1DIntPointer
+
+ ! subroutine data
+ integer :: dataNumber
+ type (mpas_particle_list_type), pointer :: particlelistCurr
+ type (field0DInteger), pointer :: field0DIntPointer
+
+ ! allocate the array if it isn't allocated
+ if(.not.associated(array1DIntPointer)) then
+ allocate(array1DIntPointer(count_particlelist(particlelist)))
+ end if
+
+ ! loop over all elements of the list and insert the data
+ dataNumber = 1
+ particlelistCurr => particlelist
+ ! while we have a real link
+ do while(associated(particlelistCurr))
+ call mpas_pool_get_field(particlelistCurr % particle % nonhaloDataPool, dataName, field0DIntPointer)
+ array1DIntPointer(dataNumber) = field0DIntPointer % scalar
+
+ ! increment for new dataNumber
+ dataNumber = dataNumber + 1
+ ! get next link
+ particlelistCurr => particlelistCurr % next
+ end do
+
+end subroutine get_nonhalo_data_from_particle_list_1Dint_array !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_get_nonhalodata_to_particlelist_1Dreal
+!
+!> \brief MPAS get nonhalodata to particle contained in a list
+!> \author Phillip Wolfram
+!> \date 06/04/2014
+!> \details
+!
+!-----------------------------------------------------------------------
+subroutine get_nonhalo_data_from_particle_list_1Dreal & !{{{
+ (particlelist, dataName, field1DRealPointer)
+ ! input data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ character(len=*), intent(in) :: dataName
+ type (field1DReal), pointer, intent(out) :: field1DRealPointer
+
+ ! subroutine data
+ integer :: dataNumber
+ type (mpas_particle_list_type), pointer :: particlelistCurr
+ type (field0DReal), pointer :: field0DRealPointer
+
+ ! loop over all elements of the list and insert the data
+ dataNumber = 1
+ particlelistCurr => particlelist
+ ! while we have a real link
+ do while(associated(particlelistCurr))
+ call mpas_pool_get_field(particlelistCurr % particle % nonhaloDataPool, dataName, field0DRealPointer)
+ field1DRealPointer % array(dataNumber) = field0DRealPointer % scalar
+
+ ! increment for new dataNumber
+ dataNumber = dataNumber + 1
+ ! get next link
+ particlelistCurr => particlelistCurr % next
+ end do
+
+end subroutine get_nonhalo_data_from_particle_list_1Dreal !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_get_nonhalodata_to_particlelist_1Dreal_array
+!
+!> \brief MPAS get nonhalodata to particle contained in a list
+!> \author Phillip Wolfram
+!> \date 07/07/2014
+!> \details
+!
+!-----------------------------------------------------------------------
+subroutine get_nonhalo_data_from_particle_list_1Dreal_array & !{{{
+ (particlelist, dataName, array1DRealPointer)
+ ! input data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ character(len=*), intent(in) :: dataName
+ real (kind=RKIND), dimension(:), pointer, intent(out) :: array1DRealPointer
+
+ ! subroutine data
+ integer :: dataNumber
+ type (mpas_particle_list_type), pointer :: particlelistCurr
+ type (field0DReal), pointer :: field0DRealPointer
+
+ ! allocate the array if it isn't allocated
+ if(.not.associated(array1DRealPointer)) then
+ allocate(array1DRealPointer(count_particlelist(particlelist)))
+ end if
+
+ ! loop over all elements of the list and insert the data
+ dataNumber = 1
+ particlelistCurr => particlelist
+ ! while we have a real link
+ do while(associated(particlelistCurr))
+ call mpas_pool_get_field(particlelistCurr % particle % nonhaloDataPool, dataName, field0DRealPointer)
+ array1DRealPointer(dataNumber) = field0DRealPointer % scalar
+
+ ! increment for new dataNumber
+ dataNumber = dataNumber + 1
+ ! get next link
+ particlelistCurr => particlelistCurr % next
+ end do
+
+end subroutine get_nonhalo_data_from_particle_list_1Dreal_array !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_get_nonhalodata_to_particlelist_2Dreal
+!
+!> \brief MPAS get nonhalodata to particle contained in a list
+!> \author Phillip Wolfram
+!> \date 04/10/2014
+!> \details
+!> This routine takes a an array of 1D real arrays and places the data into
+!> the nonhaloData pool of the particles in the list. It is assumed
+!> that the dimensionality of the field is reduced in order by one
+!> on each particle.
+!
+!-----------------------------------------------------------------------
+subroutine get_nonhalo_data_from_particle_list_2Dreal & !{{{
+ (particlelist, dataName, field2DRealPointer)
+ ! input data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ character(len=*), intent(in) :: dataName
+ type (field2DReal), pointer, intent(out) :: field2DRealPointer
+
+ ! subroutine data
+ integer :: dataNumber
+ type (mpas_particle_list_type), pointer :: particlelistCurr
+ type (field1DReal), pointer :: field1DRealPointer
+
+ ! loop over all elements of the list and insert the data
+ dataNumber = 1
+ particlelistCurr => particlelist
+ ! while we have a real link
+ do while(associated(particlelistCurr))
+ call mpas_pool_get_field(particlelistCurr % particle % nonhaloDataPool, dataName, field1DRealPointer)
+ field2DRealPointer % array(dataNumber, :) = field1DRealPointer % array(:)
+
+ ! increment for new dataNumber
+ dataNumber = dataNumber + 1
+ ! get next link
+ particlelistCurr => particlelistCurr % next
+ end do
+
+end subroutine get_nonhalo_data_from_particle_list_2Dreal !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_get_halodata_to_particlelist_1Dint_array
+!
+!> \brief MPAS get halodata to particle contained in a list
+!> \author Phillip Wolfram
+!> \date 04/10/2014
+!> \details
+!> This routine takes a an array of 1D int arrays and places the data into
+!> the haloData pool of the particles in the list. It is assumed
+!> that the dimensionality of the field is reduced in order by one
+!> on each particle.
+!
+!-----------------------------------------------------------------------
+subroutine get_halo_data_from_particle_list_1Dint_array & !{{{
+ (particlelist, dataName, array1DIntPointer)
+ ! input data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ character(len=*), intent(in) :: dataName
+ integer, dimension(:), pointer, intent(out) :: array1DIntPointer
+
+ ! subroutine data
+ integer :: dataNumber
+ type (mpas_particle_list_type), pointer :: particlelistCurr
+ type (field0DInteger), pointer :: field0DIntPointer
+
+ ! allocate the array if it isn't allocated
+ if(.not.associated(array1DIntPointer)) then
+ allocate(array1DIntPointer(count_particlelist(particlelist)))
+ end if
+
+ ! loop over all elements of the list and insert the data
+ dataNumber = 1
+ particlelistCurr => particlelist
+ ! while we have a int link
+ do while(associated(particlelistCurr))
+ call mpas_pool_get_field(particlelistCurr % particle % haloDataPool, dataName, field0DIntPointer)
+ array1DIntPointer(dataNumber) = field0DIntPointer % scalar
+
+ ! increment for new dataNumber
+ dataNumber = dataNumber + 1
+ ! get next link
+ particlelistCurr => particlelistCurr % next
+ end do
+
+end subroutine get_halo_data_from_particle_list_1Dint_array !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_get_halodata_to_particlelist_1Dint
+!
+!> \brief MPAS get halodata to particle contained in a list
+!> \author Phillip Wolfram
+!> \date 04/10/2014
+!> \details
+!> This routine takes a an array of 1D int arrays and places the data into
+!> the haloData pool of the particles in the list. It is assumed
+!> that the dimensionality of the field is reduced in order by one
+!> on each particle.
+!
+!-----------------------------------------------------------------------
+subroutine get_halo_data_from_particle_list_1Dint & !{{{
+ (particlelist, dataName, field1DIntPointer)
+ ! input data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ character(len=*), intent(in) :: dataName
+ type (field1DInteger), pointer, intent(out) :: field1DIntPointer
+
+ ! subroutine data
+ integer :: dataNumber
+ type (mpas_particle_list_type), pointer :: particlelistCurr
+ type (field0DInteger), pointer :: field0DIntPointer
+
+ ! loop over all elements of the list and insert the data
+ dataNumber = 1
+ particlelistCurr => particlelist
+ ! while we have a int link
+ do while(associated(particlelistCurr))
+ call mpas_pool_get_field(particlelistCurr % particle % haloDataPool, dataName, field0DIntPointer)
+ field1DIntPointer % array(dataNumber) = field0DIntPointer % scalar
+
+ ! increment for new dataNumber
+ dataNumber = dataNumber + 1
+ ! get next link
+ particlelistCurr => particlelistCurr % next
+ end do
+
+end subroutine get_halo_data_from_particle_list_1Dint !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_add_halodata_to_particlelist_1Dreal_array
+!
+!> \brief MPAS add halodata to particle contained in a list
+!> \author Phillip Wolfram
+!> \date 07/01/2014
+!> \details
+!> This routine takes a an array of real scalars and places the data into
+!> the haloData pool of the particles in the list. It is assumed
+!> that the dimensionality of the field is reduced in order by one
+!> on each particle.
+!
+!-----------------------------------------------------------------------
+subroutine add_halo_data_to_particle_list_1Dreal_array & !{{{
+ (particlelist, dataName, array1DRealPointer)
+ ! input data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ character(len=*), intent(in) :: dataName
+ real (kind=RKIND), dimension(:), pointer, intent(in) :: array1DRealPointer
+
+ ! subroutine data
+ integer :: dataNumber
+ type (mpas_particle_list_type), pointer :: particlelistCurr
+ type (field0DReal), pointer :: field0DRealPointer
+
+ ! loop over all elements of the list and insert the data
+ dataNumber = 1
+ particlelistCurr => particlelist
+ ! while we have a real link
+ do while(associated(particlelistCurr))
+
+ allocate(field0DRealPointer)
+ field0DRealPointer % scalar = array1DRealPointer(dataNumber)
+ call mpas_pool_add_field(particlelistCurr % particle % haloDataPool, dataName, field0DRealPointer)
+
+ ! increment for new dataNumber
+ dataNumber = dataNumber + 1
+ ! get next link
+ particlelistCurr => particlelistCurr % next
+ end do
+
+end subroutine add_halo_data_to_particle_list_1Dreal_array !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_add_halodata_to_particlelist_1Dreal
+!
+!> \brief MPAS add halodata to particle contained in a list
+!> \author Phillip Wolfram
+!> \date 06/03/2014
+!> \details
+!> This routine takes a an array of real scalars and places the data into
+!> the haloData pool of the particles in the list. It is assumed
+!> that the dimensionality of the field is reduced in order by one
+!> on each particle.
+!
+!-----------------------------------------------------------------------
+subroutine add_halo_data_to_particle_list_1Dreal & !{{{
+ (particlelist, dataName, field1DRealPointer)
+ ! input data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ character(len=*), intent(in) :: dataName
+ type (field1DReal), pointer, intent(in) :: field1DRealPointer
+
+ ! subroutine data
+ integer :: dataNumber
+ type (mpas_particle_list_type), pointer :: particlelistCurr
+ type (field0DReal), pointer :: field0DRealPointer
+
+ ! loop over all elements of the list and insert the data
+ dataNumber = 1
+ particlelistCurr => particlelist
+ ! while we have a real link
+ do while(associated(particlelistCurr))
+
+ allocate(field0DRealPointer)
+ field0DRealPointer % scalar = field1DRealPointer % array(dataNumber)
+ call mpas_pool_add_field(particlelistCurr % particle % haloDataPool, dataName, field0DRealPointer)
+
+ ! increment for new dataNumber
+ dataNumber = dataNumber + 1
+ ! get next link
+ particlelistCurr => particlelistCurr % next
+ end do
+
+end subroutine add_halo_data_to_particle_list_1Dreal !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_add_nonhalodata_to_particlelist_1Dreal_array
+!
+!> \brief MPAS add nonhalodata to particle contained in a list
+!> \author Phillip Wolfram
+!> \date 07/01/2014
+!> \details
+!> This routine takes a an array of real scalars and places the data into
+!> the nonhaloData pool of the particles in the list. It is assumed
+!> that the dimensionality of the field is reduced in order by one
+!> on each particle.
+!
+!-----------------------------------------------------------------------
+subroutine add_nonhalo_data_to_particle_list_1Dreal_array & !{{{
+ (particlelist, dataName, array1DRealPointer)
+ ! input data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ character(len=*), intent(in) :: dataName
+ real (kind=RKIND), dimension(:), pointer :: array1DRealPointer
+
+ ! subroutine data
+ integer :: dataNumber
+ type (mpas_particle_list_type), pointer :: particlelistCurr
+ type (field0DReal), pointer :: field0DRealPointer
+
+ ! loop over all elements of the list and insert the data
+ dataNumber = 1
+ particlelistCurr => particlelist
+ ! while we have a real link
+ do while(associated(particlelistCurr))
+
+ allocate(field0DRealPointer)
+ field0DRealPointer % scalar = array1DRealPointer(dataNumber)
+ call mpas_pool_add_field(particlelistCurr % particle % nonhaloDataPool, dataName, field0DRealPointer)
+
+ ! increment for new dataNumber
+ dataNumber = dataNumber + 1
+ ! get next link
+ particlelistCurr => particlelistCurr % next
+ end do
+
+end subroutine add_nonhalo_data_to_particle_list_1Dreal_array !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_add_nonhalodata_to_particlelist_1Dreal
+!
+!> \brief MPAS add nonhalodata to particle contained in a list
+!> \author Phillip Wolfram
+!> \date 06/03/2014
+!> \details
+!> This routine takes a an array of real scalars and places the data into
+!> the nonhaloData pool of the particles in the list. It is assumed
+!> that the dimensionality of the field is reduced in order by one
+!> on each particle.
+!
+!-----------------------------------------------------------------------
+subroutine add_nonhalo_data_to_particle_list_1Dreal & !{{{
+ (particlelist, dataName, field1DRealPointer)
+ ! input data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ character(len=*), intent(in) :: dataName
+ type (field1DReal), pointer :: field1DRealPointer
+
+ ! subroutine data
+ integer :: dataNumber
+ type (mpas_particle_list_type), pointer :: particlelistCurr
+ type (field0DReal), pointer :: field0DRealPointer
+
+ ! loop over all elements of the list and insert the data
+ dataNumber = 1
+ particlelistCurr => particlelist
+ ! while we have a real link
+ do while(associated(particlelistCurr))
+
+ allocate(field0DRealPointer)
+ field0DRealPointer % scalar = field1DRealPointer % array(dataNumber)
+ call mpas_pool_add_field(particlelistCurr % particle % nonhaloDataPool, dataName, field0DRealPointer)
+
+ ! increment for new dataNumber
+ dataNumber = dataNumber + 1
+ ! get next link
+ particlelistCurr => particlelistCurr % next
+ end do
+
+end subroutine add_nonhalo_data_to_particle_list_1Dreal !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_add_halodata_to_particlelist_1Dint_array
+!
+!> \brief MPAS add halodata to particle contained in a list
+!> \author Phillip Wolfram
+!> \date 07/01/2014
+!> \details
+!> This routine takes a an array of int scalars and places the data into
+!> the haloData pool of the particles in the list. It is assumed
+!> that the dimensionality of the field is reduced in order by one
+!> on each particle.
+!
+!-----------------------------------------------------------------------
+subroutine add_halo_data_to_particle_list_1Dint_array & !{{{
+ (particlelist, dataName, array1DIntPointer)
+ ! input data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ character(len=*), intent(in) :: dataName
+ integer, dimension(:), pointer, intent(in) :: array1DIntPointer
+
+ ! subroutine data
+ integer :: dataNumber
+ type (mpas_particle_list_type), pointer :: particlelistCurr
+ type (field0DInteger), pointer :: field0DIntPointer
+
+ ! loop over all elements of the list and insert the data
+ dataNumber = 1
+ particlelistCurr => particlelist
+ ! while we have a int link
+ do while(associated(particlelistCurr))
+
+ allocate(field0DIntPointer)
+ field0DIntPointer % scalar = array1DIntPointer(dataNumber)
+ call mpas_pool_add_field(particlelistCurr % particle % haloDataPool, dataName, field0DIntPointer)
+
+ ! increment for new dataNumber
+ dataNumber = dataNumber + 1
+ ! get next link
+ particlelistCurr => particlelistCurr % next
+ end do
+
+end subroutine add_halo_data_to_particle_list_1Dint_array !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_add_halodata_to_particlelist_1Dint
+!
+!> \brief MPAS add halodata to particle contained in a list
+!> \author Phillip Wolfram
+!> \date 06/03/2014
+!> \details
+!> This routine takes a an array of int scalars and places the data into
+!> the haloData pool of the particles in the list. It is assumed
+!> that the dimensionality of the field is reduced in order by one
+!> on each particle.
+!
+!-----------------------------------------------------------------------
+subroutine add_halo_data_to_particle_list_1Dint & !{{{
+ (particlelist, dataName, field1DIntPointer)
+ ! input data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ character(len=*), intent(in) :: dataName
+ type (field1DInteger), pointer, intent(in) :: field1DIntPointer
+
+ ! subroutine data
+ integer :: dataNumber
+ type (mpas_particle_list_type), pointer :: particlelistCurr
+ type (field0DInteger), pointer :: field0DIntPointer
+
+ ! loop over all elements of the list and insert the data
+ dataNumber = 1
+ particlelistCurr => particlelist
+ ! while we have a int link
+ do while(associated(particlelistCurr))
+
+ allocate(field0DIntPointer)
+ field0DIntPointer % scalar = field1DIntPointer % array(dataNumber)
+ call mpas_pool_add_field(particlelistCurr % particle % haloDataPool, dataName, field0DIntPointer)
+
+ ! increment for new dataNumber
+ dataNumber = dataNumber + 1
+ ! get next link
+ particlelistCurr => particlelistCurr % next
+ end do
+
+end subroutine add_halo_data_to_particle_list_1Dint !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_add_nonhalodata_to_particlelist_1Dint_array
+!
+!> \brief MPAS add nonhalodata to particle contained in a list
+!> \author Phillip Wolfram
+!> \date 07/01/2014
+!> \details
+!> This routine takes a an array of int scalars and places the data into
+!> the nonhaloData pool of the particles in the list. It is assumed
+!> that the dimensionality of the field is reduced in order by one
+!> on each particle.
+!
+!-----------------------------------------------------------------------
+subroutine add_nonhalo_data_to_particle_list_1Dint_array & !{{{
+ (particlelist, dataName, array1DIntPointer)
+ ! input data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ character(len=*), intent(in) :: dataName
+ integer, dimension(:), pointer, intent(in) :: array1DIntPointer
+
+ ! subroutine data
+ integer :: dataNumber
+ type (mpas_particle_list_type), pointer :: particlelistCurr
+ type (field0DInteger), pointer :: field0DIntPointer
+
+ ! loop over all elements of the list and insert the data
+ dataNumber = 1
+ particlelistCurr => particlelist
+ ! while we have a int link
+ do while(associated(particlelistCurr))
+
+ allocate(field0DIntPointer)
+ field0DIntPointer % scalar = array1DIntPointer(dataNumber)
+ call mpas_pool_add_field(particlelistCurr % particle % nonhaloDataPool, dataName, field0DIntPointer)
+
+ ! increment for new dataNumber
+ dataNumber = dataNumber + 1
+ ! get next link
+ particlelistCurr => particlelistCurr % next
+ end do
+
+end subroutine add_nonhalo_data_to_particle_list_1Dint_array !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_add_nonhalodata_to_particlelist_1Dint
+!
+!> \brief MPAS add nonhalodata to particle contained in a list
+!> \author Phillip Wolfram
+!> \date 06/03/2014
+!> \details
+!> This routine takes a an array of int scalars and places the data into
+!> the nonhaloData pool of the particles in the list. It is assumed
+!> that the dimensionality of the field is reduced in order by one
+!> on each particle.
+!
+!-----------------------------------------------------------------------
+subroutine add_nonhalo_data_to_particle_list_1Dint & !{{{
+ (particlelist, dataName, field1DIntPointer)
+ ! input data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ character(len=*), intent(in) :: dataName
+ type (field1DInteger), pointer, intent(in) :: field1DIntPointer
+
+ ! subroutine data
+ integer :: dataNumber
+ type (mpas_particle_list_type), pointer :: particlelistCurr
+ type (field0DInteger), pointer :: field0DIntPointer
+
+ ! loop over all elements of the list and insert the data
+ dataNumber = 1
+ particlelistCurr => particlelist
+ ! while we have a int link
+ do while(associated(particlelistCurr))
+
+ allocate(field0DIntPointer)
+ field0DIntPointer % scalar = field1DIntPointer % array(dataNumber)
+ call mpas_pool_add_field(particlelistCurr % particle % nonhaloDataPool, dataName, field0DIntPointer)
+
+ ! increment for new dataNumber
+ dataNumber = dataNumber + 1
+ ! get next link
+ particlelistCurr => particlelistCurr % next
+ end do
+
+end subroutine add_nonhalo_data_to_particle_list_1Dint !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine count_particlelist_particles
+!
+!> \brief MPAS count particles in particlelist (must be allocated)
+!> \author Phillip Wolfram
+!> \date 04/14/2014
+!> \details
+!> This routine counts number of particles in particlelist.
+!
+!-----------------------------------------------------------------------
+integer function count_particlelist_particles(particlelist) !{{{
+ implicit none
+ ! input/output data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+
+ ! subroutine data
+ type (mpas_particle_list_type), pointer :: ParticleLinkCurr
+
+ count_particlelist_particles = 0
+ !write(stderrUnit,*) 'count_particlelist'
+ !if(.not.associated(particlelist)) then
+ ! write(stdoutunit,*) 'particleLinkCurr not associated'
+ ! return
+ !end if
+
+ ! current link
+ particleLinkCurr => particlelist
+
+ do while (associated(particleLinkCurr))
+ ! increment the list
+ if (associated(particleLinkCurr % particle)) then
+ count_particlelist_particles = count_particlelist_particles + 1
+ end if
+ ! get next item on the list
+ particleLinkCurr => particleLinkCurr % next
+ end do
+
+ return
+
+end function count_particlelist_particles !}}}
+
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine build_new_particlelist
+!
+!> \brief MPAS build list of particles
+!> \author Phillip Wolfram
+!> \date 06/03/2014
+!> \details
+!> This routine builds up a list of empty particles ready to be populated.
+!> This is just a raw constructor for a particle list. This assumes
+!> that a list is more than 1 link, such that nParticles >= 2.
+!
+!-----------------------------------------------------------------------
+subroutine build_new_particlelist(nParticles, particlelist, ioBlock) !{{{
+ ! input/output data
+ ! number of particles
+ integer, intent(in) :: nParticles
+ integer, intent(in), optional :: ioBlock
+ type (field0dInteger), pointer :: ioBlockfield
+ type (mpas_particle_list_type), pointer, intent(inout) :: particlelist
+ ! subroutine data
+ integer aParticle
+ type (mpas_particle_type), pointer :: particle
+ type (mpas_particle_list_type), pointer :: newParticleLink
+ type (mpas_particle_list_type), pointer :: ParticleLinkCurr
+
+ integer :: counter
+
+ if(nParticles == 0) then
+ return
+ end if
+
+ ! instantiate a list of empty particles of dimension nParticles
+ if(.not.associated(particlelist)) then
+ allocate(particlelist)
+ end if
+
+ ! allocate memory for the new particle
+ allocate(particle)
+ call mpas_pool_create_pool(particle % haloDataPool)
+ call mpas_pool_create_pool(particle % nonhaloDataPool)
+ if (present(ioBlock)) then
+ allocate(ioBlockfield)
+ ioBlockfield % scalar = ioBlock
+ call mpas_pool_add_field(particle % haloDataPool, 'ioBlock', ioBlockfield)
+ end if
+
+ !! allocate start of list link (this must have already been done!
+ ! assign allocated particle memory to link
+ particlelist % particle => particle
+
+ ! current link
+ particleLinkCurr => particlelist
+
+ ! add more links
+ do aParticle = 2, nParticles
+ ! allocate memory for the new particle
+ allocate(particle)
+ call mpas_pool_create_pool(particle % haloDataPool)
+ call mpas_pool_create_pool(particle % nonhaloDataPool)
+ if(present(ioBlock)) then
+ allocate(ioBlockfield)
+ ioBlockfield % scalar = ioBlock
+ call mpas_pool_add_field(particle % haloDataPool, 'ioBlock', ioBlockfield)
+ end if
+ ! we already have one link so make a new one
+ allocate(newParticleLink)
+ ! place the particle in the list link
+ newParticleLink % particle => particle
+ nullify(newParticleLink % next)
+ ! connect new link to current link
+ newParticleLink % prev => particleLinkCurr
+ ! next link is the new link
+ particleLinkCurr % next => newParticleLink
+ ! reset link to last link
+ particleLinkCurr => newParticleLink
+ end do
+
+end subroutine build_new_particlelist !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine count_particlelist
+!
+!> \brief MPAS count particles in particlelist
+!> \author Phillip Wolfram
+!> \date 04/14/2014
+!> \details
+!> This routine counts number of particles in particlelist.
+!
+!-----------------------------------------------------------------------
+integer function count_particlelist(particlelist) !{{{
+ implicit none
+ ! input/output data
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+
+ ! subroutine data
+ type (mpas_particle_list_type), pointer :: ParticleLinkCurr
+
+ count_particlelist = 0
+ !write(stderrUnit,*) 'count_particlelist'
+ !if(.not.associated(particlelist)) then
+ ! write(stdoutunit,*) 'particleLinkCurr not associated'
+ ! return
+ !end if
+
+ ! current link
+ particleLinkCurr => particlelist
+
+ do while (associated(particleLinkCurr))
+ ! increment the list
+ count_particlelist = count_particlelist + 1
+ !write(stderrUnit,*) 'count_particlelist = ', count_particlelist
+ ! get next item on the list
+ particleLinkCurr => particleLinkCurr % next
+ end do
+
+ return
+
+end function count_particlelist !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine destroy_particle
+!
+!> \brief MPAS destroy particle
+!> \author Phillip Wolfram
+!> \date 06/03/2014
+!> \details
+!> This routine destroys a particle, deallocating its memory
+!
+!-----------------------------------------------------------------------
+subroutine destroy_particle(particle) !{{{
+ implicit none
+
+ type (mpas_particle_type), pointer, intent(inout) :: particle
+
+ if(associated(particle)) then
+ if(associated(particle % haloDataPool)) then
+ call mpas_pool_destroy_pool(particle % haloDataPool)
+ end if
+ if(associated(particle % nonhaloDataPool)) then
+ call mpas_pool_destroy_pool(particle % nonhaloDataPool)
+ end if
+ deallocate(particle)
+ end if
+
+end subroutine destroy_particle !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine empty_particlelist
+!
+!> \brief MPAS empty particlelist
+!> \author Phillip Wolfram
+!> \date 06/27/2014
+!> \details
+!> This routine emptys a particlelist, deallocating its memory
+!> but keeping memory of particles it contains intact
+!
+!-----------------------------------------------------------------------
+subroutine empty_particlelist(particlelist) !{{{
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ type (mpas_particle_list_type), pointer :: pLCurr, pLCurrTemp
+
+ plCurr => particlelist
+ do while(associated(plCurr))
+ pLCurrTemp => pLCurr
+ pLCurr => pLCurr % next
+ deallocate(pLCurrTemp)
+ ! N.B., particle contained in pLCurrTemp is not deallocated!!!
+ end do
+
+end subroutine empty_particlelist !}}}
+
+subroutine destory_list_particlelists(listParticleLists) !{{{
+ type (mpas_list_of_particle_list_type), dimension(:), pointer, intent(inout) :: listParticleLists
+ integer :: i, sizeList
+
+ if(associated(listParticleLists)) then
+ sizeList = size(listParticleLists)
+ do i=1,sizeList
+ call mpas_particle_list_destroy_particle_list(listParticleLists(i) % list)
+ end do
+ deallocate(listParticleLists)
+ end if
+
+end subroutine destory_list_particlelists !}}}
+
+subroutine empty_list_particlelists(listParticleLists) !{{{
+ type (mpas_list_of_particle_list_type), dimension(:), pointer, intent(inout) :: listParticleLists
+ integer :: i, sizeList
+
+ if(associated(listParticleLists)) then
+ sizeList = size(listParticleLists)
+ do i=1,sizeList
+ call empty_particlelist(listParticleLists(i) % list)
+ end do
+ deallocate(listParticleLists)
+ end if
+
+end subroutine empty_list_particlelists!}}}
+
+!***********************************************************************
+!
+! routine compute_cellOwnerBlock(domain, err)
+!
+!> \brief Compute owner block arrays to specify halo ownership
+!> \author Phillip Wolfram
+!> \date 06/25/2014
+!> \details
+!> This routine computes the cellOwnerBlock for all cells on a block,
+!> diagnosing the block which owns each cell. Could potentially be
+!> generalized and put in framework (probably need package variables
+!> if particles are used).
+!
+!-----------------------------------------------------------------------
+ subroutine compute_cellOwnerBlock(domain, err) !{{{
+ implicit none
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: lagrPartTrackPool
+ type (field1DInteger), pointer :: cellOwnerBlock
+
+ err = 0
+
+ block => domain % blocklist
+ do while (associated(block))
+ ! get pool to access cellOwnerBlock
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackCells', lagrPartTrackPool)
+ ! prepare cellOwnerBlock for use in determining blockID to
+ ! be passed from one processor to another
+ call mpas_pool_get_field(lagrPartTrackPool, 'cellOwnerBlock', cellOwnerBlock)
+ ! set cellOwnerBlock to be current block
+ cellOwnerBlock % array(:) = block % blockID
+
+ block => block % next
+ end do
+ ! exchange halos
+ call mpas_dmpar_exch_halo_field(cellOwnerBlock)
+
+ end subroutine compute_cellOwnerBlock !}}}
+
+!***********************************************************************
+!
+! routine compute_blockNeighs(domain, err)
+!
+!> \brief Compute neighboring blocks from owner block,
+!> parsing the halo to get unique values
+!> \author Phillip Wolfram
+!> \date 06/26/2014
+!> \details
+!> This routine computes the neighboring blocks block % blockNeighs
+!> for each block. Note that the size of this is not predetermined
+!> and depends on the partitioning (typically in graph.info.part.#)
+!
+!-----------------------------------------------------------------------
+ subroutine compute_blockNeighs(domain, err) !{{{
+ implicit none
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: lagrPartTrackPool
+ type (field1DInteger), pointer :: cellOwnerBlock
+
+ err = 0
+
+ block => domain % blocklist
+ do while (associated(block))
+ ! get pool to access cellOwnerBlock
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackCells', lagrPartTrackPool)
+ ! get cellOwnerBlock
+ call mpas_pool_get_field(lagrPartTrackPool, 'cellOwnerBlock', cellOwnerBlock)
+
+ ! compute unique list obtained from cellOwnerBlock
+ call uniqueIntegerList(cellOwnerBlock % array, block % blockNeighs)
+
+ block => block % next
+ end do
+
+ end subroutine compute_blockNeighs !}}}
+
+!***********************************************************************
+!
+! routine compute_block_procNeighs(domain, err)
+!
+!> \brief Compute neighboring processors from blockNeighs,
+!> getting unique values on a block
+!> \author Phillip Wolfram
+!> \date 06/26/2014
+!> \details
+!> This routine computes the neighboring processors corresponding to
+!> block % blockNeighs for each block.
+!
+!-----------------------------------------------------------------------
+ subroutine compute_block_procNeighs(domain, err) !{{{
+ implicit none
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+ type (block_type), pointer :: block
+ !type (mpas_pool_type), pointer :: lagrPartTrackPool
+ integer, dimension(:), pointer :: array
+ integer :: numBlockNeighs, i
+
+ err = 0
+
+ block => domain % blocklist
+ do while (associated(block))
+ ! convert blockNeighs to procNeighs array
+ numBlockNeighs = size(block % blockNeighs)
+ allocate(array(numBlockNeighs))
+ do i=1, numBlockNeighs
+ call mpas_get_owning_proc(domain % dminfo, block % blockNeighs(i), array(i))
+ end do
+ ! compute unique list for processor neighbors
+ call uniqueIntegerList(array, block % procNeighs)
+
+ ! free up temporary memory
+ deallocate(array)
+
+ ! get the next block
+ block => block % next
+ end do
+
+ end subroutine compute_block_procNeighs !}}}
+
+!***********************************************************************
+!
+! routine compute_procNeighs(domain, err)
+!
+!> \brief Compute neighboring processors from blockNeighs,
+!> getting unique values across all blocks
+!> \author Phillip Wolfram
+!> \date 06/26/2014
+!> \details
+!> This routine computes the neighboring processors corresponding to
+!> block % procNeighs for each block.
+!
+!-----------------------------------------------------------------------
+ subroutine compute_procNeighs(domain, err, procNeighs) !{{{
+ implicit none
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+ integer, dimension(:), pointer, intent(out) :: procNeighs
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+ type (block_type), pointer :: block
+ integer, dimension(:), pointer :: tempIntegerArray
+ integer :: localSize, totalSize, iStart
+
+ err = 0
+
+ totalSize = 0
+
+ block => domain % blocklist
+ do while(associated(block))
+ totalSize = totalSize + size(block % procNeighs)
+ block => block % next
+ end do
+
+ allocate(tempIntegerArray(totalSize))
+
+ block => domain % blocklist
+ iStart = 1
+ do while(associated(block))
+ localSize = size(block % procNeighs)
+ tempIntegerArray(iStart:iStart+localSize-1) = block % procNeighs
+ iStart = iStart + localSize
+ block => block % next
+ end do
+
+ ! get unique array for complete list
+ call uniqueIntegerList(tempIntegerArray, procNeighs)
+ call removeValueFromIntList(procNeighs, domain % dminfo % my_proc_id)
+
+ deallocate(tempIntegerArray)
+
+ end subroutine compute_procNeighs !}}}
+
+
+!***********************************************************************
+!
+! routine removeValueFromIntList(list, removeval)
+!
+!> \brief Remove value removeval from list vector
+!> \author Phillip Wolfram
+!> \date 10/22/2015
+!> \details
+!> This routine remotes the removeval value from the list in-place.
+!
+!-----------------------------------------------------------------------
+ subroutine removeValueFromIntList(list, removeval) !{{{
+ implicit none
+ integer, dimension(:), pointer, intent(inout) :: list
+ integer, intent(in) :: removeval
+
+ integer, dimension(:), pointer :: tmparray
+ integer :: nsize, i
+
+ ! get size of new array
+ nsize = 0
+ do i = 1, size(list)
+ if (list(i) /= removeval) then
+ nsize = nsize + 1
+ end if
+ end do
+
+ allocate(tmparray(nsize))
+ nsize = 0
+ do i = 1, size(list)
+ if (list(i) /= removeval) then
+ nsize = nsize + 1
+ tmparray(nsize) = list(i)
+ end if
+ end do
+
+ ! resize the list
+ deallocate(list)
+ allocate(list(nsize))
+
+ ! transfer contents back to list
+ do i = 1, nsize
+ list(i) = tmparray(i)
+ end do
+
+ deallocate(tmparray)
+
+ end subroutine removeValueFromIntList
+
+!***********************************************************************
+!
+! routine mpas_particle_list_self_union_halo_lists(self, list)
+!
+!> \brief Taken union of self and list and store in self
+!> \author Phillip J. Wolfram
+!> \date 10/29/2015
+!> \details
+!> This routine computes the unique entries in an array using a
+!> linked list for dynamic memory storage
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_particle_list_self_union_halo_lists(self, list, nprocs, procid) !{{{
+ implicit none
+ integer, dimension(:), pointer, intent(inout) :: self
+ integer, dimension(:), pointer, intent(in) :: list
+ integer, intent(in) :: nprocs
+ integer, intent(in) :: procid
+
+ logical, dimension(:), pointer :: theunion
+ integer :: i, thesum
+
+ allocate(theunion(nprocs))
+ theunion = .False.
+
+ ! use Fortran integer indexing
+ theunion(self+1) = .True.
+ theunion(list+1) = .True.
+
+ ! compute number of processors in halo
+ thesum = 0
+ do i=1,nprocs
+ if (theunion(i)) then
+ thesum = thesum + 1
+ end if
+ end do
+
+ ! rebuild up self
+ deallocate(self)
+ allocate(self(thesum))
+
+ ! store processor number in new list
+ thesum = 0
+ do i=1,nprocs
+ if (theunion(i)) then
+ thesum = thesum + 1
+ self(thesum) = i-1
+ end if
+ end do
+
+ deallocate(theunion)
+ call removeValueFromIntList(self, procid)
+
+ end subroutine mpas_particle_list_self_union_halo_lists !}}}
+
+!***********************************************************************
+!
+! routine uniqueIntegerList(array, uniqueList)
+!
+!> \brief Compute unique entries in array with output in uniqueList
+!> \author Phillip Wolfram
+!> \date 06/26/2014
+!> \details
+!> This routine computes the unique entries in an array using a
+!> linked list for dynamic memory storage
+!
+!-----------------------------------------------------------------------
+ subroutine uniqueIntegerList(array, uniqueList) !{{{
+ implicit none
+ integer, dimension(:), pointer, intent(out) :: uniqueList
+ integer, dimension(:), pointer, intent(in) :: array
+
+ type simplelist
+ type (simplelist), pointer :: next => null()
+ integer :: num
+ end type simplelist
+
+ type (simplelist), pointer :: listhead, templist, currlist
+
+ integer :: nlist, i
+
+ ! parse the simple list, looking for unique values
+ ! algorithm will scale like Nblocks*NCells
+
+ if(.not.associated(array)) then
+ uniqueList => null()
+ return
+ end if
+
+ ! first entry
+ allocate(listhead)
+ listhead % num = array(1)
+ nlist = 1
+
+ do i = 2, size(array)
+ currlist => listhead
+ ! check to see if value is on list
+ do while(associated(currlist))
+ if(currlist % num == array(i)) then
+ exit
+ else
+ if(.not.associated(currlist % next)) then
+ ! we are on the end of the list, so we should add the entry
+ allocate(templist)
+ templist % num = array(i)
+ nlist = nlist + 1
+ currlist % next => templist
+ end if
+ currlist => currlist % next
+ end if
+ end do
+ end do
+
+ ! now we have a complete, unique list so store it
+ if(associated(uniqueList)) LIGHT_ERROR_WRITE('Trying to allocate uniqueList, which is already allocated!')
+ allocate(uniqueList(nlist))
+
+ currlist => listhead
+ i = 1
+ do while(associated(currlist))
+ uniqueList(i) = currlist % num
+ currlist => currlist % next
+ i = i + 1
+ end do
+
+ ! deallocate linked list
+ currlist => listhead
+ do while(associated(currlist))
+ templist => currlist % next
+ deallocate(currlist)
+ currlist => templist
+ end do
+
+ end subroutine uniqueIntegerList !}}}
+
+!***********************************************************************
+!
+! routine compute_all_particle_values_unique_int
+!
+!> \brief Get a unique list of values across particlelists on all blocks
+!> \author Phillip Wolfram
+!> \date 07/02/2014
+!> \details
+!> This routine computes a unique list of values for all the particles
+!> on the processor.
+!
+!-----------------------------------------------------------------------
+ subroutine compute_all_particle_values_unique_int(domain, err, attrName, attrData) !{{{
+ implicit none
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+ character(len=*) :: attrName
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+ integer, dimension(:), pointer, intent(out) :: attrData
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+ type (block_type), pointer :: block
+ integer, dimension(:), pointer :: tempIntegerArray
+ integer :: localSize, totalSize, iStart, nPart
+
+ err = 0
+
+ ! need to get full set of attrData from each processor and form unique list
+
+ totalSize = 0
+
+ block => domain % blocklist
+ do while(associated(block))
+ nPart = count_particlelist(block % particlelist)
+ if (nPart > 0) then
+ allocate(attrData(nPart))
+ call get_halo_data_from_particle_list_array(block % particlelist, trim(attrName), attrData)
+ totalSize = totalSize + size(attrData)
+ deallocate(attrData)
+ end if
+ block => block % next
+ end do
+
+ if (totalSize > 0) allocate(tempIntegerArray(totalSize))
+
+ block => domain % blocklist
+ iStart = 1
+ do while(associated(block))
+ nPart = count_particlelist(block % particlelist)
+ if (nPart > 0) then
+ allocate(attrData(nPart))
+ call get_halo_data_from_particle_list_array(block % particlelist, trim(attrName), attrData)
+ localSize = size(attrData)
+ tempIntegerArray(iStart:iStart+localSize-1) = attrData
+ iStart = iStart + localSize
+ deallocate(attrData)
+ end if
+ block => block % next
+ end do
+
+ ! get unique array for complete list
+ !if(associated(tempIntegerArray)) write(stderrUnit,*) 'tempIntegerArray = ', tempIntegerArray
+ call uniqueIntegerList(tempIntegerArray, attrData)
+
+ if (associated(tempIntegerArray)) deallocate(tempIntegerArray)
+
+ end subroutine compute_all_particle_values_unique_int !}}}
+
+!***********************************************************************
+!
+! routine make_proc_to_proc_particlelist(domain, err)
+!
+!> \brief Compute neighboring processors from blockNeighs,
+!> getting unique values across all blocks and forming the lists
+!> \author Phillip Wolfram
+!> \date 06/26/2014
+!> \details
+!> This routine computes the lists of neighboring processors
+!
+!-----------------------------------------------------------------------
+ subroutine make_proc_to_proc_particlelists(domain, copyOnly, blockSendToName, interProcPLArray, procNeighs, err) !{{{
+ implicit none
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+ character(len=*), intent(in) :: blockSendToName
+ logical, intent(in) :: copyOnly
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(in) :: domain
+ integer, dimension(:), pointer, intent(in) :: procNeighs
+ type (mpas_list_of_particle_list_type), dimension(:), &
+ pointer, intent(inout) :: interProcPLArray
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+ type (block_type), pointer :: block
+ type (mpas_particle_list_type), pointer :: particlelist, particlelisttemp, particlelisttemp2
+ integer :: thisBlock
+ integer, pointer :: particleBlock
+ integer :: particleProc, arrayIndex
+ !type (mpas_pool_type), pointer :: lagrPartTrackPool
+ type (mpas_particle_type), pointer :: particle
+ character (len=StrKIND) :: message
+
+ err = 0
+
+ LIGHT_DEBUG_WRITE('make_proc_to_proc_particlelists')
+
+ block => domain % blocklist
+ do while(associated(block))
+ ! for each particle on each block
+ particlelist => block % particlelist
+ do while(associated(particlelist))
+ LIGHT_DEBUG_ALL_WRITE('link on particlelist ' COMMA loc(particlelist))
+#ifdef MPAS_DEBUG
+ if(.not.associated(particlelist % particle)) then
+ LIGHT_ERROR_WRITE('particle not associated!')
+ end if
+#endif
+ particle => particlelist % particle
+#ifdef MPAS_DEBUG
+ if(.not.associated(particle % haloDataPool)) then
+ LIGHT_ERROR_WRITE('particle haloDataPool not associated!')
+ end if
+#endif
+ call mpas_pool_get_array(particle % haloDataPool, blockSendToName, particleBlock)
+ ! For example:
+ !call mpas_pool_get_array(particle % haloDataPool, 'currentBlock', particleBlock)
+
+ LIGHT_DEBUG_ALL_WRITE('particleBlock ' COMMA particleBlock COMMA ' for ' COMMA trim(blockSendToName))
+ LIGHT_DEBUG_ALL_WRITE('before mpas call')
+ call mpas_get_owning_proc(domain % dminfo, particleBlock, particleProc)
+#ifdef MPAS_DEBUG
+ if(particleBlock /= particleProc) then
+ write(message, *) 'Error if one block per proc: currentBlock = ', particleBlock, ' currentProc = ', particleProc
+ LIGHT_ERROR_WRITE(message)
+ end if
+#endif
+ LIGHT_DEBUG_WRITE('after mpas call')
+ ! determine whether it belongs on thisBlock
+ LIGHT_DEBUG_WRITE('myproc= ' COMMA domain % dminfo % my_proc_id COMMA ' particleProc= ' COMMA particleProc)
+ ! eventual support for multiple blocks
+ !if(particleBlock /= block % blockID) then
+ if(particleProc /= domain % dminfo % my_proc_id) then
+ ! we need to move the particle to a list for export to particleProc
+ ! get index for array and place particle in list at that index location
+ !write(stderrUnit,*) 'get array index'
+ arrayIndex = find_index(procNeighs, particleProc)
+ if(arrayIndex == -1) LIGHT_ERROR_WRITE('Found processor is not on list of "halo" processors!')
+ LIGHT_DEBUG_WRITE('ammending particle to processor index ' COMMA arrayIndex)
+ call append_particle_to_particlelist(particle, interProcPLArray(arrayIndex)%list)
+ write(message, *) 'added particle ', loc(particle), ' on link ', loc(particlelist), ' to list'
+ LIGHT_DEBUG_ALL_WRITE(message)
+ if (.not.copyOnly) then
+ ! REMOVE PARTICLE FROM EXISTING PARTICLELIST
+ ! remove particle reference from existing particle list to prevent bug / hitting null
+ ! particle if particle is deallocated when interProcPLArray particlelists are destroyed
+ ! next two lines mean (particlelist % prev) % next => particlelist % next, which
+ ! fortran doesn't allow even though syntactically this makes perfect sense.
+ ! 3 cases: head, middle, tail
+ if(associated(particlelist % prev)) then
+ LIGHT_DEBUG_ALL_WRITE('have previous particlelist link')
+ particlelisttemp => particlelist % prev
+ if (associated(particlelist % next)) then
+ LIGHT_DEBUG_ALL_WRITE('in middle of list')
+ ! case of the middle
+ particlelisttemp % next => particlelist % next
+ particlelisttemp2 => particlelisttemp
+ ! want to keep particle memory intact because their pointers were passed previously,
+ ! so just empty the list, don't destroy it and its contents
+ particlelisttemp => particlelist % next
+ particlelisttemp % prev => particlelisttemp2
+
+ particlelisttemp => particlelisttemp % prev
+ ! just need to remove the single link, particle memory needs to stay intact
+ !write(stderrunit,*) 'deallocating link ', loc(particlelist)
+ ! deallocate link and get next link
+ deallocate(particlelist)
+ particlelist => particlelisttemp
+ else
+ LIGHT_DEBUG_ALL_WRITE('in tail of list')
+ ! case of tail
+ nullify(particlelisttemp % next)
+ !write(stderrunit,*) 'deallocating link ', loc(particlelist)
+ ! deallocate link and get next link
+ deallocate(particlelist)
+ ! no other links to process
+ end if
+ else
+ if(associated(particlelist % next)) then
+ LIGHT_DEBUG_ALL_WRITE('in head of list')
+ ! case of head, set new head (assumes more than one particle)
+ particlelisttemp => particlelist % next
+ nullify(particlelisttemp % prev)
+ deallocate(particlelist)
+ block % particlelist => particlelisttemp
+ !write(stderrunit,*) 'deallocating link ', loc(particlelist)
+ ! deallocate link and get next link
+ particlelist => particlelisttemp
+ else
+ LIGHT_DEBUG_ALL_WRITE('single link ' COMMA loc(particlelist))
+ LIGHT_DEBUG_ALL_WRITE('block % particlelist' COMMA loc(block % particlelist))
+ ! case of single link / particle
+ LIGHT_DEBUG_ALL_WRITE('deallocating link ' COMMA loc(particlelist))
+ deallocate(particlelist)
+ nullify(block % particlelist) !deallocate(block % particlelist)
+ ! there is no other particle in the list (we now have 0!)
+ end if
+ end if
+ else
+ particlelist => particlelist % next
+ end if
+ else
+ LIGHT_DEBUG_ALL_WRITE('just go to the next particle')
+ particlelist => particlelist % next
+ end if
+ end do
+
+ ! this is done for each block because we want processor - processor communication
+ block => block % next
+ end do
+
+ end subroutine make_proc_to_proc_particlelists!}}}
+
+ subroutine get_num_particlelists(particlelists, numLists, nPartList) !{{{
+ implicit none
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_list_of_particle_list_type), dimension(:), &
+ pointer, intent(in) :: particlelists
+ integer, intent(in) :: numLists
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+ integer, dimension(:), pointer, intent(inout) :: nPartList
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+ integer :: i, allerr=0
+
+ ! now get number of particles in each list
+ ! for each entry in list of particlelist
+ nPartList = -1
+ do i=1, numLists
+ nPartList(i) = count_particlelist(particlelists(i)%list)
+ LIGHT_DEBUG_WRITE('nPartList(i)=' COMMA nPartList(i))
+ end do
+
+ end subroutine get_num_particlelists !}}}
+
+!***********************************************************************
+!
+! routine communicate_num_particles_send_recv
+!
+!> \brief Communicate the number of particles to be sent/recv'd
+!> from adjacent processors
+!> \author Phillip Wolfram
+!> \date 06/27/2014
+!> \details
+!> This routine transmitts nPartSend to be stored in nPartRecv of
+!> adjacent processors in procNeighs. Not that matrix with
+!> procNeighs in columns stored in rows for each processor
+!> must be symmetric for this to work.
+!
+!-----------------------------------------------------------------------
+ subroutine communicate_num_particles_send_recv(domain, procNeighs, nPartSend, nPartRecv) !{{{
+ implicit none
+
+ type (domain_type), intent(in) :: domain
+ integer, dimension(:), pointer, intent(in) :: procNeighs
+ integer, dimension(:), pointer, intent(in) :: nPartSend
+ integer, dimension(:), pointer, intent(out) :: nPartRecv
+
+ integer :: i, j, numProcs
+ integer, dimension(:), pointer :: requestID
+ integer :: mpi_ierr
+ character (len=StrKIND) :: message
+
+ numProcs = size(procNeighs)
+
+ ! set to be -1 for error catching
+ nPartRecv = -1
+
+ ! want to send individual values in nPartSend to each entry in procNeighs (paired data)
+ ! values obtained after communication are to be stored in nPartRecv
+
+ allocate(requestID(2*numProcs))
+#ifdef MPAS_DEBUG
+ LIGHT_DEBUG_WRITE('before 1st barrier')
+#ifdef _MPI
+ call MPI_Barrier(domain % dminfo % comm, mpi_ierr)
+#endif
+ LIGHT_DEBUG_WRITE('after 1st barrier')
+ LIGHT_DEBUG_WRITE('receiving data')
+ LIGHT_DEBUG_WRITE('numProcs =' COMMA numProcs)
+#endif
+ do i=1,numProcs
+ LIGHT_DEBUG_WRITE('receiving data i=' COMMA i COMMA ' procNeighs(i)=' COMMA procNeighs(i))
+#ifdef _MPI
+ call MPI_IRecv(nPartRecv(i), 1, MPI_INTEGERKIND, procNeighs(i), procNeighs(i), &
+ domain % dminfo % comm, requestID(i), mpi_ierr)
+#endif
+ end do
+ do i=1,numProcs
+ LIGHT_DEBUG_WRITE('procNeighs=' COMMA procNeighs)
+ write(message, *) 'sending data i=', i, ' procNeighs(i)=', procNeighs(i), ' nPartSend(i)=', nPartSend(i)
+ LIGHT_DEBUG_WRITE(message)
+#ifdef _MPI
+ call MPI_ISend(nPartSend(i), 1, MPI_INTEGERKIND, procNeighs(i), domain % dminfo % my_proc_id, &
+ domain % dminfo % comm, requestID(numProcs + i), mpi_ierr)
+#endif
+ end do
+ LIGHT_DEBUG_WRITE('done with send receive calls')
+#ifdef _MPI
+ call MPI_WaitAll(2*numProcs, requestID, MPI_STATUSES_IGNORE, mpi_ierr)
+#endif
+#ifdef MPAS_DEBUG
+ LIGHT_DEBUG_WRITE('before 2nd barrier')
+#ifdef _MPI
+ call MPI_Barrier(domain % dminfo % comm, mpi_ierr)
+#endif
+ LIGHT_DEBUG_WRITE('after 2nd barrier')
+ LIGHT_DEBUG_WRITE('done with wait')
+#endif
+ deallocate(requestID)
+
+ end subroutine communicate_num_particles_send_recv !}}}
+
+!***********************************************************************
+!
+! routine compute_additional_particle_send_list
+!
+!> \brief Update send list
+!> \author Phillip Wolfram
+!> \date 06/24/2015
+!> \details
+!> Compute send list for all particles residing on correct block 'currentBlock'
+!-----------------------------------------------------------------------
+ subroutine compute_additional_particle_send_list(domain, destinationName, ioProcSendList) !{{{
+ implicit none
+ type (domain_type), intent(in) :: domain
+ character(len=*), intent(in) :: destinationName
+ logical, dimension(:), pointer, intent(inout) :: ioProcSendList
+
+ ! local variables
+ type (block_type), pointer :: block
+ type (mpas_particle_list_type), pointer :: particlelist
+ type (mpas_particle_type), pointer :: particle
+ integer, pointer :: sendBlock
+ integer :: ioProc
+
+ block => domain % blocklist
+ do while (associated(block)) !{{{
+ particlelist => block % particlelist
+ do while(associated(particlelist)) !{{{
+ particle => particlelist % particle
+ call mpas_pool_get_array(particle % haloDataPool, destinationName, sendBlock)
+ call mpas_get_owning_proc(domain % dminfo, sendBlock, ioProc)
+ ioProcSendList(ioProc+1) = .True.
+ ! get next particle to process on the list
+ particlelist => particlelist % next
+ end do !}}}
+ ! get next block
+ block => block % next
+ end do !}}}
+
+ end subroutine compute_additional_particle_send_list !}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine allocate_list_particlelists
+!
+!> \brief MPAS allocate list of particlelists
+!> \author Phillip Wolfram
+!> \date 07/01/2014
+!> \details
+!> This routine allocates a list of particlelists. Useful in preparation
+!> to receive data from MPI communication
+!
+!-----------------------------------------------------------------------
+subroutine allocate_list_particlelists(nPart, listPL) !{{{
+ implicit none
+
+ type (mpas_list_of_particle_list_type), dimension(:), intent(inout), pointer :: listPL
+ integer, dimension(:), pointer, intent(in) :: nPart
+
+ integer :: nProcs, i
+
+ nProcs = size(nPart)
+
+ ! allocate size of particeLists
+ do i=1,nProcs
+ call build_new_particlelist(nPart(i), listPL(i)%list)
+ end do
+
+end subroutine allocate_list_particlelists !}}}
+
+!***********************************************************************
+!
+! routine distribute_particlelist_to_blocks
+!
+!> \brief Take a list of particlelists and move them onto the appropriate
+!> block on the processor
+!> \author Phillip Wolfram
+!> \date 07/01/2014
+!> \details
+!> This routine places particles in a list of particlelist on the appropriate
+!> block (currentBlock) on the processor
+!
+!-----------------------------------------------------------------------
+ subroutine distribute_particlelist_to_blocks(domain, blockSendToName, listPL) !{{{
+ implicit none
+
+ type (domain_type), intent(in) :: domain
+ type (mpas_list_of_particle_list_type), dimension(:), pointer, intent(in) :: listPL
+ character(len=*), intent(in) :: blockSendToName
+
+ integer :: i, numLists
+ type (block_type), pointer :: block
+ type (mpas_particle_list_type), pointer :: tempPL
+ type (mpas_particle_type), pointer :: particle
+ type (mpas_pool_type), pointer :: lagrPartTrackPool
+ integer, pointer :: blockNum
+
+ ! need to copy pointers to particles from each entry of the listPL and move the
+ ! particle to the appropriate block
+
+ ! loop over each part of the particle list
+ numLists = size(listPL)
+ do i=1,numLists
+ ! get a single list of particles
+ tempPL => listPL(i) % list
+ ! iterate through the list and assign particles
+ do while(associated(tempPL))
+ ! get the particle blockNum
+ particle => tempPL % particle
+ call mpas_pool_get_array(particle % haloDataPool, blockSendToName, blockNum)
+
+ ! determine the block the particle should be moved to
+ block => domain % blocklist
+ LIGHT_DEBUG_ALL_WRITE('blockNum = ' COMMA blockNum)
+ blocksearch: do while(associated(block))
+ !write(stderrunit,*) 'blockID = ', block % blockID, 'blockNum = ', blockNum
+ if (block % blockID == blockNum) then
+ ! we have the correct block
+ exit blocksearch
+ end if
+ block => block % next
+ end do blocksearch
+
+ ! check to make sure block is correct
+ LIGHT_DEBUG_ALL_WRITE('blockNum = ' COMMA blockNum)
+ if (blockNum /= block % blockID) then
+ LIGHT_ERROR_WRITE('block is not correct! for blockNum =' COMMA blockNum COMMA ' and blockID = ' COMMA block % blockID)
+ end if
+
+ ! move the particle to the block
+ call append_particle_to_particlelist(particle, block % particlelist)
+
+ ! get the next particle in the list
+ tempPL => tempPL % next
+ end do
+
+ end do
+
+ end subroutine distribute_particlelist_to_blocks !}}}
+
+!***********************************************************************
+!
+! routine compute_ordering_vector
+!
+!> \brief Compute the orderingVector for restructuring of mixed up particles
+!> into original order
+!> \author Phillip Wolfram
+!> \date 07/03/2014
+!> \details
+!> This routine ensures that the particles are ordered consistently with
+!> the ordering of the original data.
+!
+!-----------------------------------------------------------------------
+ subroutine compute_ordering_vector(arrayOrig, arrayNew, orderingVector) !{{{
+ implicit none
+
+ integer, dimension(:), pointer, intent(in) :: arrayOrig, arrayNew
+ integer, dimension(:), pointer, intent(out) :: orderingVector
+
+ integer :: i, idx
+
+ allocate(orderingVector(size(arrayOrig)))
+ ! allocate to -1 to that if a value isn't found it isn't random data, assuming arrays
+ ! are all indexed starting from 1
+ orderingVector = -1
+ ! loop over each element and figure out index
+ do i=1,size(arrayOrig)
+ !N.B. should in principle check to make sure index is found
+ idx = find_index(arrayNew, arrayOrig(i))
+#ifdef MPAS_DEBUG
+ if ( idx > 0 ) then
+#endif
+ orderingVector(i) = idx
+#ifdef MPAS_DEBUG
+ else
+ LIGHT_ERROR_WRITE("ERROR! Didn't find correct ordering index")
+ end if
+#endif
+ end do
+
+ end subroutine compute_ordering_vector !}}}
+
+!***********************************************************************
+!
+! routine find_index
+!
+!> \brief find the index corresponding to num in array
+!> \author Phillip Wolfram
+!> \date 07/03/2014
+!> \details
+!> This routine returns the index such that array(find_index) = num.
+!> If the index doesn't exist it returns -1.
+!
+!-----------------------------------------------------------------------
+ integer function find_index(array, num) !{{{
+ implicit none
+
+ integer, dimension(:), pointer, intent(in) :: array
+ integer, intent(in) :: num
+
+ integer :: i
+
+ ! allocate to negative number to make sure it breaks if
+ ! an index is not found
+
+ find_index = -1
+ ! an error here could be caused by running with different
+ ! processors (blocks) specified in the input file
+ ! than run with MPI
+ do i=1,size(array)
+ if(num == array(i)) then
+ find_index = i
+ return
+ end if
+ end do
+
+#ifdef MPAS_DEBUG
+ if(find_index == -1) LIGHT_ERROR_WRITE('Error: Index number ' COMMA num COMMA ' not found in array!')
+#endif
+
+ end function find_index !}}}
+
+!***********************************************************************
+!
+! routine communicate_particle_nonhalo_data
+!
+!> \brief Communicate particle nonhalo data to relevant processors
+!> based on particlelists
+!> \author Phillip Wolfram
+!> \date 07/07/2014
+!> \details
+!> This routine transmitts nonHaloData from particlelists
+!
+!-----------------------------------------------------------------------
+ subroutine communicate_particle_nonhalo_data(domain, procNeighs, nPartSend, nPartRecv, listSend, listRecv) !{{{
+ implicit none
+
+ type (domain_type), intent(in) :: domain
+ integer, dimension(:), pointer, intent(in) :: procNeighs
+ integer, dimension(:), pointer, intent(in) :: nPartSend
+ integer, dimension(:), pointer, intent(out) :: nPartRecv
+ type (mpas_list_of_particle_list_type), dimension(:), pointer :: listSend, listRecv
+
+ integer :: i, j, numProcs, numFields, numRecv, numSends
+ integer, dimension(:), pointer :: recvRequestID, sendRequestID
+ integer :: mpi_ierr
+ type (mpas_pool_type), pointer :: lagrPartTrackPool
+ type (mpas_pool_iterator_type) :: dimItr
+ type array1DReal_list
+ real (kind=RKIND), dimension(:), pointer :: val
+ end type
+ type array1DInt_list
+ integer, dimension(:), pointer :: val
+ end type
+ type (array1DInt_list), dimension(:), pointer :: array1DIntSend, array1DIntRecv
+ type (array1DReal_list), dimension(:), pointer :: array1DRealSend, array1DRealRecv
+ character (len=StrKIND) :: message
+
+ ! for each entry in the halo pool, want to send and recv the data
+
+#ifdef _MPI
+ !call MPI_Barrier(domain % dminfo % comm)
+#endif
+
+ numProcs = size(procNeighs)
+ allocate(array1DRealSend(numProcs), array1DRealRecv(numProcs))
+ allocate(array1DIntSend(numProcs), array1DIntRecv(numProcs))
+
+ numSends = 0
+ do i = 1, numProcs
+ if (nPartSend(i) > 0) numSends = numSends + 1
+ end do
+ allocate(sendRequestID(numSends))
+
+ numRecv = 0
+ do i = 1, numProcs
+ if (nPartRecv(i) > 0) numRecv = numRecv + 1
+ end do
+ allocate(recvRequestID(numRecv))
+
+ !Notes !{{{
+ !! get number of items that need transfered from halo pool, numFields which is a constant
+ !call mpas_pool_get_subpool(domain % blocklist % structs, 'lagrPartTrackHalo', lagrPartTrackPool)
+ !call mpas_pool_begin_iteration(lagrPartTrackPool)
+ !numFields = 0
+ !do while(mpas_pool_get_next_member(lagrPartTrackPool, dimItr))
+ ! ! only need to transfer pool
+ ! if (dimItr % memberType == MPAS_POOL_FIELD) then
+ ! numFields = numFields + 1
+ ! end if
+ !end do
+ !! assume, for now, that this will be constant accross processors. If not, it would need to be sent to other
+ !! processors too. This also presumes that properties will be fixed accross the processesors.
+ !}}}
+
+ ! on each list, transmit relevant fields to associated processors (note using the var struct since it has the names
+ ! required and this information is on each processor, even if the pool's fields are empty their names and types
+ ! are there from the registry).
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'lagrPartTrackNonHalo', lagrPartTrackPool)
+ call mpas_pool_begin_iteration(lagrPartTrackPool)
+ do while(mpas_pool_get_next_member(lagrPartTrackPool, dimItr))
+ if (dimItr % memberType == MPAS_POOL_FIELD) then
+ !write(stderrUnit,*) 'transfering ', trim(dimItr % memberName)
+ if (dimItr % dataType == MPAS_POOL_REAL) then
+ ! recv
+ j = 1
+ do i=1,numProcs
+ if(nPartRecv(i) > 0) then
+ allocate(array1DRealRecv(i)%val(nPartRecv(i)))
+ !write(stderrUnit,*) 'receiving real ', trim(dimItr % memberName), ' from ', procNeighs(i)
+ ! receive communicated data
+#ifdef _MPI
+ call MPI_IRecv(array1DRealRecv(i)%val, nPartRecv(i), MPI_REALKIND, procNeighs(i), procNeighs(i), &
+ domain % dminfo % comm, recvRequestID(j), mpi_ierr)
+#endif
+ j = j + 1
+ end if
+ end do
+ ! send
+ j = 1
+ do i=1,numProcs
+ if (nPartSend(i) > 0) then
+ allocate(array1DRealSend(i)%val(nPartSend(i)))
+ !write(stderrUnit,*) 'sending real ', trim(dimItr % memberName), ' to ', procNeighs(i)
+ call get_nonhalo_data_from_particle_list_array(listSend(i)%list, dimItr % memberName, &
+ array1DRealSend(i)%val)
+#ifdef _MPI
+ call MPI_ISend(array1DRealSend(i)%val, nPartSend(i), MPI_REALKIND, procNeighs(i), &
+ domain % dminfo % my_proc_id, domain % dminfo % comm, sendRequestID(j), mpi_ierr)
+#endif
+ j = j + 1
+ end if
+ end do
+
+#ifdef _MPI
+ call MPI_WaitAll(numRecv, recvRequestID, MPI_STATUSES_IGNORE, mpi_ierr)
+#endif
+ if (mpi_ierr /= 0) LIGHT_ERROR_WRITE('recv: mpi_ierr = ' COMMA mpi_ierr)
+#ifdef _MPI
+ call MPI_WaitAll(numSends, sendRequestID, MPI_STATUSES_IGNORE, mpi_ierr)
+#endif
+ if (mpi_ierr /= 0) LIGHT_ERROR_WRITE('send: mpi_ierr = ' COMMA mpi_ierr)
+
+ ! store values
+ j = 1
+ do i=1,numProcs
+ if(nPartRecv(i) > 0) then
+ ! place it in particle list
+ call add_nonhalo_data_to_particle_list_array(listRecv(i)%list, dimItr % memberName, &
+ array1DRealRecv(i)%val)
+ j = j + 1
+ end if
+ end do
+
+ do i=1,numProcs
+ if(nPartSend(i) > 0) deallocate(array1DRealSend(i)%val)
+ end do
+ do i=1,numProcs
+ if(nPartRecv(i) > 0) deallocate(array1DRealRecv(i)%val)
+ end do
+ !write(stderrUnit,*) 'finished'
+
+ elseif (dimItr % dataType == MPAS_POOL_INTEGER) then
+ ! recv
+ j = 1
+ do i=1,numProcs
+ if(nPartRecv(i) > 0) then
+ allocate(array1DIntRecv(i)%val(nPartRecv(i)))
+ ! receive communicated data
+ !write(stderrUnit,*) 'receiving int ', trim(dimItr % memberName), ' from ', procNeighs(i)
+#ifdef _MPI
+ call MPI_IRecv(array1DIntRecv(i)%val, nPartRecv(i), MPI_INTEGERKIND, procNeighs(i), procNeighs(i), &
+ domain % dminfo % comm, recvRequestID(j), mpi_ierr)
+#endif
+ !if( trim(dimItr % memberName) == 'currentBlock') write(stderrUnit,*) 'currentBlock received ', &
+ ! nPartRecv(i), ' from', procNeighs(i), ' = ', array1DIntRecv(i)%val
+ j = j + 1
+ end if
+ end do
+ ! send
+ j = 1
+ do i=1,numProcs
+ if(nPartSend(i) > 0) then
+ allocate(array1DIntSend(i)%val(nPartSend(i)))
+ !write(stderrUnit,*) 'sending int ', trim(dimItr % memberName), ' to ', procNeighs(i)
+ call get_nonhalo_data_from_particle_list_array(listSend(i)%list, dimItr % memberName, array1DIntSend(i)%val)
+ !if( trim(dimItr % memberName) == 'currentBlock') write(stderrUnit,*) 'currentBlock sent ',nPartSend(i), &
+ ! ' to ', procNeighs(i), ' = ', array1DIntSend(i)%val
+#ifdef _MPI
+ call MPI_ISend(array1DIntSend(i)%val, nPartSend(i), MPI_INTEGERKIND, procNeighs(i), &
+ domain % dminfo % my_proc_id, domain % dminfo % comm, sendRequestID(j), mpi_ierr)
+#endif
+ j = j + 1
+ end if
+ end do
+
+#ifdef _MPI
+ call MPI_WaitAll(numRecv, recvRequestID, MPI_STATUSES_IGNORE, mpi_ierr)
+#endif
+ if (mpi_ierr /= 0) LIGHT_ERROR_WRITE('mpi_ierr = ' COMMA mpi_ierr)
+#ifdef _MPI
+ call MPI_WaitAll(numSends, sendRequestID, MPI_STATUSES_IGNORE, mpi_ierr)
+#endif
+ if (mpi_ierr /= 0) write(stderrUnit,*) 'mpi_ierr = ', mpi_ierr
+
+ !do i=1,numProcs
+ ! if(nPartRecv(i) > 0) write(stderrUnit,*) 'Received ', trim(dimItr % memberName), ' = ', array1DIntRecv(i) % val
+ !end do
+
+ ! store values
+ do i=1,numProcs
+ if(nPartRecv(i) > 0) then
+ ! place it in particle list
+ call add_nonhalo_data_to_particle_list_array(listRecv(i)%list, dimItr % memberName, array1DIntRecv(i)%val)
+ j = j + 1
+ end if
+ end do
+
+ do i=1,numProcs
+ if(nPartSend(i) > 0) deallocate(array1DIntSend(i)%val)
+ end do
+ do i=1,numProcs
+ if(nPartRecv(i) > 0) deallocate(array1DIntRecv(i)%val)
+ end do
+ !write(stderrUnit,*) 'finished'
+ else
+ !write(stderrunit,*) "Different field type than implemented during nonHalo communication!"
+ end if
+ elseif (dimItr % memberType == MPAS_POOL_DIMENSION) then
+ ! ignore dimensions for now and have this code so they aren't printed as an error message
+ else
+ write(message, *) "Different type expected in registry for key ", trim(dimItr % memberName), &
+ " in nonHalo data for communication-- don't know what to do!"
+ LIGHT_DEBUG_ALL_WRITE(message)
+ end if
+ end do
+
+ deallocate(array1DIntSend, array1DIntRecv, array1DRealSend, array1DRealRecv, recvRequestID, sendRequestID)
+ LIGHT_DEBUG_WRITE('Finished primary MPI communication for nonhalo')
+
+ end subroutine communicate_particle_nonhalo_data!}}}
+
+!***********************************************************************
+!
+! routine communicate_particle_halo_data
+!
+!> \brief Communicate particle halo data to relevant processors
+!> based on particlelists
+!> \author Phillip Wolfram
+!> \date 07/01/2014
+!> \details
+!> This routine transmitts haloData from particlelists
+!
+!-----------------------------------------------------------------------
+ subroutine communicate_particle_halo_data(domain, procNeighs, nPartSend, nPartRecv, listSend, listRecv) !{{{
+ implicit none
+
+ type (domain_type), intent(in) :: domain
+ integer, dimension(:), pointer, intent(in) :: procNeighs
+ integer, dimension(:), pointer, intent(in) :: nPartSend
+ integer, dimension(:), pointer, intent(out) :: nPartRecv
+ type (mpas_list_of_particle_list_type), dimension(:), pointer :: listSend, listRecv
+
+ integer :: i, j, numProcs, numFields, numRecv, numSends
+ integer, dimension(:), pointer :: recvRequestID, sendRequestID
+ integer :: mpi_ierr
+ type (mpas_pool_type), pointer :: lagrPartTrackPool
+ type (mpas_pool_iterator_type) :: dimItr
+ type array1DReal_list
+ real (kind=RKIND), dimension(:), pointer :: val
+ end type
+ type array1DInt_list
+ integer, dimension(:), pointer :: val
+ end type
+ type (array1DInt_list), dimension(:), pointer :: array1DIntSend, array1DIntRecv
+ type (array1DReal_list), dimension(:), pointer :: array1DRealSend, array1DRealRecv
+ character (len=StrKIND) :: message
+
+ ! for each entry in the halo pool, want to send and recv the data
+
+#ifdef _MPI
+ !call MPI_Barrier(domain % dminfo % comm)
+#endif
+
+ numProcs = size(procNeighs)
+ allocate(array1DRealSend(numProcs), array1DRealRecv(numProcs))
+ allocate(array1DIntSend(numProcs), array1DIntRecv(numProcs))
+
+ numSends = 0
+ do i = 1, numProcs
+ if (nPartSend(i) > 0) numSends = numSends + 1
+ end do
+ allocate(sendRequestID(numSends))
+
+ numRecv = 0
+ do i = 1, numProcs
+ if (nPartRecv(i) > 0) numRecv = numRecv + 1
+ end do
+ allocate(recvRequestID(numRecv))
+
+ !Notes !{{{
+ !! get number of items that need transfered from halo pool, numFields which is a constant
+ !call mpas_pool_get_subpool(domain % blocklist % structs, 'lagrPartTrackHalo', lagrPartTrackPool)
+ !call mpas_pool_begin_iteration(lagrPartTrackPool)
+ !numFields = 0
+ !do while(mpas_pool_get_next_member(lagrPartTrackPool, dimItr))
+ ! ! only need to transfer pool
+ ! if (dimItr % memberType == MPAS_POOL_FIELD) then
+ ! numFields = numFields + 1
+ ! end if
+ !end do
+ !! assume, for now, that this will be constant accross processors. If not, it would need to be sent to other
+ !! processors too. This also presumes that properties will be fixed accross the processesors.
+ !}}}
+
+ ! on each list, transmit relevant fields to associated processors (note using the var struct since it has the names
+ ! required and this information is on each processor, even if the pool's fields are empty their names and types
+ ! are there from the registry).
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'lagrPartTrackHalo', lagrPartTrackPool)
+ call mpas_pool_begin_iteration(lagrPartTrackPool)
+ do while(mpas_pool_get_next_member(lagrPartTrackPool, dimItr))
+ if (dimItr % memberType == MPAS_POOL_FIELD) then
+ !write(stderrUnit,*) 'transfering ', trim(dimItr % memberName)
+ if (dimItr % dataType == MPAS_POOL_REAL) then
+ ! recv
+ j = 1
+ do i=1,numProcs
+ if(nPartRecv(i) > 0) then
+ allocate(array1DRealRecv(i)%val(nPartRecv(i)))
+ !write(stderrUnit,*) 'receiving real ', trim(dimItr % memberName), ' from ', procNeighs(i)
+ ! receive communicated data
+#ifdef _MPI
+ call MPI_IRecv(array1DRealRecv(i)%val, nPartRecv(i), MPI_REALKIND, procNeighs(i), procNeighs(i), &
+ domain % dminfo % comm, recvRequestID(j), mpi_ierr)
+#endif
+ j = j + 1
+ end if
+ end do
+ ! send
+ j = 1
+ do i=1,numProcs
+ if (nPartSend(i) > 0) then
+ allocate(array1DRealSend(i)%val(nPartSend(i)))
+ !write(stderrUnit,*) 'sending real ', trim(dimItr % memberName), ' to ', procNeighs(i)
+ call get_halo_data_from_particle_list_array(listSend(i)%list, dimItr % memberName, &
+ array1DRealSend(i)%val)
+#ifdef _MPI
+ call MPI_ISend(array1DRealSend(i)%val, nPartSend(i), MPI_REALKIND, procNeighs(i), &
+ domain % dminfo % my_proc_id, domain % dminfo % comm, sendRequestID(j), mpi_ierr)
+#endif
+ j = j + 1
+ end if
+ end do
+
+#ifdef _MPI
+ call MPI_WaitAll(numRecv, recvRequestID, MPI_STATUSES_IGNORE, mpi_ierr)
+#endif
+ if (mpi_ierr /= 0) LIGHT_ERROR_WRITE('recv: mpi_ierr = ' COMMA mpi_ierr)
+#ifdef _MPI
+ call MPI_WaitAll(numSends, sendRequestID, MPI_STATUSES_IGNORE, mpi_ierr)
+#endif
+ if (mpi_ierr /= 0) LIGHT_ERROR_WRITE('send: mpi_ierr = ' COMMA mpi_ierr)
+
+ ! store values
+ j = 1
+ do i=1,numProcs
+ if(nPartRecv(i) > 0) then
+ ! place it in particle list
+ call add_halo_data_to_particle_list_array(listRecv(i)%list, dimItr % memberName, &
+ array1DRealRecv(i)%val)
+ j = j + 1
+ end if
+ end do
+
+ do i=1,numProcs
+ if(nPartSend(i) > 0) deallocate(array1DRealSend(i)%val)
+ end do
+ do i=1,numProcs
+ if(nPartRecv(i) > 0) deallocate(array1DRealRecv(i)%val)
+ end do
+ !write(stderrUnit,*) 'finished'
+
+ elseif (dimItr % dataType == MPAS_POOL_INTEGER) then
+ ! recv
+ j = 1
+ do i=1,numProcs
+ if(nPartRecv(i) > 0) then
+ allocate(array1DIntRecv(i)%val(nPartRecv(i)))
+ ! receive communicated data
+ !write(stderrUnit,*) 'receiving int ', trim(dimItr % memberName), ' from ', procNeighs(i)
+#ifdef _MPI
+ call MPI_IRecv(array1DIntRecv(i)%val, nPartRecv(i), MPI_INTEGERKIND, procNeighs(i), procNeighs(i), &
+ domain % dminfo % comm, recvRequestID(j), mpi_ierr)
+#endif
+ !if( trim(dimItr % memberName) == 'currentBlock') write(stderrUnit,*) 'currentBlock received ',nPartRecv(i), &
+ ! ' from', procNeighs(i), ' = ', array1DIntRecv(i)%val
+ j = j + 1
+ end if
+ end do
+ ! send
+ j = 1
+ do i=1,numProcs
+ if(nPartSend(i) > 0) then
+ allocate(array1DIntSend(i)%val(nPartSend(i)))
+ !write(stderrUnit,*) 'sending int ', trim(dimItr % memberName), ' to ', procNeighs(i)
+ call get_halo_data_from_particle_list_array(listSend(i)%list, dimItr % memberName, array1DIntSend(i)%val)
+ !if( trim(dimItr % memberName) == 'currentBlock') write(stderrUnit,*) 'currentBlock sent ',nPartSend(i), ' to ', &
+ ! procNeighs(i), ' = ', array1DIntSend(i)%val
+#ifdef _MPI
+ call MPI_ISend(array1DIntSend(i)%val, nPartSend(i), MPI_INTEGERKIND, procNeighs(i), &
+ domain % dminfo % my_proc_id, domain % dminfo % comm, sendRequestID(j), mpi_ierr)
+#endif
+ j = j + 1
+ end if
+ end do
+
+#ifdef _MPI
+ call MPI_WaitAll(numRecv, recvRequestID, MPI_STATUSES_IGNORE, mpi_ierr)
+#endif
+ if (mpi_ierr /= 0) LIGHT_ERROR_WRITE('mpi_ierr = ' COMMA mpi_ierr)
+#ifdef _MPI
+ call MPI_WaitAll(numSends, sendRequestID, MPI_STATUSES_IGNORE, mpi_ierr)
+#endif
+ if (mpi_ierr /= 0) LIGHT_ERROR_WRITE('mpi_ierr = ' COMMA mpi_ierr)
+
+ !do i=1,numProcs
+ ! if(nPartRecv(i) > 0) write(stderrUnit,*) 'Received ', trim(dimItr % memberName), ' = ', array1DIntRecv(i) % val
+ !end do
+
+ ! store values
+ do i=1,numProcs
+ if(nPartRecv(i) > 0) then
+ ! place it in particle list
+ call add_halo_data_to_particle_list_array(listRecv(i)%list, dimItr % memberName, array1DIntRecv(i)%val)
+ j = j + 1
+ end if
+ end do
+
+ do i=1,numProcs
+ if(nPartSend(i) > 0) deallocate(array1DIntSend(i)%val)
+ end do
+ do i=1,numProcs
+ if(nPartRecv(i) > 0) deallocate(array1DIntRecv(i)%val)
+ end do
+ !write(stderrUnit,*) 'finished'
+ else
+ !write(stderrunit,*) "Different field type than implemented during halo communication!"
+ end if
+ elseif (dimItr % memberType == MPAS_POOL_DIMENSION) then
+ ! ignore dimensions for now and have this code so they aren't printed as an error message
+ else
+ write(message, *) "Different type expected in registry for key ", trim(dimItr % memberName), &
+ " in halo data for communication-- don't know what to do!"
+ LIGHT_DEBUG_ALL_WRITE(message)
+ end if
+ end do
+
+ deallocate(array1DIntSend, array1DIntRecv, array1DRealSend, array1DRealRecv, recvRequestID, sendRequestID)
+ LIGHT_DEBUG_WRITE('Finished primary MPI communication for halo')
+
+ end subroutine communicate_particle_halo_data!}}}
+
+!***********************************************************************
+!
+! routine allocate_nonHalo_data
+!
+!> \brief Allocate space for nonHalo data for diagnostic output
+!> on particlelists
+!> \author Phillip Wolfram
+!> \date 07/01/2014
+!> \details
+!> This routine allocates space for nonHaloData on the particlelist
+!
+!-----------------------------------------------------------------------
+ subroutine allocate_nonHalo_data(domain, particlelist) !{{{
+ implicit none
+
+ type (domain_type), intent(in) :: domain
+ type (mpas_particle_list_type), pointer, intent(in) :: particlelist
+ type (mpas_pool_type), pointer :: lagrPartTrackPool
+ type (mpas_pool_iterator_type) :: dimItr
+
+ integer :: i, nPart
+ real (kind=RKIND), dimension(:), pointer :: array1DRealPointer
+ integer, dimension(:), pointer :: array1DIntPointer
+ character (len=StrKIND) :: message
+
+
+ ! get number of particle on list
+ nPart = count_particlelist(particlelist)
+
+ ! allocate zero arrays
+ allocate(array1DRealPointer(nPart))
+ allocate(array1DIntPointer(nPart))
+ array1DRealPointer = 0.0_RKIND
+ array1DIntPointer = 0
+
+ ! on each list, transmit relevant fields to associated processors
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'lagrPartTrackNonHalo', lagrPartTrackPool)
+ call mpas_pool_begin_iteration(lagrPartTrackPool)
+ do while(mpas_pool_get_next_member(lagrPartTrackPool, dimItr))
+ if (dimItr % memberType == MPAS_POOL_FIELD) then
+ if (dimItr % dataType == MPAS_POOL_REAL) then
+ call add_nonhalo_data_to_particle_list_array(particlelist, dimItr % memberName, array1DRealPointer)
+ elseif (dimItr % dataType == MPAS_POOL_INTEGER) then
+ call add_nonhalo_data_to_particle_list_array(particlelist, dimItr % memberName, array1DIntPointer)
+ else
+ LIGHT_DEBUG_ALL_WRITE("Different field type than implemented during halo communication!")
+ end if
+ elseif (dimItr % memberType == MPAS_POOL_DIMENSION) then
+ ! ignore dimensions for now and have this code so they aren't printed as an error message
+ else
+ write(message, *) "Different type expected in registry for key ", trim(dimItr % memberName), &
+ " in halo data for communication-- don't know what to do!"
+ LIGHT_DEBUG_ALL_WRITE(message)
+ end if
+ end do
+
+ ! deallocate arrays
+ deallocate(array1DRealPointer)
+ deallocate(array1DIntPointer)
+
+ end subroutine allocate_nonHalo_data !}}}
+
+ subroutine allocate_list_nonHalo_data(domain, listPL) !{{{
+ implicit none
+
+ type (domain_type), intent(in) :: domain
+ type (mpas_list_of_particle_list_type), dimension(:), pointer, intent(inout) :: listPL
+
+ integer :: i, numList
+
+ numList = size(listPL)
+ do i=1, numList
+ call allocate_nonHalo_data(domain, listPL(i)%list)
+ end do
+
+ end subroutine allocate_list_nonHalo_data !}}}
+
+!***********************************************************************
+!
+! routine build_block_particlelists
+!
+!> \brief Allocates empty particlelist
+!> \author Phillip Wolfram
+!> \date 04/15/2014
+!> \details
+!> This routine allocates empty particlelist data structures
+!
+!-----------------------------------------------------------------------
+ subroutine build_block_particlelists(domain, err)!{{{
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input/output variables
+ !-----------------------------------------------------------------
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_particle_list_type), pointer :: particlelist
+ integer, pointer :: nParticles
+
+ err = 0
+
+ block => domain % blocklist
+ do while (associated(block))
+ ! allocate pointers
+ call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
+ call mpas_pool_get_dimension(meshPool, 'nParticles', nParticles)
+
+ ! allocate the memory in its location for use
+ LIGHT_DEBUG_WRITE('in build_block_particlelists: nParticles = ' COMMA nParticles)
+
+ if (nParticles > 0) then
+ allocate(block % particlelist)
+ particlelist => block % particlelist
+
+ !-----------------------------------------------------------------
+ ! populate list of particles from input data structures
+ !-----------------------------------------------------------------
+
+ ! initialize the particlelist for population
+ call build_new_particlelist(nParticles, particlelist, block % blockID)
+ end if
+
+ block => block % next
+ end do
+
+ end subroutine build_block_particlelists!}}}
+
+ subroutine clear_block_particlelists(domain, err) !{{{
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input/output variables
+ !-----------------------------------------------------------------
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ type (block_type), pointer :: block
+
+ err = 0
+
+ block => domain % blocklist
+ do while (associated(block))
+
+ call mpas_particle_list_destroy_particle_list(block % particlelist)
+
+ block => block % next
+ end do
+
+ end subroutine clear_block_particlelists !}}}
+
+!***********************************************************************
+!
+! routine read_haloData
+!
+!> \brief Reads haloData from netCDF-injected struct arrays
+!> \author Phillip Wolfram
+!> \date 04/15/2014
+!> \details
+!> This routine reads haloData input for this MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+ subroutine read_haloData(domain, err)!{{{
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input/output variables
+ !-----------------------------------------------------------------
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: lagrPartTrackPool
+ type (mpas_pool_iterator_type) :: dimItr
+ type (mpas_particle_list_type), pointer :: particlelist
+ type (field1DReal), pointer :: field1DRealPointer
+ !type (field2DReal), pointer :: field2DRealPointer
+ type (field1DInteger), pointer :: field1DIntPointer
+ integer, dimension(:), pointer :: array1DInt
+ character (len=StrKIND) :: message
+
+ err = 0
+
+ block => domain % blocklist
+ do while (associated(block))
+ ! allocate pointers
+ particlelist => block % particlelist
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackHalo', lagrPartTrackPool)
+
+ ! iterate over each member of the pool and make the relevant assignment
+ call mpas_pool_begin_iteration(lagrPartTrackPool)
+ do while(mpas_pool_get_next_member(lagrPartTrackPool, dimItr))
+ ! determine the type of data
+ if (dimItr % memberType == MPAS_POOL_FIELD) then
+ if (dimItr % dataType == MPAS_POOL_REAL) then
+ call mpas_pool_get_field(lagrPartTrackPool, dimItr % memberName, field1DRealPointer)
+ LIGHT_DEBUG_WRITE(dimItr % memberName COMMA ' = ')
+ LIGHT_DEBUG_WRITE(field1DRealPointer % array)
+ call add_halo_data_to_particle_list(particlelist, dimItr % memberName, field1DRealPointer)
+ elseif (dimItr % dataType == MPAS_POOL_INTEGER) then
+ call mpas_pool_get_field(lagrPartTrackPool, dimItr % memberName, field1DIntPointer)
+ ! assign ioBlock explicitly during initial read
+ if (dimItr % memberName == 'ioBlock') then
+ LIGHT_DEBUG_WRITE('ioBlock = ' COMMA field1DIntPointer % array)
+ field1DIntPointer % array = domain % dminfo % my_proc_id
+ end if
+ LIGHT_DEBUG_WRITE(dimItr % memberName COMMA ' = ')
+ LIGHT_DEBUG_WRITE(field1DIntPointer % array)
+ call add_halo_data_to_particle_list(particlelist, dimItr % memberName, field1DIntPointer)
+ else
+ LIGHT_DEBUG_WRITE("Different field type than implemented during halo read!")
+ end if
+ elseif (dimItr % memberType == MPAS_POOL_DIMENSION) then
+ ! ignore dimensions for now and have this code so they aren't printed as an error message
+ else
+ write(message, *) "Different type expected in registry for key ", trim(dimItr % memberName), &
+ " in halo data for read-- don't know what to do!"
+ LIGHT_DEBUG_WRITE(message)
+ ! false warning for
+ !Different type expected in registry for key on_a_sphere in nonHalo data for read, don't know what to do!
+ !Different type expected in registry for key sphere_radius in nonHalo data for read, don't know what to do!
+ !Different type expected in registry for key is_periodic in nonHalo data for read, don't know what to do!
+ !Different type expected in registry for key x_period in nonHalo data for read, don't know what to do!
+ !Different type expected in registry for key y_period in nonHalo data for read, don't know what to do!
+ end if
+ end do
+
+ block => block % next
+ end do
+ LIGHT_DEBUG_WRITE('Finished reading halo data')
+
+ end subroutine read_haloData!}}}
+
+!***********************************************************************
+!
+! routine read_nonhaloData
+!
+!> \brief Reads nonhaloData from netCDF-injected struct arrays
+!> \author Phillip Wolfram
+!> \date 04/15/2014
+!> \details
+!> This routine reads nonhaloData input for this MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+ subroutine read_nonhaloData(domain, err)!{{{
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! input/output variables
+ !-----------------------------------------------------------------
+ type (domain_type), intent(in) :: domain
+
+ !-----------------------------------------------------------------
+ ! output variables
+ !-----------------------------------------------------------------
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ ! local variables
+ !-----------------------------------------------------------------
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: lagrPartTrackPool
+ type (mpas_pool_iterator_type) :: dimItr
+ type (mpas_particle_list_type), pointer :: particlelist
+ type (field1DReal), pointer :: field1DRealPointer
+ type (field1DInteger), pointer :: field1DIntPointer
+ character (len=StrKIND) :: message
+
+ err = 0
+
+ block => domain % blocklist
+ do while (associated(block))
+ ! allocate pointers
+ particlelist => block % particlelist
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackNonHalo', lagrPartTrackPool)
+
+ ! iterate over each member of the pool and make the relevant assignment
+ call mpas_pool_begin_iteration(lagrPartTrackPool)
+ do while(mpas_pool_get_next_member(lagrPartTrackPool, dimItr))
+ ! determine the type of data
+ if (dimItr % memberType == MPAS_POOL_FIELD) then
+ if (dimItr % dataType == MPAS_POOL_REAL) then
+ call mpas_pool_get_field(lagrPartTrackPool, dimItr % memberName, field1DRealPointer)
+ call add_nonhalo_data_to_particle_list(particlelist, dimItr % memberName, field1DRealPointer)
+ elseif (dimItr % dataType == MPAS_POOL_INTEGER) then
+ call mpas_pool_get_field(lagrPartTrackPool, dimItr % memberName, field1DIntPointer)
+ call add_nonhalo_data_to_particle_list(particlelist, dimItr % memberName, field1DIntPointer)
+ else
+ LIGHT_DEBUG_WRITE("Different field type than implemented in nonHalo read!")
+ end if
+ elseif (dimItr % memberType == MPAS_POOL_DIMENSION) then
+ ! ignore dimensions for now and have this code so they aren't printed as an error message
+ else
+ write(message, *) "Different type expected in registry for key ", trim(dimItr % memberName), &
+ " in nonHalo data for read-- don't know what to do!"
+ LIGHT_DEBUG_WRITE(message)
+ end if
+ end do
+
+ ! alternatively, could initialize these fields or just make sure that they exist!
+
+ block => block % next
+ end do
+ LIGHT_DEBUG_WRITE('Finished reading non-halo data')
+
+ end subroutine read_nonhaloData!}}}
+
+!***********************************************************************
+!
+! routine mpas_particle_list_update_particle_block
+!
+!> \brief Update particle block
+!> \author Phillip Wolfram
+!> \date 10/28/2015
+!> \details
+!> This routine updates the currentBlock for particles within the
+!> particlelist loop.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_particle_list_update_particle_block(domain, block, particle, poolname, iCell) !{{{
+ implicit none
+ type (domain_type), intent(inout) :: domain
+ type (block_type), intent(inout), pointer :: block
+ type (mpas_particle_type), intent(inout), pointer :: particle
+ character(len=*), intent(in) :: poolname
+ integer, intent(inout) :: iCell
+
+ ! local variables
+ type (mpas_pool_type), pointer :: lagrPartTrackCellsPool
+ integer, dimension(:), pointer :: cellOwnerBlock
+ integer, pointer :: currentBlock, transfered
+
+ call mpas_pool_get_subpool(block % structs, trim(poolname), lagrPartTrackCellsPool)
+ call mpas_pool_get_array(lagrPartTrackCellsPool, 'cellOwnerBlock', cellOwnerBlock)
+ call mpas_pool_get_array(particle % haloDataPool, 'currentBlock', currentBlock)
+ if(cellOwnerBlock(iCell) /= currentBlock) then
+ ! increment transfer counter
+ call mpas_pool_get_array(particle % haloDataPool, 'transfered', transfered)
+ transfered = transfered + 1
+ ! set new current block
+ currentBlock = cellOwnerBlock(iCell)
+ ! reset cell_id to be brute force computed on new block after trasnfer
+ iCell = -1
+ end if
+
+ end subroutine mpas_particle_list_update_particle_block !}}}
+
+!***********************************************************************
+!
+! routine mpas_particle_list_update_halos_start
+!
+!> \brief Update halo
+!> \author Phillip Wolfram
+!> \date 10/28/2015
+!> \details
+!> This routine updates the halos for particles within the particlelist loop.
+!> This facilitates a computational transfer of a particle from one domain
+!> to another.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_particle_list_update_halos_start(domain, block, particle, poolname, iCell, &
+ arrayIndex, destinationName, sendProcRecvList, sendProcSendList, gsendProcNeighs ) !{{{
+ implicit none
+ type (domain_type), intent(inout) :: domain
+ type (block_type), intent(inout), pointer :: block
+ type (mpas_particle_type), intent(inout), pointer :: particle
+ character(len=*), intent(in) :: poolname
+ ! 'ioBlock' and 'currentBlock' are options for destinationName
+ character(len=*), intent(in) :: destinationName
+ integer, intent(inout) :: iCell, arrayIndex
+ integer, dimension(:), pointer, intent(inout) :: gsendProcNeighs
+ logical, dimension(:,:), pointer, intent(inout) :: sendProcRecvList
+ logical, dimension(:), pointer, intent(inout) :: sendProcSendList
+
+ ! local variables
+ integer :: currentProc, sendProc
+ type (mpas_pool_type), pointer :: lagrPartTrackCellsPool
+ integer, pointer :: currentBlock, sendBlock
+
+ call mpas_pool_get_subpool(block % structs, trim(poolname), lagrPartTrackCellsPool)
+ call mpas_pool_get_array(particle % haloDataPool, 'currentBlock', currentBlock)
+ call mpas_pool_get_array(particle % haloDataPool, destinationName, sendBlock)
+ call mpas_get_owning_proc(domain % dminfo, currentBlock, currentProc)
+ call mpas_get_owning_proc(domain % dminfo, sendBlock, sendProc)
+
+ ! increment data for receiving processors (sum should be total number of particles on processor)
+ LIGHT_DEBUG_WRITE('destinationName=' COMMA destinationName)
+ LIGHT_DEBUG_WRITE('g_sendProcNeighs=' COMMA gsendProcNeighs)
+ LIGHT_DEBUG_WRITE('sendProc=' COMMA sendProc)
+ ! do not need to transfer information for particles on-processor, this is computed from the send list
+ ! which is dependent upon current, on-processor particles
+ if (sendProc /= domain % dminfo % my_proc_id) then
+ arrayIndex = find_index(gsendProcNeighs, sendProc)
+ sendProcRecvList(currentProc+1, arrayIndex) = .True.
+ else
+ ! consider the case where a particle on A has an sendProc of A and is sent to B (need to have B in A's halo).
+ sendProcSendList(currentProc+1) = .True.
+ end if
+ ! must be computed after computational particles are transferred (this was a bug left-over from serial IO)
+ end subroutine mpas_particle_list_update_halos_start!}}}
+
+!}}}
+
+!-----------------------------------------------------------------------
+!
+! TESTING SUBROUTINES
+!
+!-----------------------------------------------------------------------
+!{{{
+ subroutine mpas_particle_list_test_neighscalc(domain, err) !{{{
+ implicit none
+
+ type (domain_type), intent(in) :: domain
+ integer, intent(out) :: err !< Output: error flag
+ type (block_type), pointer :: block
+
+ err = 0
+ block => domain % blocklist
+ do while (associated(block))
+
+ ! write out all blockNeighs and procNeighs
+ write(stderrUnit,*) 'blockID = ', block % blockID
+ write(stderrUnit,*) 'blockNeighs = ', block % blockNeighs
+ write(stderrUnit,*) 'procNeighs = ', block % procNeighs
+
+ block => block % next
+ end do
+
+ end subroutine mpas_particle_list_test_neighscalc !}}}
+
+ subroutine mpas_particle_list_test_numparticles_to_neighprocs(myproc, procNeighs, ioProcNeighs) !{{{
+ implicit none
+ integer, intent(in) :: myproc
+ integer, dimension(:), pointer, intent(in) :: procNeighs, ioProcNeighs
+
+ integer :: i, numNeighs
+
+ numNeighs = size(procNeighs)
+
+ write(stderrUnit,*) 'myproc, procNeighs'
+ do i=1,numNeighs
+ write(stderrUnit,*) myproc, procNeighs(i)
+ end do
+ if(associated(ioProcNeighs)) then
+ write(stderrUnit,*) 'myproc, ioProcNeighs'
+ numNeighs = size(ioProcNeighs)
+ do i=1,numNeighs
+ write(stderrUnit,*) myproc, ioProcNeighs(i)
+ end do
+ end if
+
+ end subroutine mpas_particle_list_test_numparticles_to_neighprocs !}}}
+
+ subroutine mpas_particle_list_test_num_current_particlelist(domain) !{{{
+ implicit none
+ type (domain_type), intent(in) :: domain
+ type (block_type), pointer :: block
+ integer :: nPartList, nPartList_particles
+
+ block => domain % blocklist
+ do while(associated(block))
+ ! THIS LINE CAUSED A VERY, VERY, VERY NASTY BUG-- BE CAREFUL ABOUT GETTING THE LOCATION OF POTENTIALLY NULLS!
+ nPartList = count_particlelist(block % particlelist)
+ nPartList_particles = count_particlelist_particles(block % particlelist)
+ write(stderrUnit,*) 'block = ', block % blockID, ' nPartList= ', nPartList, ' nparticles = ', nPartList_particles
+ if (nPartList > nPartList_particles) then
+ write(stderrUnit,*) 'Possible error! ', nPartList - nPartList_particles, ' particles on particle list is not allocated!'
+ end if
+
+ block => block % next
+ end do
+
+ end subroutine mpas_particle_list_test_num_current_particlelist!}}}
+
+ subroutine test_currentBlock(domain) !{{{
+ implicit none
+ type (domain_type), intent(in) :: domain
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: lagrPartTrackPool
+ integer, dimension(:), pointer :: field1DInt
+ integer :: currentBlock, countOnProc, i
+ countOnProc = 0
+ block => domain % blocklist
+ do while(associated(block))
+ call mpas_pool_get_subpool(block % structs, 'lagrPartTrackHalo', lagrPartTrackPool)
+ call mpas_pool_get_array(lagrPartTrackPool, 'currentBlock', field1DInt)
+ do i=1,size(field1DInt(:))
+ if (field1DInt(i) == block % blockID) countOnProc = countOnProc + 1
+ end do
+
+ block => block % next
+ end do
+ write(stderrUnit,*) 'number of particles on processor = ', countOnProc
+
+ end subroutine test_currentBlock !}}}
+
+ subroutine test_num_particles_on_particlelist(listPL, nlist) !{{{
+ implicit none
+ integer, intent(in) :: nlist
+ type (mpas_list_of_particle_list_type), dimension(:), pointer, intent(in) :: listPL
+
+ integer :: i, sumtot, listparticles
+
+ sumtot = 0
+ do i = 1, nlist
+ listparticles = count_particlelist(listPL(i)%list)
+ write(stderrUnit,*) 'list i=',i,' nparticles=', listparticles
+ sumtot = sumtot + listparticles
+ end do
+ write(stderrunit,*) 'total_on_list=', sumtot
+ end subroutine test_num_particles_on_particlelist !}}}
+!}}}
+
+
+end module ocn_particle_list
+! vim: foldmethod=marker
diff --git a/src/core_ocean/analysis_members/mpas_ocn_pointwise_stats.F b/src/core_ocean/analysis_members/mpas_ocn_pointwise_stats.F
new file mode 100644
index 0000000000..2b27af9285
--- /dev/null
+++ b/src/core_ocean/analysis_members/mpas_ocn_pointwise_stats.F
@@ -0,0 +1,1318 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_pointwise_stats
+!
+!> \brief MPAS ocean analysis mode member: pointwise_stats
+!> \author Mark Petersen
+!> \date Jan 2016
+!> \details
+!> MPAS ocean analysis mode member: pointwise_stats
+!>
+!-----------------------------------------------------------------------
+
+#define COMMA ,
+#define PWAM_DEBUG_WRITE(M) ! write(stderrUnit,*) M
+#define PWAM_WARNING_WRITE(M) write(stderrUnit,*) 'WARNING: '//M
+#define PWAM_ERROR_WRITE(M) write(stderrUnit,*) 'ERROR: '//M
+
+module ocn_pointwise_stats
+
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_dmpar
+ use mpas_timekeeping
+ use mpas_stream_manager
+
+ use ocn_constants
+ use ocn_diagnostics_routines
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_bootstrap_pointwise_stats, &
+ ocn_init_pointwise_stats, &
+ ocn_compute_pointwise_stats, &
+ ocn_restart_pointwise_stats, &
+ ocn_finalize_pointwise_stats
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ character (len=*), parameter :: AMPoolSuffix = 'FieldMapping'
+ character (len=*), parameter :: AMFieldNameSuffix = 'PointStats'
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_bootstrap_pointwise_stats
+!
+!> \brief Bootstrap pointwise stats AM
+!> \author Doug Jacobsen
+!> \date 02/03/2016
+!> \details
+!> This routine builds out the fields needed for the pointwise stats AM.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_bootstrap_pointwise_stats(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ character (len=*), parameter :: AMName = 'pointwiseStats'
+ character (len=StrKIND), pointer :: config_AM_output_stream
+
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: AMInputFields
+
+ type (field0DInteger), pointer :: ptr0DInt, ptr0DIntNew
+ type (field1DInteger), pointer :: ptr1DInt, ptr1DIntNew
+ type (field2DInteger), pointer :: ptr2DInt, ptr2DIntNew
+ type (field3DInteger), pointer :: ptr3DInt, ptr3DIntNew
+ type (field0DReal), pointer :: ptr0DReal, ptr0DRealNew
+ type (field1DReal), pointer :: ptr1DReal, ptr1DRealNew
+ type (field2DReal), pointer :: ptr2DReal, ptr2DRealNew
+ type (field3DReal), pointer :: ptr3DReal, ptr3DRealNew
+ type (field4DReal), pointer :: ptr4DReal, ptr4DRealNew
+ type (field5DReal), pointer :: ptr5DReal, ptr5DRealNew
+
+ type (mpas_pool_iterator_type) :: poolItr
+ type (mpas_pool_field_info_type) :: fieldInfo
+ character (len=StrKIND), pointer :: charPtr
+ character (len=StrKIND) :: fieldName
+ logical :: fieldActive
+
+ logical :: keepField
+ integer :: iConst, iDim, iDim2
+
+ integer, pointer :: nPoints
+
+ err = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_AM_' // trim(AMName) // '_output_stream', config_AM_output_stream)
+
+ call mpas_pool_create_pool(AMInputFields)
+
+ if ( config_AM_output_stream /= 'none' ) then
+ call mpas_stream_mgr_begin_iteration(domain % streamManager, config_AM_output_stream)
+ do while ( mpas_stream_mgr_get_next_field(domain % streamManager, config_AM_output_stream, fieldNAme, fieldActive) )
+ keepField = .false.
+ if ( fieldActive ) then
+ call mpas_pool_get_field_info(domain % blocklist % allFields, fieldName, fieldInfo)
+
+ if ( fieldInfo % fieldType == MPAS_POOL_REAL ) then
+ if ( fieldInfo % nDims == 0 ) then
+ ! Can't compute stats for 0D real...
+ else if ( fieldInfo % nDims == 1 ) then
+ block => domain % blocklist
+ do while ( associated(block) )
+ call mpas_pool_get_field(block % allFields, fieldName, ptr1DReal)
+ call mpas_pool_get_dimension(block % dimensions, 'nPoints', nPoints)
+
+ ! Check for nCells as a dimension, since that's all we can use for now...
+ do iDim = 1, fieldInfo % nDims
+ if ( trim(ptr1DReal % dimNames(iDim)) == 'nCells' ) then
+ keepField = .true.
+ end if
+ end do
+
+ if ( keepField ) then
+ ! Need to create a copy of the field, And change nCells with nPoints
+ allocate(ptr1DRealNew)
+ call mpas_duplicate_field(ptr1DReal, ptr1DRealNew)
+
+ ptr1DRealNew % fieldName = trim(ptr1DReal % fieldName) // trim(AMFieldNameSuffix)
+ PWAM_DEBUG_WRITE(' -- New Name: ' // trim(ptr1DRealNew % fieldName))
+
+ ! Change constituent names, if it's a var array
+ if ( ptr1DRealNew % isVarArray ) then
+ do iConst = 1, size(ptr1DRealNew % constituentNames)
+ ptr1DRealNew % constituentNames(iConst) = trim(ptr1DReal % constituentNames(iConst)) &
+ // trim(AMFieldNameSuffix)
+ end do
+ end if
+
+ ! Add input name to input name pool, with a value of the new name
+ call mpas_pool_add_config(AMInputFields, trim(ptr1DReal % fieldName), trim(ptr1DRealNew % fieldName))
+
+ ! Deallocate array, so we can resize it.
+ deallocate(ptr1DRealNew % array)
+
+ ! Swap out nCells with nPoints
+ do iDim = 1, fieldInfo % nDims
+ if ( trim(ptr1DRealNew % dimNames(iDim)) == 'nCells' ) then
+ PWAM_DEBUG_WRITE(' -- Changing nCells to nPoints')
+ ptr1DRealNew % dimNames(iDim) = 'nPoints'
+ ptr1DRealNew % dimSizes(iDim) = nPoints
+ end if
+ end do
+
+ ! Allocate new array size
+ allocate(ptr1DRealNew % array(ptr1DRealNew % dimSizes(1)))
+ ptr1DRealNew % array(:) = 0.0_RKIND
+
+ ! Mark the field as non-decomposed, since nPoints is not a decomposed dimension
+ ptr1DRealNew % isDecomposed = .false.
+
+ ! Link with previous block
+ if ( associated(block % prev) ) then
+ call mpas_pool_get_field(block % prev % allFields, ptr1DRealNew % fieldName, ptr1DReal)
+
+ ptr1DReal % next => ptr1DRealNew
+ ptr1DRealNew % prev => ptr1DReal
+ end if
+
+ ! Add field to allFields pool
+ call mpas_pool_add_field(block % allFields, ptr1DRealNew % fieldName, ptr1DRealNew)
+ end if
+ block => block % next
+ end do
+ else if ( fieldInfo % nDims == 2 ) then
+ block => domain % blocklist
+ do while ( associated(block) )
+ call mpas_pool_get_field(block % allFields, fieldName, ptr2DReal)
+ call mpas_pool_get_dimension(block % dimensions, 'nPoints', nPoints)
+
+ ! Check for nCells as a dimension, since that's all we can use for now...
+ do iDim = 1, fieldInfo % nDims
+ if ( trim(ptr2DReal % dimNames(iDim)) == 'nCells' ) then
+ keepField = .true.
+ end if
+ end do
+
+ if ( keepField ) then
+ ! Need to create a copy of the field, And change nCells with nPoints
+ allocate(ptr2DRealNew)
+ call mpas_duplicate_field(ptr2DReal, ptr2DRealNew)
+
+ ptr2DRealNew % fieldName = trim(ptr2DReal % fieldName) // trim(AMFieldNameSuffix)
+ PWAM_DEBUG_WRITE(' -- New Name: ' // trim(ptr2DRealNew % fieldName))
+
+ if ( ptr2DRealNew % isVarArray ) then
+ do iConst = 1, size(ptr2DRealNew % constituentNames)
+ ptr2DRealNew % constituentNames(iConst) = trim(ptr2DReal % constituentNames(iConst)) &
+ // trim(AMFieldNameSuffix)
+ end do
+ end if
+
+
+ ! Add input name to input name pool, with a value of the new name
+ call mpas_pool_add_config(AMInputFields, trim(ptr2DReal % fieldName), trim(ptr2DRealNew % fieldName))
+
+ ! Deallocate array, so we can resize it.
+ deallocate(ptr2DRealNew % array)
+
+ ! Swap out nCells with nPoints
+ do iDim = 1, fieldInfo % nDims
+ if ( trim(ptr2DRealNew % dimNames(iDim)) == 'nCells' ) then
+ PWAM_DEBUG_WRITE(' -- Changing nCells to nPoints')
+ ptr2DRealNew % dimNames(iDim) = 'nPoints'
+ ptr2DRealNew % dimSizes(iDim) = nPoints
+ end if
+ end do
+
+ ! Allocate new array size
+ allocate(ptr2DRealNew % array(ptr2DRealNew % dimSizes(1), ptr2DRealNew % dimSizes(2)))
+ ptr2DRealNew % array(:, :) = 0.0_RKIND
+
+ ! Mark the field as non-decomposed, since nPoints is not a decomposed dimension
+ ptr2DRealNew % isDecomposed = .false.
+
+ ! Link with previous block
+ if ( associated(block % prev) ) then
+ call mpas_pool_get_field(block % prev % allFields, ptr2DRealNew % fieldName, ptr2DReal)
+
+ ptr2DReal % next => ptr2DRealNew
+ ptr2DRealNew % prev => ptr2DReal
+ end if
+
+ ! Add field to allFields pool
+ call mpas_pool_add_field(block % allFields, ptr2DRealNew % fieldName, ptr2DRealNew)
+ end if
+ block => block % next
+ end do
+ else if ( fieldInfo % nDims == 3 ) then
+ block => domain % blocklist
+ do while ( associated(block) )
+ call mpas_pool_get_field(block % allFields, fieldName, ptr3DReal)
+ call mpas_pool_get_dimension(block % dimensions, 'nPoints', nPoints)
+
+ ! Check for nCells as a dimension, since that's all we can use for now...
+ do iDim = 1, fieldInfo % nDims
+ if ( trim(ptr3DReal % dimNames(iDim)) == 'nCells' ) then
+ keepField = .true.
+ end if
+ end do
+
+ if ( keepField ) then
+ ! Need to create a copy of the field, And change nCells with nPoints
+ allocate(ptr3DRealNew)
+ call mpas_duplicate_field(ptr3DReal, ptr3DRealNew)
+
+ ptr3DRealNew % fieldName = trim(ptr3DReal % fieldName) // trim(AMFieldNameSuffix)
+ PWAM_DEBUG_WRITE(' -- New Name: ' // trim(ptr3DRealNew % fieldName))
+
+ if ( ptr3DRealNew % isVarArray ) then
+ do iConst = 1, size(ptr3DRealNew % constituentNames)
+ ptr3DRealNew % constituentNames(iConst) = trim(ptr3DReal % constituentNames(iConst)) &
+ // trim(AMFieldNameSuffix)
+ end do
+ end if
+
+ ! Add input name to input name pool, with a value of the new name
+ call mpas_pool_add_config(AMInputFields, trim(ptr3DReal % fieldName), trim(ptr3DRealNew % fieldName))
+
+ ! Deallocate array, so we can resize it.
+ deallocate(ptr3DRealNew % array)
+
+ ! Swap out nCells with nPoints
+ do iDim = 1, fieldInfo % nDims
+ if ( trim(ptr3DRealNew % dimNames(iDim)) == 'nCells' ) then
+ PWAM_DEBUG_WRITE(' -- Changing nCells to nPoints')
+ ptr3DRealNew % dimNames(iDim) = 'nPoints'
+ ptr3DRealNew % dimSizes(iDim) = nPoints
+ end if
+ end do
+
+ ! Allocate new array size
+ allocate(ptr3DRealNew % array(ptr3DRealNew % dimSizes(1), ptr3DRealNew % dimSizes(2), &
+ ptr3DRealNew % dimSizes(3)))
+ ptr3DRealNew % array(:, :, :) = 0.0_RKIND
+
+ ! Mark the field as non-decomposed, since nPoints is not a decomposed dimension
+ ptr3DRealNew % isDecomposed = .false.
+
+ ! Link with previous block
+ if ( associated(block % prev) ) then
+ call mpas_pool_get_field(block % prev % allFields, ptr3DRealNew % fieldName, ptr3DReal)
+
+ ptr3DReal % next => ptr3DRealNew
+ ptr3DRealNew % prev => ptr3DReal
+ end if
+
+ ! Add field to allFields pool
+ call mpas_pool_add_field(block % allFields, ptr3DRealNew % fieldName, ptr3DRealNew)
+ end if
+ block => block % next
+ end do
+ else if ( fieldInfo % nDims == 4 ) then
+ block => domain % blocklist
+ do while ( associated(block) )
+ call mpas_pool_get_field(block % allFields, fieldName, ptr4DReal)
+ call mpas_pool_get_dimension(block % dimensions, 'nPoints', nPoints)
+
+ ! Check for nCells as a dimension, since that's all we can use for now...
+ do iDim = 1, fieldInfo % nDims
+ if ( trim(ptr4DReal % dimNames(iDim)) == 'nCells' ) then
+ keepField = .true.
+ end if
+ end do
+
+ if ( keepField ) then
+ ! Need to create a copy of the field, And change nCells with nPoints
+ allocate(ptr4DRealNew)
+ call mpas_duplicate_field(ptr4DReal, ptr4DRealNew)
+
+ ptr4DRealNew % fieldName = trim(ptr4DReal % fieldName) // trim(AMFieldNameSuffix)
+ PWAM_DEBUG_WRITE(' -- New Name: ' // trim(ptr4DRealNew % fieldName))
+
+ if ( ptr4DRealNew % isVarArray ) then
+ do iConst = 1, size(ptr4DRealNew % constituentNames)
+ ptr4DRealNew % constituentNames(iConst) = trim(ptr4DReal % constituentNames(iConst)) &
+ // trim(AMFieldNameSuffix)
+ end do
+ end if
+
+ ! Add input name to input name pool, with a value of the new name
+ call mpas_pool_add_config(AMInputFields, trim(ptr4DReal % fieldName), trim(ptr4DRealNew % fieldName))
+
+ ! Deallocate array, so we can resize it.
+ deallocate(ptr4DRealNew % array)
+
+ ! Swap out nCells with nPoints
+ do iDim = 1, fieldInfo % nDims
+ if ( trim(ptr4DRealNew % dimNames(iDim)) == 'nCells' ) then
+ PWAM_DEBUG_WRITE(' -- Changing nCells to nPoints')
+ ptr4DRealNew % dimNames(iDim) = 'nPoints'
+ ptr4DRealNew % dimSizes(iDim) = nPoints
+ end if
+ end do
+
+ ! Allocate new array size
+ allocate(ptr4DRealNew % array(ptr4DRealNew % dimSizes(1), ptr4DRealNew % dimSizes(2), &
+ ptr4DRealNew % dimSizes(3), ptr4DRealNew % dimSizes(4)))
+ ptr4DRealNew % array(:, :, :, :) = 0.0_RKIND
+
+ ! Mark the field as non-decomposed, since nPoints is not a decomposed dimension
+ ptr4DRealNew % isDecomposed = .false.
+
+ ! Link with previous block
+ if ( associated(block % prev) ) then
+ call mpas_pool_get_field(block % prev % allFields, ptr4DRealNew % fieldName, ptr4DReal)
+
+ ptr4DReal % next => ptr4DRealNew
+ ptr4DRealNew % prev => ptr4DReal
+ end if
+
+ ! Add field to allFields pool
+ call mpas_pool_add_field(block % allFields, ptr4DRealNew % fieldName, ptr4DRealNew)
+ end if
+ block => block % next
+ end do
+ else if ( fieldInfo % nDims == 5 ) then
+ block => domain % blocklist
+ do while ( associated(block) )
+ call mpas_pool_get_field(block % allFields, fieldName, ptr5DReal)
+ call mpas_pool_get_dimension(block % dimensions, 'nPoints', nPoints)
+
+ ! Check for nCells as a dimension, since that's all we can use for now...
+ do iDim = 1, fieldInfo % nDims
+ if ( trim(ptr5DReal % dimNames(iDim)) == 'nCells' ) then
+ keepField = .true.
+ end if
+ end do
+
+ if ( keepField ) then
+ ! Need to create a copy of the field, And change nCells with nPoints
+ allocate(ptr5DRealNew)
+ call mpas_duplicate_field(ptr5DReal, ptr5DRealNew)
+
+ ptr5DRealNew % fieldName = trim(ptr5DReal % fieldName) // trim(AMFieldNameSuffix)
+ PWAM_DEBUG_WRITE(' -- New Name: ' // trim(ptr5DRealNew % fieldName))
+
+ if ( ptr5DRealNew % isVarArray ) then
+ do iConst = 1, size(ptr5DRealNew % constituentNames)
+ ptr5DRealNew % constituentNames(iConst) = trim(ptr5DReal % constituentNames(iConst)) &
+ // trim(AMFieldNameSuffix)
+ end do
+ end if
+
+ ! Add input name to input name pool, with a value of the new name
+ call mpas_pool_add_config(AMInputFields, trim(ptr5DReal % fieldName), trim(ptr5DRealNew % fieldName))
+
+ ! Deallocate array, so we can resize it.
+ deallocate(ptr5DRealNew % array)
+
+ ! Swap out nCells with nPoints
+ do iDim = 1, fieldInfo % nDims
+ if ( trim(ptr5DRealNew % dimNames(iDim)) == 'nCells' ) then
+ PWAM_DEBUG_WRITE(' -- Changing nCells to nPoints')
+ ptr5DRealNew % dimNames(iDim) = 'nPoints'
+ ptr5DRealNew % dimSizes(iDim) = nPoints
+ end if
+ end do
+
+ ! Allocate new array size
+ allocate(ptr5DRealNew % array( ptr5DRealNew % dimSizes(1), ptr5DRealNew % dimSizes(2), &
+ ptr5DRealNew % dimSizes(3), ptr5DRealNew % dimSizes(4), &
+ ptr5DRealNew % dimSizes(5)))
+ ptr5DRealNew % array(:, :, :, :, :) = 0.0_RKIND
+
+ ! Mark the field as non-decomposed, since nPoints is not a decomposed dimension
+ ptr5DRealNew % isDecomposed = .false.
+
+ ! Link with previous block
+ if ( associated(block % prev) ) then
+ call mpas_pool_get_field(block % prev % allFields, ptr5DRealNew % fieldName, ptr5DReal)
+
+ ptr5DReal % next => ptr5DRealNew
+ ptr5DRealNew % prev => ptr5DReal
+ end if
+
+ ! Add field to allFields pool
+ call mpas_pool_add_field(block % allFields, ptr5DRealNew % fieldName, ptr5DRealNew)
+ end if
+ block => block % next
+ end do
+ end if
+ else if ( fieldInfo % fieldType == MPAS_POOL_INTEGER ) then
+ if ( fieldInfo % nDims == 0 ) then
+ ! Can't compute stats for 0D integer...
+ else if ( fieldInfo % nDims == 1 ) then
+ block => domain % blocklist
+ do while ( associated(block) )
+ call mpas_pool_get_field(block % allFields, fieldName, ptr1DInt)
+ call mpas_pool_get_dimension(block % dimensions, 'nPoints', nPoints)
+
+ ! Check for nCells as a dimension, since that's all we can use for now...
+ do iDim = 1, fieldInfo % nDims
+ if ( trim(ptr1DInt % dimNames(iDim)) == 'nCells' ) then
+ keepField = .true.
+ end if
+ end do
+
+ if ( keepField ) then
+ ! Need to create a copy of the field, And change nCells with nPoints
+ allocate(ptr1DIntNew)
+ call mpas_duplicate_field(ptr1DInt, ptr1DIntNew)
+
+ ptr1DIntNew % fieldName = trim(ptr1DInt % fieldName) // trim(AMFieldNameSuffix)
+ PWAM_DEBUG_WRITE(' -- New Name: ' // trim(ptr1DIntNew % fieldName))
+
+ if ( ptr1DIntNew % isVarArray ) then
+ do iConst = 1, size(ptr1DIntNew % constituentNames)
+ ptr1DIntNew % constituentNames(iConst) = trim(ptr1DInt % constituentNames(iConst)) &
+ // trim(AMFieldNameSuffix)
+ end do
+ end if
+
+ ! Add input name to input name pool, with a value of the new name
+ call mpas_pool_add_config(AMInputFields, trim(ptr1DInt % fieldName), trim(ptr1DIntNew % fieldName))
+
+ ! Deallocate array, so we can resize it.
+ deallocate(ptr1DIntNew % array)
+
+ ! Swap out nCells with nPoints
+ do iDim = 1, fieldInfo % nDims
+ if ( trim(ptr1DIntNew % dimNames(iDim)) == 'nCells' ) then
+ PWAM_DEBUG_WRITE(' -- Changing nCells to nPoints')
+ ptr1DIntNew % dimNames(iDim) = 'nPoints'
+ ptr1DIntNew % dimSizes(iDim) = nPoints
+ end if
+ end do
+
+ ! Allocate new array size
+ allocate(ptr1DIntNew % array(ptr1DIntNew % dimSizes(1)))
+ ptr1DIntNew % array(:) = 0
+
+ ! Mark the field as non-decomposed, since nPoints is not a decomposed dimension
+ ptr1DIntNew % isDecomposed = .false.
+
+ ! Link with previous block
+ if ( associated(block % prev) ) then
+ call mpas_pool_get_field(block % prev % allFields, ptr1DIntNew % fieldName, ptr1DInt)
+
+ ptr1DInt % next => ptr1DIntNew
+ ptr1DIntNew % prev => ptr1DInt
+ end if
+
+ ! Add field to allFields pool
+ call mpas_pool_add_field(block % allFields, ptr1DIntNew % fieldName, ptr1DIntNew)
+ end if
+ block => block % next
+ end do
+ else if ( fieldInfo % nDims == 2 ) then
+ block => domain % blocklist
+ do while ( associated(block) )
+ call mpas_pool_get_field(block % allFields, fieldName, ptr2DInt)
+ call mpas_pool_get_dimension(block % dimensions, 'nPoints', nPoints)
+
+ ! Check for nCells as a dimension, since that's all we can use for now...
+ do iDim = 1, fieldInfo % nDims
+ if ( trim(ptr2DInt % dimNames(iDim)) == 'nCells' ) then
+ keepField = .true.
+ end if
+ end do
+
+ if ( keepField ) then
+ ! Need to create a copy of the field, And change nCells with nPoints
+ allocate(ptr2DIntNew)
+ call mpas_duplicate_field(ptr2DInt, ptr2DIntNew)
+
+ ptr2DIntNew % fieldName = trim(ptr2DInt % fieldName) // trim(AMFieldNameSuffix)
+ PWAM_DEBUG_WRITE(' -- New Name: ' // trim(ptr2DIntNew % fieldName))
+
+ if ( ptr2DIntNew % isVarArray ) then
+ do iConst = 1, size(ptr2DIntNew % constituentNames)
+ ptr2DIntNew % constituentNames(iConst) = trim(ptr2DInt % constituentNames(iConst)) &
+ // trim(AMFieldNameSuffix)
+ end do
+ end if
+
+ ! Add input name to input name pool, with a value of the new name
+ call mpas_pool_add_config(AMInputFields, trim(ptr2DInt % fieldName), trim(ptr2DIntNew % fieldName))
+
+ ! Deallocate array, so we can resize it.
+ deallocate(ptr2DIntNew % array)
+
+ ! Swap out nCells with nPoints
+ do iDim = 1, fieldInfo % nDims
+ if ( trim(ptr2DIntNew % dimNames(iDim)) == 'nCells' ) then
+ PWAM_DEBUG_WRITE(' -- Changing nCells to nPoints')
+ ptr2DIntNew % dimNames(iDim) = 'nPoints'
+ ptr2DIntNew % dimSizes(iDim) = nPoints
+ end if
+ end do
+
+ ! Allocate new array size
+ allocate(ptr2DIntNew % array(ptr2DIntNew % dimSizes(1), ptr2DIntNew % dimSizes(2)))
+ ptr2DIntNew % array(:, :) = 0
+
+ ! Mark the field as non-decomposed, since nPoints is not a decomposed dimension
+ ptr2DIntNew % isDecomposed = .false.
+
+ ! Link with previous block
+ if ( associated(block % prev) ) then
+ call mpas_pool_get_field(block % prev % allFields, ptr2DIntNew % fieldName, ptr2DInt)
+
+ ptr2DInt % next => ptr2DIntNew
+ ptr2DIntNew % prev => ptr2DInt
+ end if
+
+ ! Add field to allFields pool
+ call mpas_pool_add_field(block % allFields, ptr2DIntNew % fieldName, ptr2DIntNew)
+ end if
+ block => block % next
+ end do
+ else if ( fieldInfo % nDims == 3 ) then
+ block => domain % blocklist
+ do while ( associated(block) )
+ call mpas_pool_get_field(block % allFields, fieldName, ptr3DInt)
+ call mpas_pool_get_dimension(block % dimensions, 'nPoints', nPoints)
+
+ ! Check for nCells as a dimension, since that's all we can use for now...
+ do iDim = 1, fieldInfo % nDims
+ if ( trim(ptr3DInt % dimNames(iDim)) == 'nCells' ) then
+ keepField = .true.
+ end if
+ end do
+
+ if ( keepField ) then
+ ! Need to create a copy of the field, And change nCells with nPoints
+ allocate(ptr3DIntNew)
+ call mpas_duplicate_field(ptr3DInt, ptr3DIntNew)
+
+ ptr3DIntNew % fieldName = trim(ptr3DInt % fieldName) // trim(AMFieldNameSuffix)
+ PWAM_DEBUG_WRITE(' -- New Name: ' // trim(ptr3DIntNew % fieldName))
+
+ if ( ptr3DIntNew % isVarArray ) then
+ do iConst = 1, size(ptr3DIntNew % constituentNames)
+ ptr3DIntNew % constituentNames(iConst) = trim(ptr3DInt % constituentNames(iConst)) &
+ // trim(AMFieldNameSuffix)
+ end do
+ end if
+
+ ! Add input name to input name pool, with a value of the new name
+ call mpas_pool_add_config(AMInputFields, trim(ptr3DInt % fieldName), trim(ptr3DIntNew % fieldName))
+
+ ! Deallocate array, so we can resize it.
+ deallocate(ptr3DIntNew % array)
+
+ ! Swap out nCells with nPoints
+ do iDim = 1, fieldInfo % nDims
+ if ( trim(ptr3DIntNew % dimNames(iDim)) == 'nCells' ) then
+ PWAM_DEBUG_WRITE(' -- Changing nCells to nPoints')
+ ptr3DIntNew % dimNames(iDim) = 'nPoints'
+ ptr3DIntNew % dimSizes(iDim) = nPoints
+ end if
+ end do
+
+ ! Allocate new array size
+ allocate(ptr3DIntNew % array(ptr3DIntNew % dimSizes(1), ptr3DIntNew % dimSizes(2), &
+ ptr3DIntNew % dimSizes(3)))
+ ptr3DIntNew % array(:, :, :) = 0
+
+ ! Mark the field as non-decomposed, since nPoints is not a decomposed dimension
+ ptr3DIntNew % isDecomposed = .false.
+
+ ! Link with previous block
+ if ( associated(block % prev) ) then
+ call mpas_pool_get_field(block % prev % allFields, ptr3DIntNew % fieldName, ptr3DInt)
+
+ ptr3DInt % next => ptr3DIntNew
+ ptr3DIntNew % prev => ptr3DInt
+ end if
+
+ ! Add field to allFields pool
+ call mpas_pool_add_field(block % allFields, ptr3DIntNew % fieldName, ptr3DIntNew)
+ end if
+ block => block % next
+ end do
+ end if
+ end if
+ end if
+ end do
+ end if
+
+ ! Swap fields in the stream
+ call mpas_pool_begin_iteration(AMInputFields)
+ do while ( mpas_pool_get_next_member(AMInputFields, poolItr) )
+ if ( poolItr % memberType == MPAS_POOL_CONFIG ) then
+ if ( poolItr % dataType == MPAS_POOL_CHARACTER ) then
+ call mpas_pool_get_config(AMInputFields, poolItr % memberName, charPtr)
+
+ call mpas_stream_mgr_remove_field(domain % streamManager, config_AM_output_stream, poolItr % memberName)
+ call mpas_stream_mgr_add_field(domain % streamManager, config_AM_output_stream, charPtr)
+ end if
+ end if
+ end do
+
+ call mpas_pool_add_subpool(domain % blocklist % structs, trim(AMName) // trim(AMPoolSuffix), AMInputFields)
+ nullify(AMInputFields)
+
+ end subroutine ocn_bootstrap_pointwise_stats!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_pointwise_stats
+!
+!> \brief Initialize MPAS-Ocean analysis member
+!> \author Mark Petersen
+!> \date Jan 2016
+!> \details
+!> This routine conducts all initializations required for the
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_pointwise_stats(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ type (dm_info) :: dminfo
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: pointPool
+
+ integer, pointer :: nCells, nCellsSolve, nPoints, nVertLevels
+ integer :: iCell, iPoint, i
+ integer, dimension(:), pointer :: indexToCellID,pointCellGlobalID, pointCellLocalID, indexToPointCellLocalID
+
+ err = 0
+
+ dminfo = domain % dminfo
+
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, 'nPoints', nPoints)
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, 'nVertLevels', nVertLevels)
+
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
+
+ call mpas_pool_get_subpool(block % structs, 'pointLocations', pointPool)
+ call mpas_pool_get_dimension(block % dimensions, 'nCells', nCells)
+ call mpas_pool_get_dimension(block % dimensions, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_array(meshPool, 'indexToCellID', indexToCellID)
+ call mpas_pool_get_array(pointPool, 'pointCellGlobalID', pointCellGlobalID)
+ call mpas_pool_get_array(pointPool, 'pointCellLocalID', pointCellLocalID)
+ call mpas_pool_get_array(pointPool, 'indexToPointCellLocalID', indexToPointCellLocalID)
+
+ pointCellLocalID = nCells + 1
+ indexToPointCellLocalID = 0
+
+ ! Initialize index arrays to record pointwise data.
+ i = 0
+ do iCell = 1,nCellsSolve
+ do iPoint = 1,nPoints
+ if (indexToCellID(iCell).eq.pointCellGlobalID(iPoint)) then
+ i = i + 1
+ indexToPointCellLocalID(i) = iPoint
+ pointCellLocalID(iPoint) = iCell
+ endif
+ end do
+ end do
+
+ block => block % next
+ end do
+
+ end subroutine ocn_init_pointwise_stats!}}}
+
+!***********************************************************************
+!
+! routine ocn_compute_pointwise_stats
+!
+!> \brief Compute MPAS-Ocean analysis member
+!> \author Mark Petersen
+!> \date Jan 2016
+!> \details
+!> This routine conducts all computation required for this
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_compute_pointwise_stats(domain, timeLevel, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(in) :: timeLevel
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ type (dm_info) :: dminfo
+ type (block_type), pointer :: block
+
+ integer, pointer :: nPoints, nCells
+ integer :: iPoint, i
+ integer, dimension(:), pointer :: pointCellGlobalID, pointCellLocalID, indexToPointCellLocalID
+
+ character (len=*), parameter :: AMName = 'pointwiseStats'
+
+ real (kind=RKIND), pointer :: ptr0DReal1, ptr0DReal2
+ real (kind=RKIND), dimension(:), pointer :: ptr1DReal1, ptr1DReal2
+ real (kind=RKIND), dimension(:, :), pointer :: ptr2DReal1, ptr2DReal2
+ real (kind=RKIND), dimension(:, :, :), pointer :: ptr3DReal1, ptr3DReal2
+ real (kind=RKIND), dimension(:, :, :, :), pointer :: ptr4DReal1, ptr4DReal2
+ real (kind=RKIND), dimension(:, :, :, :, :), pointer :: ptr5DReal1, ptr5DReal2
+
+ integer, pointer :: ptr0DInt1, ptr0DInt2
+ integer, dimension(:), pointer :: ptr1DInt1, ptr1DInt2
+ integer, dimension(:, :), pointer :: ptr2DInt1, ptr2DInt2
+ integer, dimension(:, :, :), pointer :: ptr3DInt1, ptr3DInt2
+
+ character (len=StrKIND), pointer :: mappedName
+ type (mpas_pool_type), pointer :: AMFieldMapping, pointPool
+ type (mpas_pool_iterator_type) :: poolItr
+ type (mpas_pool_field_info_type) :: fieldInfo
+ integer :: nElements
+ integer, dimension(:), pointer :: arrShape
+
+ real (kind=RKIND), dimension(:), pointer :: tempRealArrLocal, tempRealArrGlobal
+ integer, dimension(:), pointer :: tempIntArrLocal, tempIntArrGlobal
+ integer :: iElement, iDim1, iDim2, iDim3, iDim4, iDim5
+ integer :: fieldTimeLevel
+
+ err = 0
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, trim(AMName) // trim(AMPoolSuffix), AMFieldMapping)
+
+ call mpas_pool_begin_iteration(AMFieldMapping)
+
+ do while ( mpas_pool_get_next_member(AMFieldMapping, poolItr) )
+ if ( poolItr % memberType == MPAS_POOL_CONFIG ) then
+ call mpas_pool_get_config(AMFieldMapping, poolItr % memberName, mappedName)
+ call mpas_pool_get_field_info(domain % blocklist % allFields, poolItr % memberName, fieldInfo)
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, 'nPoints', nPoints)
+ nElements = 0
+
+ ! Set field time level, for retrieving the correct time level of the field later
+ if ( fieldInfo % nTimeLevels < timeLevel ) then
+ fieldTimeLevel = 1
+ else
+ fieldTimeLevel = timeLevel
+ end if
+
+ PWAM_DEBUG_WRITE(' -- Building pointer')
+ ! Get pointer to field in the first block, to store processor sum in
+ if ( fieldInfo % fieldType == MPAS_POOL_REAL ) then
+ if ( fieldInfo % nDims == 0 ) then
+ else if ( fieldInfo % nDims == 1 ) then
+ call mpas_pool_get_array(domain % blocklist % allFields, mappedName, ptr1DReal2)
+ ptr1DReal2(:) = 0.0_RKIND
+ nElements = size(ptr1DReal2)
+ else if ( fieldInfo % nDims == 2 ) then
+ call mpas_pool_get_array(domain % blocklist % allFields, mappedName, ptr2DReal2)
+ ptr2DReal2(:, :) = 0.0_RKIND
+ nElements = size(ptr2DReal2)
+ else if ( fieldInfo % nDims == 3 ) then
+ call mpas_pool_get_array(domain % blocklist % allFields, mappedName, ptr3DReal2)
+ ptr3DReal2(:, :, :) = 0.0_RKIND
+ nElements = size(ptr3DReal2)
+ else if ( fieldInfo % nDims == 4 ) then
+ call mpas_pool_get_array(domain % blocklist % allFields, mappedName, ptr4DReal2)
+ ptr4DReal2(:, :, :, :) = 0.0_RKIND
+ nElements = size(ptr4DReal2)
+ else if ( fieldInfo % nDims == 5 ) then
+ call mpas_pool_get_array(domain % blocklist % allFields, mappedName, ptr5DReal2)
+ ptr5DReal2(:, :, :, :, :) = 0.0_RKIND
+ nElements = size(ptr5DReal2)
+ end if
+ else if ( fieldInfo % fieldType == MPAS_POOL_INTEGER ) then
+ if ( fieldInfo % nDims == 0 ) then
+ else if ( fieldInfo % nDims == 1 ) then
+ call mpas_pool_get_array(domain % blocklist % allFields, mappedName, ptr1DInt2)
+ ptr1DInt2(:) = 0
+ nElements = size(ptr1DInt2)
+ else if ( fieldInfo % nDims == 2 ) then
+ call mpas_pool_get_array(domain % blocklist % allFields, mappedName, ptr2DInt2)
+ ptr2DInt2(:, :) = 0
+ nElements = size(ptr2DInt2)
+ else if ( fieldInfo % nDims == 3 ) then
+ call mpas_pool_get_array(domain % blocklist % allFields, mappedName, ptr3DInt2)
+ ptr3DInt2(:, :, :) = 0
+ nElements = size(ptr3DInt2)
+ end if
+ end if
+
+ ! Accumulate point data into the first block's field
+ PWAM_DEBUG_WRITE(' -- Accumulating field pointer ' // trim(poolItr % memberName))
+ block => domain % blocklist
+ do while ( associated(block) )
+ call mpas_pool_get_subpool(block % structs, 'pointLocations', pointPool)
+ call mpas_pool_get_dimension(block % dimensions, 'nCells', nCells)
+ call mpas_pool_get_array(pointPool, 'pointCellLocalID', pointCellLocalID)
+
+ if ( fieldInfo % fieldType == MPAS_POOL_REAL ) then
+ if ( fieldInfo % nDims == 0 ) then
+ ! Can't do 0D reals currently...
+ else if ( fieldInfo % nDims == 1 ) then
+ call mpas_pool_get_array(block % allFields, poolItr % memberName, ptr1DReal1, fieldTimeLevel)
+
+ do iPoint = 1, nPoints
+ if ( pointCellLocalID(iPoint) < nCells + 1 ) then
+ ptr1DReal2(iPoint) = ptr1DReal1( pointCellLocalID(iPoint) )
+ end if
+ end do
+ else if ( fieldInfo % nDims == 2 ) then
+ call mpas_pool_get_array(block % allFields, poolItr % memberName, ptr2DReal1, fieldTimeLevel)
+
+ do iPoint = 1, nPoints
+ if ( pointCellLocalID(iPoint) < nCells + 1 ) then
+ ptr2DReal2(:, iPoint) = ptr2DReal1(:, pointCellLocalID(iPoint) )
+ end if
+ end do
+ else if ( fieldInfo % nDims == 3 ) then
+ call mpas_pool_get_array(block % allFields, poolItr % memberName, ptr3DReal1, fieldTimeLevel)
+
+ do iPoint = 1, nPoints
+ if ( pointCellLocalID(iPoint) < nCells + 1 ) then
+ ptr3DReal2(:, :, iPoint) = ptr3DReal1(:, :, pointCellLocalID(iPoint) )
+ end if
+ end do
+ else if ( fieldInfo % nDims == 4 ) then
+ call mpas_pool_get_array(block % allFields, poolItr % memberName, ptr4DReal1, fieldTimeLevel)
+
+ do iPoint = 1, nPoints
+ if ( pointCellLocalID(iPoint) < nCells + 1 ) then
+ ptr4DReal2(:, :, :, iPoint) = ptr4DReal1(:, :, :, pointCellLocalID(iPoint) )
+ end if
+ end do
+ else if ( fieldInfo % nDims == 5 ) then
+ call mpas_pool_get_array(block % allFields, poolItr % memberName, ptr5DReal1, fieldTimeLevel)
+
+ do iPoint = 1, nPoints
+ if ( pointCellLocalID(iPoint) < nCells + 1 ) then
+ ptr5DReal2(:, :, :, :, iPoint) = ptr5DReal1(:, :, :, :, pointCellLocalID(iPoint) )
+ end if
+ end do
+ end if
+ else if ( fieldInfo % fieldType == MPAS_POOL_INTEGER ) then
+ if ( fieldInfo % nDims == 0 ) then
+ ! Can't do 0D ints currently...
+ else if ( fieldInfo % nDims == 1 ) then
+ call mpas_pool_get_array(block % allFields, poolItr % memberName, ptr1DInt1, fieldTimeLevel)
+
+ do iPoint = 1, nPoints
+ if ( pointCellLocalID(iPoint) < nCells + 1 ) then
+ ptr1DInt2(iPoint) = ptr1DInt1( pointCellLocalID(iPoint) )
+ end if
+ end do
+ else if ( fieldInfo % nDims == 2 ) then
+ call mpas_pool_get_array(block % allFields, poolItr % memberName, ptr2DInt1, fieldTimeLevel)
+
+ do iPoint = 1, nPoints
+ if ( pointCellLocalID(iPoint) < nCells + 1 ) then
+ ptr2DInt2(:, iPoint) = ptr2DInt1(:, pointCellLocalID(iPoint) )
+ end if
+ end do
+ else if ( fieldInfo % nDims == 3 ) then
+ call mpas_pool_get_array(block % allFields, poolItr % memberName, ptr3DInt1, fieldTimeLevel)
+
+ do iPoint = 1, nPoints
+ if ( pointCellLocalID(iPoint) < nCells + 1 ) then
+ ptr3DInt2(:, :, iPoint) = ptr3DInt1(:, :, pointCellLocalID(iPoint) )
+ end if
+ end do
+ end if
+ end if
+ block => block % next
+ end do
+
+ PWAM_DEBUG_WRITE(' -- Reducing field ' // trim(poolItr % memberName) // ' with nElements = ' COMMA nElements)
+ ! Need to sum field across processors
+ if ( fieldInfo % fieldType == MPAS_POOL_REAL ) then
+ allocate( tempRealArrLocal(nElements) )
+ allocate( tempRealArrGlobal(nElements) )
+ if ( fieldInfo % nDims == 0 ) then
+ else if ( fieldInfo % nDims == 1 ) then
+ ! Pack local array
+ iElement = 1
+ do iDim1 = 1, size(ptr1DReal2, dim=1)
+ tempRealArrLocal(iElement) = ptr1DReal2(iDim1)
+
+ iElement = iElement + 1
+ end do
+
+ call mpas_dmpar_sum_real_array(domain % dminfo, nElements, tempRealArrLocal, tempRealArrGlobal)
+
+ ! Unpack global array
+ iElement = 1
+ do iDim1 = 1, size(ptr1DReal2, dim=1)
+ ptr1DReal2(iDim1) = tempRealArrGlobal(iElement)
+ iElement = iElement + 1
+ end do
+ else if ( fieldInfo % nDims == 2 ) then
+ ! Pack local array
+ iElement = 1
+ do iDim1 = 1, size(ptr2DReal2, dim=2)
+ do iDim2 = 1, size(ptr2DReal2, dim=1)
+ tempRealArrLocal(iElement) = ptr2DReal2(iDim2, iDim1)
+
+ iElement = iElement + 1
+ end do
+ end do
+
+ call mpas_dmpar_sum_real_array(domain % dminfo, nElements, tempRealArrLocal, tempRealArrGlobal)
+
+ ! Unpack global array
+ iElement = 1
+ do iDim1 = 1, size(ptr2DReal2, dim=2)
+ do iDim2 = 1, size(ptr2DReal2, dim=1)
+ ptr2DReal2(iDim2, iDim1) = tempRealArrGlobal(iElement)
+ iElement = iElement + 1
+ end do
+ end do
+ else if ( fieldInfo % nDims == 3 ) then
+ ! Pack local array
+ iElement = 1
+ do iDim1 = 1, size(ptr3DReal2, dim=3)
+ do iDim2 = 1, size(ptr3DReal2, dim=2)
+ do iDim3 = 1, size(ptr3DReal2, dim=1)
+ tempRealArrLocal(iElement) = ptr3DReal2(iDim3, iDim2, iDim1)
+
+ iElement = iElement + 1
+ end do
+ end do
+ end do
+
+ call mpas_dmpar_sum_real_array(domain % dminfo, nElements, tempRealArrLocal, tempRealArrGlobal)
+
+ ! Unpack global array
+ iElement = 1
+ do iDim1 = 1, size(ptr3DReal2, dim=3)
+ do iDim2 = 1, size(ptr3DReal2, dim=2)
+ do iDim3 = 1, size(ptr3DReal2, dim=1)
+ ptr3DReal2(iDim3, iDim2, iDim1) = tempRealArrGlobal(iElement)
+ iElement = iElement + 1
+ end do
+ end do
+ end do
+ else if ( fieldInfo % nDims == 4 ) then
+ ! Pack local array
+ iElement = 1
+ do iDim1 = 1, size(ptr4DReal2, dim=4)
+ do iDim2 = 1, size(ptr4DReal2, dim=3)
+ do iDim3 = 1, size(ptr4DReal2, dim=2)
+ do iDim4 = 1, size(ptr4DReal2, dim=1)
+ tempRealArrLocal(iElement) = ptr4DReal2(iDim4, iDim3, iDim2, iDim1)
+
+ iElement = iElement + 1
+ end do
+ end do
+ end do
+ end do
+
+ call mpas_dmpar_sum_real_array(domain % dminfo, nElements, tempRealArrLocal, tempRealArrGlobal)
+
+ ! Unpack global array
+ iElement = 1
+ do iDim1 = 1, size(ptr4DReal2, dim=4)
+ do iDim2 = 1, size(ptr4DReal2, dim=3)
+ do iDim3 = 1, size(ptr4DReal2, dim=2)
+ do iDim4 = 1, size(ptr4DReal2, dim=1)
+ ptr4DReal2(iDim4, iDim3, iDim2, iDim1) = tempRealArrGlobal(iElement)
+ iElement = iElement + 1
+ end do
+ end do
+ end do
+ end do
+ else if ( fieldInfo % nDims == 5 ) then
+ ! Pack local array
+ iElement = 1
+ do iDim1 = 1, size(ptr5DReal2, dim=5)
+ do iDim2 = 1, size(ptr5DReal2, dim=4)
+ do iDim3 = 1, size(ptr5DReal2, dim=3)
+ do iDim4 = 1, size(ptr5DReal2, dim=2)
+ do iDim5 = 1, size(ptr5DReal2, dim=1)
+ tempRealArrLocal(iElement) = ptr5DReal2(iDim5, iDim4, iDim3, iDim2, iDim1)
+
+ iElement = iElement + 1
+ end do
+ end do
+ end do
+ end do
+ end do
+
+ call mpas_dmpar_sum_real_array(domain % dminfo, nElements, tempRealArrLocal, tempRealArrGlobal)
+
+ ! Unpack global array
+ iElement = 1
+ do iDim1 = 1, size(ptr5DReal2, dim=5)
+ do iDim2 = 1, size(ptr5DReal2, dim=4)
+ do iDim3 = 1, size(ptr5DReal2, dim=3)
+ do iDim4 = 1, size(ptr5DReal2, dim=2)
+ do iDim5 = 1, size(ptr5DReal2, dim=1)
+ ptr5DReal2(iDim5, iDim4, iDim3, iDim2, iDim1) = tempRealArrGlobal(iElement)
+ iElement = iElement + 1
+ end do
+ end do
+ end do
+ end do
+ end do
+ end if
+ deallocate( tempRealArrLocal )
+ deallocate( tempRealArrGlobal )
+ else if ( fieldInfo % fieldType == MPAS_POOL_INTEGER ) then
+ allocate( tempIntArrLocal(nElements) )
+ allocate( tempIntArrGlobal(nElements) )
+ if ( fieldInfo % nDims == 0 ) then
+ else if ( fieldInfo % nDims == 1 ) then
+ ! Pack local array
+ iElement = 1
+ do iDim1 = 1, size(ptr1DInt2, dim=1)
+ tempIntArrLocal(iElement) = ptr1DInt2(iDim1)
+
+ iElement = iElement + 1
+ end do
+
+ call mpas_dmpar_sum_int_array(domain % dminfo, nElements, tempIntArrLocal, tempIntArrGlobal)
+
+ ! Unpack global array
+ iElement = 1
+ do iDim1 = 1, size(ptr1DInt2, dim=1)
+ ptr1DInt2(iDim1) = tempIntArrGlobal(iElement)
+ iElement = iElement + 1
+ end do
+ else if ( fieldInfo % nDims == 2 ) then
+ ! Pack local array
+ iElement = 1
+ do iDim1 = 1, size(ptr2DInt2, dim=2)
+ do iDim2 = 1, size(ptr2DInt2, dim=1)
+ tempIntArrLocal(iElement) = ptr2DInt2(iDim2, iDim1)
+
+ iElement = iElement + 1
+ end do
+ end do
+
+ call mpas_dmpar_sum_int_array(domain % dminfo, nElements, tempIntArrLocal, tempIntArrGlobal)
+
+ ! Unpack global array
+ iElement = 1
+ do iDim1 = 1, size(ptr2DInt2, dim=2)
+ do iDim2 = 1, size(ptr2DInt2, dim=1)
+ ptr2DInt2(iDim2, iDim1) = tempIntArrGlobal(iElement)
+ iElement = iElement + 1
+ end do
+ end do
+ else if ( fieldInfo % nDims == 3 ) then
+ ! Pack local array
+ iElement = 1
+ do iDim1 = 1, size(ptr3DInt2, dim=3)
+ do iDim2 = 1, size(ptr3DInt2, dim=2)
+ do iDim3 = 1, size(ptr3DInt2, dim=1)
+ tempIntArrLocal(iElement) = ptr3DInt2(iDim3, iDim2, iDim1)
+
+ iElement = iElement + 1
+ end do
+ end do
+ end do
+
+ call mpas_dmpar_sum_int_array(domain % dminfo, nElements, tempIntArrLocal, tempIntArrGlobal)
+
+ ! Unpack global array
+ iElement = 1
+ do iDim1 = 1, size(ptr3DInt2, dim=3)
+ do iDim2 = 1, size(ptr3DInt2, dim=2)
+ do iDim3 = 1, size(ptr3DInt2, dim=1)
+ ptr3DInt2(iDim3, iDim2, iDim1) = tempIntArrGlobal(iElement)
+ iElement = iElement + 1
+ end do
+ end do
+ end do
+ end if
+ deallocate( tempIntArrLocal )
+ deallocate( tempIntArrGlobal )
+ end if
+ PWAM_DEBUG_WRITE(' -- Completed field ' // trim(poolItr % memberName))
+ end if
+ end do
+
+ end subroutine ocn_compute_pointwise_stats!}}}
+
+!***********************************************************************
+!
+! routine ocn_restart_pointwise_stats
+!
+!> \brief Save restart for MPAS-Ocean analysis member
+!> \author Mark Petersen
+!> \date Jan 2016
+!> \details
+!> This routine conducts computation required to save a restart state
+!> for the MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_restart_pointwise_stats(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ end subroutine ocn_restart_pointwise_stats!}}}
+
+!***********************************************************************
+!
+! routine ocn_finalize_pointwise_stats
+!
+!> \brief Finalize MPAS-Ocean analysis member
+!> \author Mark Petersen
+!> \date Jan 2016
+!> \details
+!> This routine conducts all finalizations required for this
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_finalize_pointwise_stats(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ end subroutine ocn_finalize_pointwise_stats!}}}
+
+end module ocn_pointwise_stats
+
+! vim: foldmethod=marker
diff --git a/src/core_ocean/analysis_members/mpas_ocn_regional_stats.F b/src/core_ocean/analysis_members/mpas_ocn_regional_stats.F
new file mode 100644
index 0000000000..e59c9bf33d
--- /dev/null
+++ b/src/core_ocean/analysis_members/mpas_ocn_regional_stats.F
@@ -0,0 +1,2731 @@
+! Copyright (c) 2015, 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
+!
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! ocn_regional_stats
+!
+!> \brief MPAS ocean analysis core member: regional_stats
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> Flexible regional averaging, mins, and maxes of fields.
+!-----------------------------------------------------------------------
+module ocn_regional_stats
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_dmpar
+ use mpas_timekeeping
+ use mpas_stream_manager
+
+ use ocn_constants
+ use ocn_diagnostics_routines
+
+ implicit none
+ private
+ save
+
+ ! Public parameters
+ !--------------------------------------------------------------------
+
+ ! Public member functions
+ !--------------------------------------------------------------------
+ public :: &
+ ocn_init_regional_stats, &
+ ocn_compute_regional_stats, &
+ ocn_restart_regional_stats, &
+ ocn_finalize_regional_stats
+
+ ! Private module variables
+ !--------------------------------------------------------------------
+
+ type regional_variable_type
+ ! state per instance variable, stored in framework
+ character (len=StrKIND), pointer :: input_name
+ integer, pointer :: has_vertical
+
+ ! generated on every instance call
+ character (len=StrKIND), dimension(:), allocatable :: output_names
+ end type regional_variable_type
+
+ type regional_type
+ ! state per instance, stored in framework
+ integer, pointer :: number_of_variables
+
+ integer, pointer :: operation
+ integer, pointer :: region_element
+ integer, pointer :: function_oned
+ integer, pointer :: function_twod
+ integer, pointer :: group_index
+
+ ! looked up on every instance call
+ character (len=StrKIND), pointer :: weights_oned
+ character (len=StrKIND), pointer :: weights_twod
+ integer, dimension(:), pointer :: num_regions_per
+ integer, dimension(:, :), pointer :: groups
+ character (len=StrKIND), pointer :: vertical_mask, vertical_dim
+
+ ! generated on every instance call
+ character (len=StrKIND) :: masking_field
+
+ ! allocated on every instance call
+ type (regional_variable_type), dimension(:), allocatable :: variables
+ character (len=StrKIND), dimension(:), allocatable :: count_zerod_names
+ character (len=StrKIND), dimension(:), allocatable :: weight_zerod_names
+ character (len=StrKIND), dimension(:), allocatable :: count_oned_names
+ character (len=StrKIND), dimension(:), allocatable :: weight_oned_names
+ end type regional_type
+
+ ! enum of ops and types
+ integer, parameter :: AVG_OP = 1
+ integer, parameter :: MIN_OP = 2
+ integer, parameter :: MAX_OP = 3
+
+ integer, parameter :: ID_FUNC = 11
+ integer, parameter :: MUL_FUNC = 12
+
+ integer, parameter :: CELL_REGION = 101
+ integer, parameter :: VERTEX_REGION = 102
+
+ ! namelist operators and identifiers for unique names
+ character (len=3), parameter :: AVG_TOKEN = 'avg'
+ character (len=3), parameter :: MIN_TOKEN = 'min'
+ character (len=3), parameter :: MAX_TOKEN = 'max'
+
+ character (len=StrKIND), parameter :: COUNT_TOKEN = 'count'
+ character (len=StrKIND), parameter :: WEIGHT_TOKEN = 'weight'
+ character (len=StrKIND), parameter :: ZEROD_TOKEN = '0D'
+ character (len=StrKIND), parameter :: ONED_TOKEN = '1D'
+
+ ! namelist operators
+ character (len=2), parameter :: ID_TOKEN = 'id'
+ character (len=3), parameter :: MUL_TOKEN = 'mul'
+
+ ! namelist operators and identifiers for mask-struct data
+ character (len=5), parameter :: CELL_TOKEN = 'cell'
+ character (len=8), parameter :: VERTEX_TOKEN = 'vertex'
+
+ ! camel case token for mask field names
+ character (len=5), parameter :: CELL_CAMEL = 'Cell'
+ character (len=8), parameter :: VERTEX_CAMEL = 'Vertex'
+
+ ! canonical dimension names
+ character (len=6), parameter :: CELL_DIM = 'nCells'
+ character (len=9), parameter :: VERTEX_DIM = 'nVertices'
+
+ ! canonical solve names
+ character (len=11), parameter :: CELL_SOLVE = 'nCellsSolve'
+ character (len=14), parameter :: VERTEX_SOLVE = 'nVerticesSolve'
+
+ ! canonical mins and maxes
+ real (kind=RKIND), parameter :: DEFAULT_MPAS_MIN_VALUE = -1.0e34_RKIND
+ real (kind=RKIND), parameter :: DEFAULT_MPAS_MAX_VALUE = 1.0e34_RKIND
+
+ ! none
+ character (len=4), parameter :: NONE_TOKEN = 'none'
+
+ ! memory names for duplication
+ character (len=StrKIND), parameter :: REGIONAL_STATS_POOL = &
+ 'regionalStatsAM'
+ character (len=StrKIND), parameter :: ONE_INTEGER_MEMORY = &
+ 'regionalStatsOneInteger'
+ character (len=StrKIND), parameter :: ONE_STRING_MEMORY = &
+ 'regionalStatsOneString'
+ character (len=StrKIND), parameter :: ONE_REAL_MEMORY = &
+ 'regionalStatsOneReal'
+
+ ! mask-struct array names and suffixes
+ character (len=StrKIND), parameter :: MASK_POOL_NAME = 'regions'
+ character (len=StrKIND), parameter :: MASK_DATA_PREFIX = 'region'
+ character (len=StrKIND), parameter :: MASK_DATA_SUFFIX = 'Masks'
+ character (len=StrKIND), parameter :: GROUP_DATA_NAME = &
+ 'regionsInGroup'
+ character (len=StrKIND), parameter :: REGIONS_PER_NAME = &
+ 'nRegionsInGroup'
+ character (len=StrKIND), parameter :: REGION_NAMES_NAME = &
+ 'regionNames'
+ character (len=StrKIND), parameter :: GROUP_NAMES_NAME = &
+ 'regionGroupNames'
+
+ ! mask dimension names
+ character (len=StrKIND), parameter :: NUM_REGIONS_SUFFIX = 'nRegions'
+ character (len=StrKIND), parameter :: NUM_GROUPS_SUFFIX = 'nRegionGroups'
+ character (len=StrKIND), parameter :: MAX_REGIONS_SUFFIX = &
+ 'maxRegionsInGroup'
+
+ ! prefixes
+ character (len=StrKIND), parameter :: CONFIG_PREFIX = &
+ 'config_AM_regionalStats'
+ character (len=StrKIND), parameter :: FRAMEWORK_PREFIX = 'regionalStats'
+
+ ! namelist-only suffixes
+ character (len=StrKIND), parameter :: OUTPUT_STREAM_SUFFIX = '_output_stream'
+ character (len=StrKIND), parameter :: WEIGHTS_ONED_SUFFIX = &
+ '_1d_weighting_field'
+ character (len=StrKIND), parameter :: WEIGHTS_TWOD_SUFFIX = &
+ '_2d_weighting_field'
+ character (len=StrKIND), parameter :: REGION_GROUP_SUFFIX = '_region_group'
+ character (len=StrKIND), parameter :: INPUT_STREAM_SUFFIX = '_input_stream'
+ character (len=StrKIND), parameter :: RESTART_STREAM_SUFFIX = &
+ '_restart_stream'
+ character (len=StrKIND), parameter :: VERTICAL_MASK_SUFFIX = &
+ '_vertical_mask'
+ character (len=StrKIND), parameter :: VERTICAL_DIM_SUFFIX = &
+ '_vertical_dimension'
+
+ ! namelist and instance suffixes
+ character (len=StrKIND), parameter :: OPERATION_SUFFIX = '_operation'
+ character (len=StrKIND), parameter :: REGION_TYPE_SUFFIX = '_region_type'
+ character (len=StrKIND), parameter :: FUNCTION_ONED_SUFFIX = &
+ '_1d_weighting_function'
+ character (len=StrKIND), parameter :: FUNCTION_TWOD_SUFFIX = &
+ '_2d_weighting_function'
+
+ ! instance-only suffixes
+ character (len=StrKIND), parameter :: INPUT_NAME_SUFFIX = '_input_name'
+ character (len=StrKIND), parameter :: NUMBER_OF_VARIABLES_SUFFIX = &
+ '_number_of_variables'
+ character (len=StrKIND), parameter :: HAS_VERTICAL_SUFFIX = '_has_vertical'
+
+ ! error message
+ character (len=StrKIND), parameter :: CURRENT_CORE_NAME = 'MPAS-Ocean'
+
+!***********************************************************************
+contains
+
+
+
+!***********************************************************************
+! routine ocn_init_regional_stats
+!
+!> \brief Initialize MPAS-Ocean analysis member
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> This routine conducts all initializations required for the
+!> MPAS-Ocean analysis member.
+!-----------------------------------------------------------------------
+subroutine ocn_init_regional_stats(domain, err)!{{{
+ ! input variables
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+
+ ! output variables
+ integer, intent(out) :: err !< Output: error flag
+
+ ! local variables
+ integer :: v
+ character (len=StrKIND) :: instance ! TODO intent(in)
+
+ ! start procedure
+ err = 0
+
+ ! TODO placeholder for some unique ID if this code is replicated
+ instance = '' ! TODO to be passed in
+
+ ! create all of the state for this instance
+ call start_state(domain, instance, err)
+
+end subroutine ocn_init_regional_stats!}}}
+
+
+
+!***********************************************************************
+! routine ocn_compute_regional_stats
+!
+!> \brief Compute MPAS-Ocean analysis member
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> This routine conducts all computation required for this
+!> MPAS-Ocean analysis member.
+!-----------------------------------------------------------------------
+subroutine ocn_compute_regional_stats(domain, timeLevel, err)!{{{
+ ! input variables
+ integer, intent(in) :: timeLevel
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+
+ ! output variables
+ integer, intent(out) :: err !< Output: error flag
+
+ ! local variables
+ character (len=StrKIND) :: instance ! TODO intent(in)
+ integer :: v, last, m, b, i
+ integer, pointer :: levels, solve
+ type (regional_type) :: regions
+ integer, pointer :: count_sum_zerod
+ integer, dimension(:), pointer :: count_sum_oned
+ real (kind=RKIND), pointer :: weight_sum_zerod
+ real (kind=RKIND), dimension(:), pointer :: weight_sum_oned
+ type (block_type), pointer :: block
+ integer, dimension(:,:), pointer :: mask, vertical_mask
+ type (mpas_pool_type), pointer :: amPool, maskPool
+ real (kind=RKIND), dimension(:), pointer :: oned_weights
+ real (kind=RKIND), dimension(:,:), pointer :: twod_weights
+ logical :: active_vertical
+ real (kind=RKIND) :: real_copy
+ integer :: int_copy
+ real (kind=RKIND), dimension(:), allocatable :: real_vert_copy
+ integer, dimension(:), allocatable :: int_vert_copy
+
+ ! start procedure
+ err = 0
+
+ ! TODO placeholder for some unique ID if this code is replicated
+ instance = '' ! TODO to be passed in
+
+ ! get all of the state for this instance to be able to compute
+ call get_state(domain, instance, regions)
+
+ !
+ ! calculate all of the counts and weights at the beginning
+ call mpas_pool_get_subpool(domain % blocklist % structs, &
+ REGIONAL_STATS_POOL, amPool)
+
+ active_vertical = (trim(regions % vertical_dim) /= trim(NONE_TOKEN))
+ if (active_vertical) then
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, &
+ regions % vertical_dim, levels)
+ allocate(real_vert_copy(levels))
+ allocate(int_vert_copy(levels))
+ end if
+
+ last = regions % num_regions_per(regions % group_index)
+ do b = 1, last
+ m = regions % groups(b, regions % group_index)
+
+ ! get the different target arrays
+ ! count 0d
+ call mpas_pool_get_array(amPool, &
+ regions % count_zerod_names(b), count_sum_zerod, 1)
+ count_sum_zerod = 0
+
+ ! weight 0d
+ if (regions % function_oned == MUL_FUNC) then
+ call mpas_pool_get_array(amPool, &
+ regions % weight_zerod_names(b), weight_sum_zerod, 1)
+ weight_sum_zerod = 0
+ end if
+
+ ! count 1d
+ if (active_vertical) then
+ call mpas_pool_get_array(amPool, &
+ regions % count_oned_names(b), count_sum_oned, 1)
+ count_sum_oned = 0
+
+ ! weight 1d
+ if (regions % function_twod == MUL_FUNC) then
+ call mpas_pool_get_array(amPool, &
+ regions % weight_oned_names(b), weight_sum_oned, 1)
+ weight_sum_oned = 0
+ end if
+ end if
+
+ ! iterate over all the blocks and sum mask counts and weights
+ block => domain % blocklist
+ do while (associated(block))
+ ! get the mask
+ call mpas_pool_get_subpool(block % structs, MASK_POOL_NAME, maskPool)
+ call mpas_pool_get_array(maskPool, regions % masking_field, mask, 1)
+
+ ! get the dimension
+ if (regions % region_element == CELL_REGION) then
+ call mpas_pool_get_dimension(block % dimensions, CELL_SOLVE, solve)
+ else
+ call mpas_pool_get_dimension(block % dimensions, VERTEX_SOLVE, solve)
+ end if
+
+ ! create the counts and weights
+ do i = 1, solve
+ count_sum_zerod = count_sum_zerod + mask(m, i)
+ end do
+
+ if (regions % function_oned == MUL_FUNC) then
+ call mpas_pool_get_array(block % allFields, &
+ regions % weights_oned, oned_weights, 1)
+
+ do i = 1, solve
+ weight_sum_zerod = weight_sum_zerod + mask(m, i) * oned_weights(i)
+ end do
+ end if
+
+ if (active_vertical) then
+ call mpas_pool_get_array(block % allFields, &
+ regions % vertical_mask, vertical_mask, 1)
+
+ do i = 1, solve
+ do v = 1, levels
+ count_sum_oned(v) = count_sum_oned(v) + &
+ vertical_mask(v, i) * mask(m, i)
+ end do
+ end do
+
+ if (regions % function_twod == MUL_FUNC) then
+ call mpas_pool_get_array(block % allFields, &
+ regions % weights_twod, twod_weights, 1)
+
+ do i = 1, solve
+ do v = 1, levels
+ weight_sum_oned(v) = weight_sum_oned(v) + &
+ vertical_mask(v, i) * mask(m, i) * twod_weights(v, i)
+ end do
+ end do
+ end if
+ end if
+
+ block => block % next
+ end do
+
+ ! reduce the weights and sums
+ call mpas_dmpar_sum_int(domain % dminfo, count_sum_zerod, int_copy)
+ count_sum_zerod = int_copy
+
+ if (regions % function_oned == MUL_FUNC) then
+ call mpas_dmpar_sum_real(domain % dminfo, weight_sum_zerod, real_copy)
+ weight_sum_zerod = real_copy
+ end if
+
+ if (active_vertical) then
+ call mpas_dmpar_sum_int_array(domain % dminfo, size(count_sum_oned), &
+ count_sum_oned, int_vert_copy)
+ count_sum_oned = int_vert_copy
+
+ if (regions % function_twod == MUL_FUNC) then
+ call mpas_dmpar_sum_real_array( &
+ domain % dminfo, size(weight_sum_oned), &
+ weight_sum_oned, real_vert_copy)
+ weight_sum_oned = real_vert_copy
+ end if
+ end if
+
+ end do
+
+ ! free up memory
+ if (active_vertical) then
+ deallocate(int_vert_copy)
+ deallocate(real_vert_copy)
+ end if
+
+ ! do all region reductions for each variable
+ do v = 1, regions % number_of_variables
+ call typed_operate(domain % dminfo, domain % blocklist, &
+ regions, regions % variables(v))
+ end do
+
+ ! clean up the instance memory
+ do v = 1, regions % number_of_variables
+ deallocate(regions % variables(v) % output_names)
+ end do
+ deallocate(regions % variables)
+ deallocate(regions % count_zerod_names)
+ deallocate(regions % weight_zerod_names)
+ deallocate(regions % count_oned_names)
+ deallocate(regions % weight_oned_names)
+end subroutine ocn_compute_regional_stats!}}}
+
+
+
+!***********************************************************************
+! routine ocn_restart_regional_stats
+!
+!> \brief Save restart for MPAS-Ocean analysis member
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> This routine conducts computation required to save a restart state
+!> for the MPAS-Ocean analysis member.
+!-----------------------------------------------------------------------
+subroutine ocn_restart_regional_stats(domain, err)!{{{
+ ! input variables
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+
+ ! output variables
+ integer, intent(out) :: err !< Output: error flag
+
+ ! local variables
+
+ ! start procedure
+ err = 0
+
+end subroutine ocn_restart_regional_stats!}}}
+
+
+
+!***********************************************************************
+! routine ocn_finalize_regional_stats
+!
+!> \brief Finalize MPAS-Ocean analysis member
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> This routine conducts all finalizations required for this
+!> MPAS-Ocean analysis member.
+!-----------------------------------------------------------------------
+subroutine ocn_finalize_regional_stats(domain, err)!{{{
+ ! input variables
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+
+ ! output variables
+ integer, intent(out) :: err !< Output: error flag
+
+ ! local variables
+
+ ! start procedure
+ err = 0
+
+end subroutine ocn_finalize_regional_stats!}}}
+
+!
+! local subroutines
+!
+
+!***********************************************************************
+! routine add_new_string
+!
+!> \brief Allocate an string in the MPAS framework for this AM
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> Allocate a new integer in the AM pool and return a pointer to it.
+!-----------------------------------------------------------------------
+subroutine add_new_string(all_fields, inpool, outpool, field_name, target_ptr)
+ ! input variables
+ character (len=StrKIND) :: field_name
+
+ ! input/output variables
+ type (mpas_pool_type), pointer, intent(inout) :: all_fields, inpool, outpool
+
+ ! output variables
+ character (len=StrKIND), pointer, optional :: target_ptr
+
+ ! local variables
+ type (field0DChar), pointer :: srcString, dstString
+
+ call mpas_pool_get_field(inpool, ONE_STRING_MEMORY, srcString, 1)
+ call mpas_duplicate_field(srcString, dstString)
+ dstString % fieldName = field_name
+ allocate(dstString % attLists(1))
+ call mpas_pool_add_field(outpool, dstString % fieldName, dstString)
+ call mpas_pool_add_field(all_fields, dstString % fieldName, dstString)
+ if (present(target_ptr)) then
+ call mpas_pool_get_array(outpool, dstString % fieldName, target_ptr, 1)
+ end if
+end subroutine add_new_string
+
+
+
+!***********************************************************************
+! routine add_new_integer
+!
+!> \brief Allocate an integer in the MPAS framework for this AM
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> Allocate a new integer in the AM pool and return a pointer to it.
+!-----------------------------------------------------------------------
+subroutine add_new_integer(all_fields, inpool, outpool, field_name, target_ptr)
+ ! input variables
+ character (len=StrKIND) :: field_name
+
+ ! input/output variables
+ type (mpas_pool_type), pointer, intent(inout) :: all_fields, inpool, outpool
+
+ ! output variables
+ integer, pointer, optional :: target_ptr
+
+ ! local variables
+ type (field0DInteger), pointer :: srcInteger, dstInteger
+
+ call mpas_pool_get_field(inpool, ONE_INTEGER_MEMORY, srcInteger, 1)
+ call mpas_duplicate_field(srcInteger, dstInteger)
+ dstInteger % fieldName = field_name
+ allocate(dstInteger % attLists(1))
+ call mpas_pool_add_field(outpool, dstInteger % fieldName, dstInteger)
+ call mpas_pool_add_field(all_fields, dstInteger % fieldName, dstInteger)
+ if (present(target_ptr)) then
+ call mpas_pool_get_array(outpool, dstInteger % fieldName, target_ptr, 1)
+ end if
+end subroutine add_new_integer
+
+
+
+!***********************************************************************
+! routine add_new_real
+!
+!> \brief Allocate an real in the MPAS framework for this AM
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> Allocate a new real in the AM pool and return a pointer to it.
+!-----------------------------------------------------------------------
+subroutine add_new_real(all_fields, inpool, outpool, field_name, target_ptr)
+ ! input variables
+ character (len=StrKIND) :: field_name
+
+ ! input/output variables
+ type (mpas_pool_type), pointer, intent(inout) :: all_fields, inpool, outpool
+
+ ! output variables
+ real (kind=RKIND), pointer, optional :: target_ptr
+
+ ! local variables
+ type (field0DReal), pointer :: srcReal, dstReal
+
+ call mpas_pool_get_field(inpool, ONE_REAL_MEMORY, srcReal, 1)
+ call mpas_duplicate_field(srcReal, dstReal)
+ dstReal % fieldName = field_name
+ allocate(dstReal % attLists(1))
+ call mpas_pool_add_field(outpool, dstReal % fieldName, dstReal)
+ call mpas_pool_add_field(all_fields, dstReal % fieldName, dstReal)
+ if (present(target_ptr)) then
+ call mpas_pool_get_array(outpool, dstReal % fieldName, target_ptr, 1)
+ end if
+end subroutine add_new_real
+
+
+
+!***********************************************************************
+! routine add_new_real_1d
+!
+!> \brief Allocate an 1d real in the MPAS framework for this AM
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> Allocate a new 1d real from a 2d integer (for creating vertical
+!> weight arrays from the vertical mask, i.e., drops the element dimension)
+!> has_vertical is integer so that the result can be stored in the framework.
+!-----------------------------------------------------------------------
+subroutine add_new_real_1d(all_fields, inpool, outpool, &
+ inname, outname, elem_name, &
+ has_vertical, vertical_dim)!{{{
+#include "regional_stats_inc/regional_field_nd_1.inc"
+
+ type (field2DInteger), pointer :: src
+ type (field1DReal), pointer :: dst
+ integer, dimension(2) :: src_dims
+ type (mpas_pool_field_info_type) :: info
+
+#include "regional_stats_inc/regional_field_nd_2.inc"
+ allocate(dst % array(src_dims(1)))
+#include "regional_stats_inc/regional_field_nd_3.inc"
+
+ dst % hasTimeDimension = .true.
+
+ call mpas_pool_get_field_info(outpool, outname, info)
+ info % nTimeLevels = 1
+end subroutine add_new_real_1d!}}}
+
+
+
+!***********************************************************************
+! routine add_new_integer_1d
+!
+!> \brief Allocate an 1d integer in the MPAS framework for this AM
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> Allocate a new 1d integer from a 2d integer (for creating vertical
+!> count arrays from the vertical mask, i.e., drops the element dimension)
+!> has_vertical is integer so that the result can be stored in the framework.
+!-----------------------------------------------------------------------
+subroutine add_new_integer_1d(all_fields, inpool, outpool, &
+ inname, outname, elem_name, &
+ has_vertical, vertical_dim)!{{{
+#include "regional_stats_inc/regional_field_nd_1.inc"
+
+ type (field2DInteger), pointer :: src
+ type (field1DInteger), pointer :: dst
+ integer, dimension(2) :: src_dims
+ type (mpas_pool_field_info_type) :: info
+
+#include "regional_stats_inc/regional_field_nd_2.inc"
+ allocate(dst % array(src_dims(1)))
+#include "regional_stats_inc/regional_field_nd_3.inc"
+
+ dst % hasTimeDimension = .true.
+
+ call mpas_pool_get_field_info(outpool, outname, info)
+ info % nTimeLevels = 1
+end subroutine add_new_integer_1d!}}}
+
+
+
+!***********************************************************************
+! function output_naming
+!
+!> \brief Given an input name, create a corresponding output name
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> Code to create consistent output names from input names.
+!-----------------------------------------------------------------------
+character (len=StrKIND) function output_naming &
+(op_name, input_name, region_identifier, instance)
+ character (len=StrKIND), intent(in) :: op_name, &
+ input_name, region_identifier, instance
+
+ output_naming = trim(instance) // &
+ trim(region_identifier) // '_' // trim(op_name) // '_' // &
+ trim(input_name)
+end function output_naming
+
+
+
+!***********************************************************************
+! function operator_naming
+!
+!> \brief Given an operator enum, create a corresponding operator name
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> Code to create consistent operator names from operator enums.
+!-----------------------------------------------------------------------
+character (len=StrKIND) function operator_naming(enum)
+ integer, intent(in) :: enum
+
+ if (enum == AVG_OP) then
+ operator_naming = AVG_TOKEN
+ else if (enum == MIN_OP) then
+ operator_naming = MIN_TOKEN
+ else if (enum == MAX_OP) then
+ operator_naming = MAX_TOKEN
+ else
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: The impossible happened. ' // &
+ 'Tried creating an operator of unknown kind in regional stats AM.')
+ end if
+end function operator_naming
+
+
+
+!***********************************************************************
+! function element_naming
+!
+!> \brief Given an element enum, create a corresponding element name
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> Code to create consistent operator names from operator enums.
+!-----------------------------------------------------------------------
+character (len=StrKIND) function element_naming(enum)
+ integer, intent(in) :: enum
+
+ if (enum == CELL_REGION) then
+ element_naming = CELL_TOKEN
+ else if (enum == VERTEX_REGION) then
+ element_naming = VERTEX_TOKEN
+ else
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: The impossible happened. ' // &
+ 'Tried creating an element of unknown kind in regional stats AM.')
+ end if
+end function element_naming
+
+
+
+!***********************************************************************
+! function dimension_naming
+!
+!> \brief Given a region type, return its canonical dimension string name
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> Returns the canonical MPAS dimension name given a region element dimension.
+!-----------------------------------------------------------------------
+character (len=StrKIND) function dimension_naming(elem_type)
+ integer, intent(in) :: elem_type
+
+ if (elem_type == CELL_REGION) then
+ dimension_naming = CELL_DIM
+ else if (elem_type == VERTEX_REGION) then
+ dimension_naming = VERTEX_DIM
+ else
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: The impossible happened. ' // &
+ 'Tried creating a element dimension name of unknown kind in ' // &
+ 'regional stats AM.')
+ end if
+end function dimension_naming
+
+
+
+!***********************************************************************
+! function check_real_element_dim
+!
+!> \brief Return true if the last dimension matches the element and is real.
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> Given an element dimension name and field info, return true
+!> if the last dimension of the field is the element and the field is
+!> real, otherwise return false.
+!-----------------------------------------------------------------------
+logical function check_real_element_dim(all_fields, field_name, elem_name)
+ type (mpas_pool_type), pointer, intent(in) :: all_fields
+ character (len=StrKIND), intent(in) :: field_name, elem_name
+
+ logical :: has_elem
+ type (mpas_pool_field_info_type) :: info
+ type (field1DReal), pointer :: r1
+ type (field2DReal), pointer :: r2
+ type (field3DReal), pointer :: r3
+ type (field4DReal), pointer :: r4
+ type (field5DReal), pointer :: r5
+
+ call mpas_pool_get_field_info(all_fields, field_name, info)
+
+ if (info % fieldType /= MPAS_POOL_REAL) then
+ write(stdErrUnit,*) &
+ trim(CURRENT_CORE_NAME) // ' WARNING: field "' // &
+ trim(field_name) // '" listed in the ' // &
+ 'output stream, for regional stats analysis member, ' // &
+ 'is not real. Regional stats will not be applied to ' // &
+ 'this field.'
+
+ check_real_element_dim = .false.
+ else if (info % nDims < 1) then
+ write(stdErrUnit,*) &
+ trim(CURRENT_CORE_NAME) // ' WARNING: field "' // &
+ trim(field_name) // '" listed in the ' // &
+ 'output stream, for regional stats analysis member, ' // &
+ 'is 0D. Regional stats will not be applied to ' // &
+ 'this field.'
+
+ check_real_element_dim = .false.
+ else
+ if (info % nDims == 1) then
+ call mpas_pool_get_field(all_fields, field_name, r1, 1)
+ has_elem = check_element_dim(r1 % dimNames, elem_name)
+ else if (info % nDims == 2) then
+ call mpas_pool_get_field(all_fields, field_name, r2, 1)
+ has_elem = check_element_dim(r2 % dimNames, elem_name)
+ else if (info % nDims == 3) then
+ call mpas_pool_get_field(all_fields, field_name, r3, 1)
+ has_elem = check_element_dim(r3 % dimNames, elem_name)
+ else if (info % nDims == 4) then
+ call mpas_pool_get_field(all_fields, field_name, r4, 1)
+ has_elem = check_element_dim(r4 % dimNames, elem_name)
+ else
+ call mpas_pool_get_field(all_fields, field_name, r5, 1)
+ has_elem = check_element_dim(r5 % dimNames, elem_name)
+ end if
+
+ if (.not. has_elem) then
+ write(stdErrUnit,*) &
+ trim(CURRENT_CORE_NAME) // ' WARNING: field "' // &
+ trim(field_name) // '" listed in the output stream, ' // &
+ 'for regional stats analysis member, does not have ' // &
+ trim(elem_name) // ' as its last dimension. Regional stats ' // &
+ 'will not be applied to this field.'
+ end if
+
+ check_real_element_dim = has_elem
+ end if
+
+end function check_real_element_dim
+
+
+
+!***********************************************************************
+! function check_element_dim
+!
+!> \brief Return true if the last dimension matches the element name.
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> Given an element dimension name and list of dim names, return true
+!> if the last dimension is the element, otherwise return false.
+!-----------------------------------------------------------------------
+logical function check_element_dim(dim_names, elem_name)
+ character (len=StrKIND), dimension(:), intent(in) :: dim_names
+ character (len=StrKIND), intent(in) :: elem_name
+
+ integer :: last
+
+ last = size(dim_names)
+ if (last > 0) then
+ check_element_dim = (trim(dim_names(last)) == trim(elem_name))
+ else
+ check_element_dim = .false.
+ end if
+end function check_element_dim
+
+
+
+!***********************************************************************
+! function check_vertical_dim
+!
+!> \brief Return not 0 if the last dimension matches the vertical name.
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> Given an vertical dimension name and list of dim names, return not 0
+!> if the last dimension is the vertical, otherwise return 0.
+!> It uses integers so the result can be stored in the framework.
+!-----------------------------------------------------------------------
+integer function check_vertical_dim(dim_names, vert_name)
+ character (len=StrKIND), dimension(:), intent(in) :: dim_names
+ character (len=StrKIND), intent(in) :: vert_name
+
+ integer :: last
+
+ last = size(dim_names)
+ if (last > 1) then
+ if (trim(dim_names(last - 1)) == trim(vert_name)) then
+ check_vertical_dim = 1
+ else
+ check_vertical_dim = 0
+ end if
+ else
+ check_vertical_dim = 0
+ end if
+end function check_vertical_dim
+
+
+
+!***********************************************************************
+! function mask_naming
+!
+!> \brief Consistent naming for mask field from the stream.
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details Creates the name of the mask field based on the element type.
+!-----------------------------------------------------------------------
+character (len=StrKIND) function mask_naming(elem_type)
+ integer, intent(in) :: elem_type
+
+ if (elem_type == CELL_REGION) then
+ mask_naming = &
+ trim(MASK_DATA_PREFIX) // trim(CELL_CAMEL) // trim(MASK_DATA_SUFFIX)
+ else if (elem_type == VERTEX_REGION) then
+ mask_naming = &
+ trim(MASK_DATA_PREFIX) // trim(VERTEX_CAMEL) // trim(MASK_DATA_SUFFIX)
+ else
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: The impossible happened. ' // &
+ 'Tried to create a name for a mask field of unknown type.')
+ end if
+end function mask_naming
+
+
+!***********************************************************************
+! function fix_region_name
+!
+!> \brief Replaces non identifier characters with _ (underscore)
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details Given a character string, it will replace all of the Fortran
+! non-identifier characters (anything but [a-zA-Z0-9_]) with underscore.
+! This is primarily for renaming regions from the mask file,
+! because NetCDF doesn't like non-identifier characters in the
+! start position and Fortran identifiers are [a-zA-Z][a-zA-Z0-9_]+.
+! It will also prepend 'reg' to the string to make sure it starts
+! with [a-zA-Z].
+!-----------------------------------------------------------------------
+character (len=StrKIND) function fix_region_name(string)
+ character (len=StrKIND), intent(in) :: string
+
+ character (len=StrKIND) :: copy
+ integer :: tl, i, c
+
+ copy = string
+ tl = len_trim(copy)
+
+ if (tl < 1) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: a region name, from the ' // &
+ 'region mask input for the regional stats analysis member, the ' // &
+ 'is an empty string.')
+ end if
+
+ tl = tl + 3
+ copy = 'reg' // copy
+
+ do i = 4, tl
+ c = iachar(copy(i:i))
+ if ((c < 48) .or. ((c > 57) .and. (c < 65)) .or. (c > 122)) then
+ copy(i:i) = '_'
+ end if
+ end do
+
+ fix_region_name = copy
+end function fix_region_name
+
+
+!***********************************************************************
+! routine debug_state
+!
+!> \brief Print all of the state for this instance.
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> Given the current state in regions, print it all for debugging.
+!-----------------------------------------------------------------------
+subroutine debug_state(regions)
+ type (regional_type), intent(in) :: regions
+ integer :: v, b, last, m
+
+ write(*,*) 'num vars: ', regions % number_of_variables
+
+ write (*,*) 'op: ', regions % operation
+ write (*,*) 'elem: ', regions % region_element
+ write (*,*) '1d func: ', regions % function_oned
+ write (*,*) '1d weight: ', trim(regions % weights_oned)
+ write (*,*) '2d func: ', regions % function_twod
+ write (*,*) '2d weight: ', trim(regions % weights_twod)
+
+ write (*,*) 'mask: ', trim(regions % masking_field)
+ write (*,*) 'vertical mask: ', trim(regions % vertical_mask)
+
+ last = regions % num_regions_per(regions % group_index)
+ write(*,*) 'selected group: ', regions % group_index
+ write(*,*) 'num regions in: ', last
+ do b = 1, last
+ write(*,*) 'count 1d var: ', trim(regions % count_zerod_names(b))
+ write(*,*) 'weight 1d var: ', trim(regions % weight_zerod_names(b))
+ write(*,*) 'count 2d var: ', trim(regions % count_oned_names(b))
+ write(*,*) 'weight 2d var: ', trim(regions % weight_oned_names(b))
+ end do
+ do v = 1, regions % number_of_variables
+ write(*,*) 'var: ', trim(regions % variables(v) % input_name)
+ write(*,*) 'has vertical: ', regions % variables(v) % has_vertical
+ do b = 1, last
+ write(*,*) 'index: ', b
+ m = regions % groups(b, regions % group_index)
+ write(*,*) 'region index: ', m
+ write(*,*) 'out var: ', trim(regions % variables(v) % output_names(b))
+ end do
+ end do
+end subroutine debug_state
+
+
+
+!***********************************************************************
+! routine get_state
+!
+!> \brief Get all of the state for this instance.
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> This will allocate and fetch all of the state necessary for this
+!> instance that is being run (prevalidated data from start_state).
+!-----------------------------------------------------------------------
+subroutine get_state(domain, instance, regions)
+ ! input variables
+ character (len=StrKIND), intent(in) :: instance
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+
+ ! output variables
+ type (regional_type), intent(out) :: regions
+
+ ! local variables
+ integer :: v, b, last, m
+ character (len=StrKIND) :: namelist_prefix, storage_prefix, field_name, &
+ var_identifier, op_name
+ type (mpas_pool_type), pointer :: maskPool, amPool
+ character (len=StrKIND), dimension(:), pointer :: names
+ logical :: active_vertical
+
+ ! start procedure
+ namelist_prefix = trim(CONFIG_PREFIX) // trim(instance)
+ storage_prefix = trim(FRAMEWORK_PREFIX) // trim(instance)
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, &
+ REGIONAL_STATS_POOL, amPool)
+
+ !
+ ! get ones we stored in framework for this instance
+ !
+
+ ! number_of_variables
+ field_name = trim(storage_prefix) // trim(NUMBER_OF_VARIABLES_SUFFIX)
+ call mpas_pool_get_array(amPool, field_name, regions % number_of_variables, 1)
+
+ ! operation
+ field_name = trim(storage_prefix) // trim(OPERATION_SUFFIX)
+ call mpas_pool_get_array(amPool, field_name, regions % operation, 1)
+
+ op_name = operator_naming(regions % operation)
+
+ ! mask type
+ field_name = trim(storage_prefix) // trim(REGION_TYPE_SUFFIX)
+ call mpas_pool_get_array(amPool, field_name, regions % region_element, 1)
+
+ ! mask field & pool
+ regions % masking_field = mask_naming(regions % region_element)
+ call mpas_pool_get_subpool(domain % blocklist % structs, &
+ MASK_POOL_NAME, maskPool)
+
+ ! weighting function
+ field_name = trim(storage_prefix) // trim(FUNCTION_ONED_SUFFIX)
+ call mpas_pool_get_array(amPool, field_name, regions % function_oned, 1)
+
+ field_name = trim(storage_prefix) // trim(FUNCTION_TWOD_SUFFIX)
+ call mpas_pool_get_array(amPool, field_name, regions % function_twod, 1)
+
+ ! get the input names and has vertical for variables
+ allocate(regions % variables(regions % number_of_variables))
+ do v = 1, regions % number_of_variables
+ ! identifier
+ write(var_identifier, '(I0)') v
+
+ ! input name
+ field_name = trim(storage_prefix) // '_' // trim(var_identifier) // &
+ trim(INPUT_NAME_SUFFIX)
+ call mpas_pool_get_array(amPool, field_name, &
+ regions % variables(v) % input_name, 1)
+
+ ! has_vertical
+ field_name = trim(storage_prefix) // '_' // trim(var_identifier) // &
+ trim(HAS_VERTICAL_SUFFIX)
+ call mpas_pool_get_array(amPool, field_name, &
+ regions % variables(v) % has_vertical, 1)
+ end do
+
+ ! group index
+ field_name = trim(storage_prefix) // trim(REGION_GROUP_SUFFIX)
+ call mpas_pool_get_array(amPool, field_name, regions % group_index, 1)
+
+ !
+ ! get ones that already exist from namelist/stream
+ !
+
+ ! weighting fields
+ field_name = trim(namelist_prefix) // trim(WEIGHTS_ONED_SUFFIX)
+ call mpas_pool_get_config(domain % configs, field_name, &
+ regions % weights_oned)
+
+ field_name = trim(namelist_prefix) // trim(WEIGHTS_TWOD_SUFFIX)
+ call mpas_pool_get_config(domain % configs, field_name, &
+ regions % weights_twod)
+
+ ! groups
+ call mpas_pool_get_array(maskPool, GROUP_DATA_NAME, regions % groups, 1)
+
+ ! num_regions_per
+ call mpas_pool_get_array(maskPool, REGIONS_PER_NAME, &
+ regions % num_regions_per, 1)
+
+ ! vertical mask
+ field_name = trim(namelist_prefix) // trim(VERTICAL_MASK_SUFFIX)
+ call mpas_pool_get_config(domain % configs, field_name, &
+ regions % vertical_mask)
+
+ field_name = trim(namelist_prefix) // trim(VERTICAL_DIM_SUFFIX)
+ call mpas_pool_get_config(domain % configs, field_name, &
+ regions % vertical_dim)
+
+ active_vertical = (trim(regions % vertical_mask) /= trim(NONE_TOKEN))
+
+ !
+ ! generate output names
+ !
+
+ ! fetch region names and name via regions
+ call mpas_pool_get_array(maskPool, REGION_NAMES_NAME, names)
+
+ last = regions % num_regions_per(regions % group_index)
+ ! allocate count and weight names
+ allocate(regions % count_zerod_names(last))
+ allocate(regions % weight_zerod_names(last))
+ allocate(regions % count_oned_names(last))
+ allocate(regions % weight_oned_names(last))
+ do b = 1, last
+ m = regions % groups(b, regions % group_index)
+
+ ! 0d count & weight name
+ regions % count_zerod_names(b) = output_naming(COUNT_TOKEN, &
+ ZEROD_TOKEN, fix_region_name(names(m)), instance)
+
+ if (regions % function_oned == MUL_FUNC) then
+ regions % weight_zerod_names(b) = &
+ output_naming(WEIGHT_TOKEN, &
+ ZEROD_TOKEN, fix_region_name(names(m)), instance)
+ end if
+
+ ! 1d count & weight name
+ if (active_vertical) then
+ regions % count_oned_names(b) = &
+ output_naming(COUNT_TOKEN, &
+ ONED_TOKEN, fix_region_name(names(m)), instance)
+
+ if (regions % function_twod == MUL_FUNC) then
+ regions % weight_oned_names(b) = &
+ output_naming(WEIGHT_TOKEN, &
+ ONED_TOKEN, fix_region_name(names(m)), instance)
+ end if
+ end if
+
+ end do
+
+ do v = 1, regions % number_of_variables
+ ! allocate output names
+ allocate(regions % variables(v) % output_names(last))
+
+ do b = 1, last
+ m = regions % groups(b, regions % group_index)
+
+ ! region name
+ regions % variables(v) % output_names(b) = output_naming(op_name, &
+ regions % variables(v) % input_name, &
+ fix_region_name(names(m)), instance)
+ end do
+ end do
+
+end subroutine get_state
+
+
+!***********************************************************************
+! routine start_state
+!
+!> \brief Begin the initialization of this analysis member
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> All the necessary details to initialize this analysis member
+!> instance.
+!-----------------------------------------------------------------------
+subroutine start_state(domain, instance, err)
+ ! input variables
+ character (len=StrKIND), intent(in) :: instance
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+
+ ! output variables
+ integer, intent(out) :: err !< Output: error flag
+
+ ! local variables
+ type (regional_type) :: regions
+ character (len=StrKIND), pointer :: config_results, output_stream_name, &
+ config_results_2
+ character (len=StrKIND) :: namelist_prefix, storage_prefix, field_name, &
+ elem_name, op_name, var_identifier
+ integer :: v, b, last, m
+ integer, pointer :: number_of_regions, number_of_groups, max_regions_per
+ type (mpas_pool_type), pointer :: maskPool, amPool
+ type (field1DReal), pointer :: oned_field
+ type (field2DReal), pointer :: twod_field
+ type (field2DInteger), pointer :: mask
+ type (mpas_pool_field_info_type) :: info
+ character (len=StrKIND), dimension(:), pointer :: names
+ logical :: active_vertical
+ logical, dimension(:), allocatable :: valid_input
+
+ ! start procedure
+ err = 0
+
+ namelist_prefix = trim(CONFIG_PREFIX) // trim(instance)
+ storage_prefix = trim(FRAMEWORK_PREFIX) // trim(instance)
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, &
+ REGIONAL_STATS_POOL, amPool)
+
+ !
+ ! get dimensions
+ !
+
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, &
+ NUM_REGIONS_SUFFIX, number_of_regions)
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, &
+ NUM_GROUPS_SUFFIX, number_of_groups)
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, &
+ MAX_REGIONS_SUFFIX, max_regions_per)
+
+ if (number_of_regions < 1) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: number of regions dimension is ' // &
+ 'less than 1 for the regional stats analysis member.')
+ end if
+
+ if (number_of_groups < 1) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: number of region groups ' // &
+ 'dimension is less than 1 for the regional stats analysis member.')
+ end if
+
+ if (max_regions_per < 1) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: maximum number of regions per ' // &
+ 'group dimension is less than 1 for the regional stats analysis member.')
+ end if
+
+ !
+ ! allocate some framework memory for instance state, and assign values
+ !
+
+ ! number of variables done in modify stream
+
+ ! operation
+ field_name = trim(storage_prefix) // trim(OPERATION_SUFFIX)
+ call add_new_integer(domain % blocklist % allFields, amPool, amPool, &
+ field_name, regions % operation)
+
+ ! get our operation
+ field_name = trim(namelist_prefix) // trim(OPERATION_SUFFIX)
+ call mpas_pool_get_config(domain % configs, field_name, config_results)
+ if (config_results == AVG_TOKEN) then
+ regions % operation = AVG_OP
+ else if (config_results == MIN_TOKEN) then
+ regions % operation = MIN_OP
+ else if (config_results == MAX_TOKEN) then
+ regions % operation = MAX_OP
+ else
+ ! error if unknown operation
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: unknown operation in ' // &
+ 'regional stats analysis member configuration.')
+ end if
+
+ op_name = operator_naming(regions % operation)
+
+ ! element type
+ field_name = trim(storage_prefix) // trim(REGION_TYPE_SUFFIX)
+ call add_new_integer(domain % blocklist % allFields, amPool, amPool, &
+ field_name, regions % region_element)
+
+ ! get the element type
+ field_name = trim(namelist_prefix) // trim(REGION_TYPE_SUFFIX)
+ call mpas_pool_get_config(domain % configs, field_name, config_results)
+
+ if (config_results == CELL_TOKEN) then
+ regions % region_element = CELL_REGION
+ else if (config_results == VERTEX_TOKEN) then
+ regions % region_element = VERTEX_REGION
+ else
+ ! error if unknown element type
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: unknown region element type in ' // &
+ 'regional stats analysis member configuration.')
+ end if
+
+ elem_name = dimension_naming(regions % region_element)
+
+ ! get vertical dim
+ field_name = trim(namelist_prefix) // trim(VERTICAL_DIM_SUFFIX)
+ call mpas_pool_get_config(domain % configs, field_name, &
+ regions % vertical_dim)
+
+ active_vertical = (trim(regions % vertical_dim) /= trim(NONE_TOKEN))
+
+ ! mask field & pool
+ regions % masking_field = mask_naming(regions % region_element)
+ call mpas_pool_get_subpool(domain % blocklist % structs, &
+ MASK_POOL_NAME, maskPool)
+
+ ! validate the mask field
+ !
+ ! shouldn't actually need this because the naming convention, but
+ ! can't hurt to check, just in case
+ if (regions % masking_field /= NONE_TOKEN) then
+ call mpas_pool_get_field_info(maskPool, regions % masking_field, info)
+
+ if (info % fieldType /= MPAS_POOL_INTEGER) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: the mask ' // &
+ trim(regions % masking_field) // &
+ ' for the regional stats AM is not a integer field.')
+ end if
+
+ if (info % nDims /= 2) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: the mask ' // &
+ trim(regions % masking_field) // &
+ ' for the regional stats AM is not a 2D field.')
+ end if
+
+ call mpas_pool_get_field(maskPool, regions % masking_field, mask)
+
+ if (.not. check_element_dim(mask % dimNames, elem_name)) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: the mask ' // &
+ trim(regions % masking_field) // &
+ ' for the regional stats AM needs to have ' // trim(elem_name) // &
+ ' as its last dimension.')
+ end if
+ end if
+
+ ! 1d weighting function
+ field_name = trim(storage_prefix) // trim(FUNCTION_ONED_SUFFIX)
+ call add_new_integer(domain % blocklist % allFields, amPool, amPool, &
+ field_name, regions % function_oned)
+
+ field_name = trim(namelist_prefix) // trim(FUNCTION_ONED_SUFFIX)
+ call mpas_pool_get_config(domain % configs, field_name, config_results)
+
+ if (config_results == ID_TOKEN) then
+ regions % function_oned = ID_FUNC
+ else if (config_results == MUL_TOKEN) then
+ regions % function_oned = MUL_FUNC
+ else
+ ! error if unknown operation
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // &
+ ' ERROR: unknown 1d weighting function in ' // &
+ 'regional stats analysis member configuration.')
+ end if
+
+ if (regions % function_oned /= ID_FUNC .and. &
+ regions % operation /= AVG_OP) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: 1d weighting function in ' // &
+ 'regional stats analysis member can only be something other than ' // &
+ '"id" if the operation is not "avg" ' // &
+ '(i.e., "mul" is only valid for "avg").')
+ end if
+
+ ! 2d weighting function
+ field_name = trim(storage_prefix) // trim(FUNCTION_TWOD_SUFFIX)
+ call add_new_integer(domain % blocklist % allFields, amPool, amPool, &
+ field_name, regions % function_twod)
+
+ field_name = trim(namelist_prefix) // trim(FUNCTION_TWOD_SUFFIX)
+ call mpas_pool_get_config(domain % configs, field_name, config_results)
+
+ if (config_results == ID_TOKEN) then
+ regions % function_twod = ID_FUNC
+ else if (config_results == MUL_TOKEN) then
+ regions % function_twod = MUL_FUNC
+ else
+ ! error if unknown operation
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // &
+ ' ERROR: unknown 2d weighting function in ' // &
+ 'regional stats analysis member configuration.')
+ end if
+
+ if (regions % function_twod /= ID_FUNC .and. &
+ regions % operation /= AVG_OP) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: 2d weighting function in ' // &
+ 'regional stats analysis member can only be something other than ' // &
+ '"id" if the operation is not "avg" ' // &
+ '(i.e., "mul" is only valid for "avg").')
+ end if
+
+ ! group index
+ field_name = trim(storage_prefix) // trim(REGION_GROUP_SUFFIX)
+ call add_new_integer(domain % blocklist % allFields, amPool, amPool, &
+ field_name, regions % group_index)
+
+ field_name = trim(namelist_prefix) // trim(REGION_GROUP_SUFFIX)
+ call mpas_pool_get_config(domain % configs, field_name, &
+ config_results)
+
+ call mpas_pool_get_array(maskPool, GROUP_NAMES_NAME, names)
+
+ ! error if we can't find it
+ regions % group_index = 0
+ do v = 1, number_of_groups
+ if (trim(names(v)) == trim(config_results)) then
+ regions % group_index = v
+ end if
+ end do
+
+ if (regions % group_index == 0) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: unable to find the region group ' // &
+ 'named "' // trim(config_results) // '" in the region mask input stream')
+ end if
+
+ !
+ ! verify the other data is OK before trying to use it later
+ !
+
+ ! validate input stream is not none
+ field_name = trim(namelist_prefix) // trim(INPUT_STREAM_SUFFIX)
+ call mpas_pool_get_config(domain % configs, field_name, config_results)
+
+ if (config_results == NONE_TOKEN) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: input stream for regional ' // &
+ 'stats AM cannot be "none". It needs to point to the region/mask stream.')
+ end if
+
+ ! validate the restart stream is not none
+ field_name = trim(namelist_prefix) // trim(RESTART_STREAM_SUFFIX)
+ call mpas_pool_get_config(domain % configs, field_name, config_results_2)
+
+ if (config_results == NONE_TOKEN) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: restart stream for regional ' // &
+ 'stats AM cannot be "none". It needs to point to the region/mask stream.')
+ end if
+
+ ! make sure input and restart are the same
+ if (config_results /= config_results_2) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: the input and restart stream ' // &
+ 'for regional stats AM need to be the same to ensure that it ' // &
+ 'has the same behavior on start and restart.')
+ end if
+
+ ! validate vertical mask
+ field_name = trim(namelist_prefix) // trim(VERTICAL_MASK_SUFFIX)
+ call mpas_pool_get_config(domain % configs, field_name, &
+ regions % vertical_mask)
+
+ active_vertical = .false.
+ if (regions % vertical_mask /= NONE_TOKEN) then
+ call mpas_pool_get_field_info(domain % blocklist % allFields, &
+ regions % vertical_mask, info)
+
+ if (info % fieldType /= MPAS_POOL_INTEGER) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: the vertical mask ' // &
+ trim(regions % vertical_mask) // &
+ 'for the regional stats AM is not an integer field.')
+ end if
+
+ if (info % nDims /= 2) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: the vertical mask ' // &
+ trim(regions % vertical_mask) // &
+ ' for the regional stats AM is not a 2D field.')
+ end if
+
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ regions % vertical_mask, mask)
+
+ if (.not. check_element_dim(mask % dimNames, elem_name)) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: the vertical mask ' // &
+ trim(regions % vertical_mask) // &
+ ' for the regional stats AM needs to have ' // trim(elem_name) // &
+ ' as its last dimension.')
+ end if
+
+ if (check_vertical_dim(mask % dimNames, regions % vertical_dim) == 0) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: the vertical mask ' // &
+ trim(regions % vertical_mask) // &
+ ' for the regional stats AM does not have ' // &
+ trim(regions % vertical_dim) // &
+ ' as its second to last dimension.')
+ end if
+
+ active_vertical = .true.
+ end if
+
+ ! validate 1d weighting field
+ field_name = trim(namelist_prefix) // trim(WEIGHTS_ONED_SUFFIX)
+ call mpas_pool_get_config(domain % configs, field_name, &
+ regions % weights_oned)
+
+ if (regions % function_oned == ID_FUNC) then
+ if (regions % weights_oned /= NONE_TOKEN) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: 1d weighting field "' // &
+ trim(regions % weights_oned) // '" is not set to "none" ' // &
+ 'when the 1d weighting function is set to "id" in ' // &
+ 'regional stats AM.')
+ end if
+ else
+ ! weighting field & info
+ if (regions % weights_oned == NONE_TOKEN) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: 1d weighting field "' // &
+ trim(regions % weights_oned) // '" is set to "none" ' // &
+ 'when the 1d weighting function is something other than "id" in ' // &
+ 'regional stats AM.')
+ else
+ call mpas_pool_get_field_info(domain % blocklist % allFields, &
+ regions % weights_oned, info)
+
+ if (info % nDims /= 1) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // &
+ ' ERROR: the listed 1d weighting field "' // &
+ trim(regions % weights_oned) // &
+ '" for the regional stats AM is not actually a 1D field.')
+ end if
+
+ ! check if we can handle it
+ if (info % fieldType == MPAS_POOL_REAL) then
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ regions % weights_oned, oned_field)
+
+ if (.not. check_element_dim(oned_field % dimNames, elem_name)) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: 1d weighting field "' // &
+ regions % weights_oned // &
+ '" in regional stats AM needs to have ' // &
+ elem_name // ' dimensioni as its last dimension.')
+ end if
+ else
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: 1d weighting field "' // &
+ trim(regions % weights_oned) // '" listed in the ' // &
+ 'namelist, for regional stats analysis member ' // &
+ 'stream, is not real.')
+ end if
+ end if
+ end if
+
+ ! validate 2d weighting field
+ field_name = trim(namelist_prefix) // trim(WEIGHTS_TWOD_SUFFIX)
+ call mpas_pool_get_config(domain % configs, field_name, &
+ regions % weights_twod)
+
+ if (.not. active_vertical) then
+ if (regions % function_twod /= ID_FUNC) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: vertical dimension is not set ' // &
+ 'in regional stats AM when the 2d weight function is something ' // &
+ 'than "id"')
+ end if
+ else if (regions % function_twod == ID_FUNC) then
+ if (regions % weights_twod /= NONE_TOKEN) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: 2d weighting field "' // &
+ trim(regions % weights_twod) // '" is not set to "none"' // &
+ 'when the 2d weighting function is set to "id", in ' // &
+ 'regional stats AM.')
+ end if
+ else
+ ! weighting field & info
+ if (regions % weights_twod == NONE_TOKEN) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: 2d weighting field "' // &
+ trim(regions % weights_twod) // '" is set to "none"' // &
+ 'when the 2d weighting function is something other than "id" in ' // &
+ 'regional stats AM.')
+ else
+ call mpas_pool_get_field_info(domain % blocklist % allFields, &
+ regions % weights_twod, info)
+
+ if (info % nDims /= 2) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // &
+ ' ERROR: the listed 2d weighting field "' // &
+ trim(regions % weights_twod) // &
+ '" for the regional stats AM is not actually a 2D field.')
+ end if
+
+ ! check if we can handle it
+ if (info % fieldType == MPAS_POOL_REAL) then
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ regions % weights_twod, twod_field)
+
+ if (.not. check_element_dim(twod_field % dimNames, elem_name)) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: 2d weighting field "' // &
+ regions % weights_twod // &
+ '" in regional stats AM needs to have ' // &
+ elem_name // ' as its last dimension.')
+ end if
+
+ if (check_vertical_dim(twod_field % dimNames, &
+ regions % vertical_dim) == 0) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: 2d weighting field "' // &
+ regions % weights_twod // &
+ '" in regional stats AM needs to have ' // &
+ regions % vertical_dim // &
+ ' vertical dimension as its second to last dimension.')
+ end if
+ else
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: 2d weighting field "' // &
+ trim(regions % weights_twod) // '" listed in the ' // &
+ 'namelist, for regional stats analysis member ' // &
+ 'stream, is not real.')
+ end if
+ end if
+ end if
+
+ ! groups
+ call mpas_pool_get_array(maskPool, GROUP_DATA_NAME, regions % groups, 1)
+
+ ! num_regions
+ call mpas_pool_get_array(maskPool, REGIONS_PER_NAME, &
+ regions % num_regions_per, 1)
+
+ ! verify selection is OK
+ last = regions % num_regions_per(regions % group_index)
+ if (last > max_regions_per) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: the number of regions for ' // &
+ 'selected group, in the regional stats analysis member, ' // &
+ 'is greater than the maximum number of regions dimension.')
+ end if
+ if (last < 1) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: the number of regions for ' // &
+ 'selection group, in the regional stats analysis member, ' // &
+ 'is less than 1.')
+ end if
+
+ do b = 1, last
+ v = regions % groups(b, regions % group_index)
+ if ((v < 1) .or. (v > number_of_regions)) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: a region index found ' // &
+ 'in the list of regions for the selected group in the ' // &
+ 'regional stats analysis member is out of bounds for the size ' // &
+ 'of the regions found in the masks input.')
+ end if
+ end do
+
+
+ !
+ ! modify the stream to create destination output variables and remove inputs
+ !
+
+ ! get the output stream name
+ field_name = trim(namelist_prefix) // trim(OUTPUT_STREAM_SUFFIX)
+ call mpas_pool_get_config(domain % configs, field_name, output_stream_name)
+
+ if (output_stream_name == NONE_TOKEN) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: ouput stream cannot be "none" ' // &
+ 'for regional stats.')
+ end if
+
+ ! number_of_variables
+ field_name = trim(storage_prefix) // trim(NUMBER_OF_VARIABLES_SUFFIX)
+ call add_new_integer(domain % blocklist % allFields, amPool, amPool, &
+ field_name, regions % number_of_variables)
+
+ ! count total number of fields
+ call mpas_stream_mgr_begin_iteration(domain % streamManager, &
+ output_stream_name, err)
+ b = 0
+ do while (mpas_stream_mgr_get_next_field(domain % streamManager, &
+ output_stream_name, field_name))
+ b = b + 1
+ end do
+
+ allocate(valid_input(b))
+
+ ! count the number of variables and mark if valid
+ call mpas_stream_mgr_begin_iteration(domain % streamManager, &
+ output_stream_name, err)
+ b = 1
+ regions % number_of_variables = 0
+ do while (mpas_stream_mgr_get_next_field(domain % streamManager, &
+ output_stream_name, field_name))
+
+ ! check if we can handle it
+ valid_input(b) = check_real_element_dim(domain % blocklist % allFields, &
+ field_name, elem_name)
+
+ if (valid_input(b)) then
+ regions % number_of_variables = regions % number_of_variables + 1
+ end if
+
+ b = b + 1
+ end do
+
+ if (regions % number_of_variables < 1) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: there are no fields ' // &
+ 'in the regional stats output stream "' // trim(output_stream_name) // &
+ '" that regional stats can be applied to.')
+ end if
+
+ ! create the memory
+ allocate(regions % variables(regions % number_of_variables))
+
+ ! create input variable name space
+ do v = 1, regions % number_of_variables
+ ! identifier
+ write(var_identifier, '(I0)') v
+
+ ! create input name space
+ field_name = trim(storage_prefix) // '_' // trim(var_identifier) // &
+ trim(INPUT_NAME_SUFFIX)
+ call add_new_string(domain % blocklist % allFields, amPool, amPool, &
+ field_name, regions % variables(v) % input_name)
+
+ ! create has_vertical space
+ field_name = trim(storage_prefix) // '_' // trim(var_identifier) // &
+ trim(HAS_VERTICAL_SUFFIX)
+ call add_new_integer(domain % blocklist % allFields, amPool, amPool, &
+ field_name, regions % variables(v) % &
+ has_vertical)
+ end do
+
+ ! get the old field names, assign to input name, and remove from stream
+ call mpas_stream_mgr_begin_iteration(domain % streamManager, &
+ output_stream_name, err)
+ b = 1
+ v = 1
+ do while (mpas_stream_mgr_get_next_field(domain % streamManager, &
+ output_stream_name, field_name))
+ ! get the info of the field
+ call mpas_pool_get_field_info(domain % blocklist % allFields, &
+ field_name, info)
+
+ ! check if we can handle it
+ if (valid_input(b)) then
+ regions % variables(v) % input_name = field_name
+
+ ! remove the old one from the stream
+ call mpas_stream_mgr_remove_field(domain % streamManager, &
+ output_stream_name, regions % variables(v) % input_name)
+
+ v = v + 1
+ end if
+
+ b = b + 1
+ end do
+
+ deallocate(valid_input)
+
+ !
+ ! modify the stream
+ !
+
+ ! set up the variables and create output memory in stream
+ call mpas_stream_mgr_begin_iteration(domain % streamManager, &
+ output_stream_name, err)
+
+ ! fetch region names and name via regions
+ call mpas_pool_get_array(maskPool, REGION_NAMES_NAME, names)
+
+ last = regions % num_regions_per(regions % group_index)
+ ! allocate count and weight names
+ allocate(regions % count_zerod_names(last))
+ allocate(regions % weight_zerod_names(last))
+ allocate(regions % count_oned_names(last))
+ allocate(regions % weight_oned_names(last))
+ do b = 1, last
+ m = regions % groups(b, regions % group_index)
+
+ ! counts
+ regions % count_zerod_names(b) = output_naming(COUNT_TOKEN, &
+ ZEROD_TOKEN, fix_region_name(names(m)), instance)
+
+ call add_new_integer(domain % blocklist % allFields, amPool, amPool, &
+ regions % count_zerod_names(b))
+
+ ! add the field to the output stream
+ call mpas_stream_mgr_add_field(domain % streamManager, &
+ output_stream_name, regions % count_zerod_names(b), &
+ ierr=err)
+
+ ! create the counts and add to pool
+ if (active_vertical) then
+ ! count name
+ regions % count_oned_names(b) = output_naming(COUNT_TOKEN, &
+ ONED_TOKEN, fix_region_name(names(m)), instance)
+
+ call add_new_integer_1d(domain % blocklist % allFields, &
+ domain % blocklist % allFields, amPool, &
+ regions % vertical_mask, regions % count_oned_names(b), &
+ elem_name)
+
+ ! add the field to the output stream
+ call mpas_stream_mgr_add_field(domain % streamManager, &
+ output_stream_name, regions % count_oned_names(b), &
+ ierr=err)
+ end if
+
+ ! weights
+ if (regions % function_oned == MUL_FUNC) then
+ ! weight name
+ regions % weight_zerod_names(b) = &
+ output_naming(WEIGHT_TOKEN, &
+ ZEROD_TOKEN, fix_region_name(names(m)), instance)
+
+ call add_new_real(domain % blocklist % allFields, amPool, amPool, &
+ regions % weight_zerod_names(b))
+
+ ! add the field to the output stream
+ call mpas_stream_mgr_add_field(domain % streamManager, &
+ output_stream_name, regions % weight_zerod_names(b), &
+ ierr=err)
+ end if
+
+ if (regions % function_twod == MUL_FUNC) then
+ ! weight name
+ regions % weight_oned_names(b) = &
+ output_naming(WEIGHT_TOKEN, &
+ ONED_TOKEN, fix_region_name(names(m)), instance)
+
+ call add_new_real_1d(domain % blocklist % allFields, &
+ domain % blocklist % allFields, amPool, &
+ regions % vertical_mask, regions % weight_oned_names(b), &
+ elem_name)
+
+ ! add the field to the output stream
+ call mpas_stream_mgr_add_field(domain % streamManager, &
+ output_stream_name, regions % weight_oned_names(b), &
+ ierr=err)
+ end if
+ end do
+
+ do v = 1, regions % number_of_variables
+ ! allocate output names
+ allocate(regions % variables(v) % output_names(last))
+
+ ! get the info of the field
+ call mpas_pool_get_field_info(domain % blocklist % allFields, &
+ regions % variables(v) % input_name, info)
+
+ ! allocate output fields if the mask is active for this group
+ do b = 1, last
+ m = regions % groups(b, regions % group_index)
+
+ ! region name
+ regions % variables(v) % output_names(b) = output_naming(op_name, &
+ regions % variables(v) % input_name, &
+ fix_region_name(names(m)), instance)
+
+ ! create the field and add to pool,
+ ! also, set has_vertical if necessary
+ if (b == 1) then
+ if (active_vertical) then
+ call add_new_field(info, domain % blocklist % allFields, &
+ domain % blocklist % allFields, amPool, &
+ regions % variables(v) % input_name, &
+ regions % variables(v) % output_names(b), elem_name, &
+ regions % variables(v) % has_vertical, regions % vertical_dim)
+ else
+ call add_new_field(info, domain % blocklist % allFields, &
+ domain % blocklist % allFields, amPool, &
+ regions % variables(v) % input_name, &
+ regions % variables(v) % output_names(b), elem_name)
+
+ regions % variables(v) % has_vertical = 0
+ end if
+ else
+ call add_new_field(info, domain % blocklist % allFields, &
+ domain % blocklist % allFields, amPool, &
+ regions % variables(v) % input_name, &
+ regions % variables(v) % output_names(b), elem_name)
+ end if
+
+ ! add the field to the output stream
+ call mpas_stream_mgr_add_field(domain % streamManager, &
+ output_stream_name, regions % variables(v) % output_names(b), &
+ ierr=err)
+ end do
+ end do ! number_of_variables
+
+ ! clean up the instance memory
+ do v = 1, regions % number_of_variables
+ deallocate(regions % variables(v) % output_names)
+ end do
+ deallocate(regions % variables)
+ deallocate(regions % count_zerod_names)
+ deallocate(regions % weight_zerod_names)
+ deallocate(regions % count_oned_names)
+ deallocate(regions % weight_oned_names)
+end subroutine start_state
+
+
+
+!***********************************************************************
+! routine add_new_field
+!
+!> \brief Function to create a new field from an existing field
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> This routine conducts all initializations required for
+!> duplicating a field and adding it to a pool.
+!-----------------------------------------------------------------------
+subroutine add_new_field(info, all_fields, inpool, outpool, &
+ inname, outname, elem_name, &
+ has_vertical, vertical_dim)!{{{
+ ! input variables
+ type (mpas_pool_field_info_type), intent(in) :: info
+ type (mpas_pool_type), pointer, intent(inout) :: inpool, outpool, all_fields
+ character (len=StrKIND), intent(in) :: inname, outname, elem_name
+ integer, intent(out), optional :: has_vertical
+ character (len=StrKIND), intent(in), optional :: vertical_dim
+
+ ! input/output variables
+
+ ! output variables
+
+ ! local variables
+
+ ! duplicate field and add new field to inpool, outpool
+ if ((info % nDims == 0) .or. (info % fieldType /= MPAS_POOL_REAL)) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: the impossible happened. ' // &
+ 'Tried to create an output field for an input field that ' // &
+ 'regional stats AM cannot support.')
+ end if
+
+ if (info % nDims == 1) then
+ if (present(has_vertical)) then
+ call copy_field_1r(all_fields, inpool, outpool, &
+ inname, outname, elem_name, &
+ has_vertical, vertical_dim)
+ else
+ call copy_field_1r(all_fields, inpool, outpool, &
+ inname, outname, elem_name)
+ end if
+ else if (info % nDims == 2) then
+ if (present(has_vertical)) then
+ call copy_field_2r(all_fields, inpool, outpool, &
+ inname, outname, elem_name, &
+ has_vertical, vertical_dim)
+ else
+ call copy_field_2r(all_fields, inpool, outpool, &
+ inname, outname, elem_name)
+ end if
+ else if (info % nDims == 3) then
+ if (present(has_vertical)) then
+ call copy_field_3r(all_fields, inpool, outpool, &
+ inname, outname, elem_name, &
+ has_vertical, vertical_dim)
+ else
+ call copy_field_3r(all_fields, inpool, outpool, &
+ inname, outname, elem_name)
+ end if
+ else if (info % nDims == 4) then
+ if (present(has_vertical)) then
+ call copy_field_4r(all_fields, inpool, outpool, &
+ inname, outname, elem_name, &
+ has_vertical, vertical_dim)
+ else
+ call copy_field_4r(all_fields, inpool, outpool, &
+ inname, outname, elem_name)
+ end if
+ else
+ if (present(has_vertical)) then
+ call copy_field_5r(all_fields, inpool, outpool, &
+ inname, outname, elem_name, &
+ has_vertical, vertical_dim)
+ else
+ call copy_field_5r(all_fields, inpool, outpool, &
+ inname, outname, elem_name)
+ end if
+ end if
+
+end subroutine add_new_field!}}}
+
+
+
+!***********************************************************************
+! routine typed_operate
+!
+!> \brief Do the operation, but switch on run-time type
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> Since we don't know the type of the array, we need to do some
+!> run-time type switching based on the type of the array.
+!-----------------------------------------------------------------------
+subroutine typed_operate(dminfo, blocklist, regions, variable) !{{{
+
+ ! input variables
+ type (dm_info), pointer, intent(in) :: dminfo
+ type (block_type), pointer, intent(in) :: blocklist
+ type (regional_type), intent(in) :: regions
+ type (regional_variable_type), intent(in) :: variable
+
+ ! input/output variables
+
+ ! output variables
+
+ ! local variables
+ type (mpas_pool_field_info_type) :: info
+ integer, pointer :: levels
+
+ ! get the info
+ call mpas_pool_get_field_info(blocklist % allFields, &
+ variable % input_name, info)
+
+ if (variable % has_vertical /= 0) then
+ call mpas_pool_get_dimension(blocklist % dimensions, &
+ regions % vertical_dim, levels)
+ end if
+
+ ! switch based on the type, dimensionality, operation, and vertical dim
+ if (info % nDims == 1) then
+ if (regions % operation == AVG_OP) then
+ call operate1r_avg(dminfo, blocklist, regions, variable)
+ else if (regions % operation == MIN_OP) then
+ call operate1r_min(dminfo, blocklist, regions, variable)
+ else
+ call operate1r_max(dminfo, blocklist, regions, variable)
+ end if
+ else if (info % nDims == 2) then
+ if (regions % operation == AVG_OP) then
+ if (variable % has_vertical /= 0) then
+ call operatevert2r_avg(dminfo, blocklist, regions, variable, levels)
+ else
+ call operate2r_avg(dminfo, blocklist, regions, variable)
+ end if
+ else if (regions % operation == MIN_OP) then
+ if (variable % has_vertical /= 0) then
+ call operatevert2r_min(dminfo, blocklist, regions, variable, levels)
+ else
+ call operate2r_min(dminfo, blocklist, regions, variable)
+ end if
+ else
+ if (variable % has_vertical /= 0) then
+ call operatevert2r_max(dminfo, blocklist, regions, variable, levels)
+ else
+ call operate2r_max(dminfo, blocklist, regions, variable)
+ end if
+ end if
+ else if (info % nDims == 3) then
+ if (regions % operation == AVG_OP) then
+ if (variable % has_vertical /= 0) then
+ call operatevert3r_avg(dminfo, blocklist, regions, variable, levels)
+ else
+ call operate3r_avg(dminfo, blocklist, regions, variable)
+ end if
+ else if (regions % operation == MIN_OP) then
+ if (variable % has_vertical /= 0) then
+ call operatevert3r_min(dminfo, blocklist, regions, variable, levels)
+ else
+ call operate3r_min(dminfo, blocklist, regions, variable)
+ end if
+ else
+ if (variable % has_vertical /= 0) then
+ call operatevert3r_max(dminfo, blocklist, regions, variable, levels)
+ else
+ call operate3r_max(dminfo, blocklist, regions, variable)
+ end if
+ end if
+ else if (info % nDims == 4) then
+ if (regions % operation == AVG_OP) then
+ if (variable % has_vertical /= 0) then
+ call operatevert4r_avg(dminfo, blocklist, regions, variable, levels)
+ else
+ call operate4r_avg(dminfo, blocklist, regions, variable)
+ end if
+ else if (regions % operation == MIN_OP) then
+ if (variable % has_vertical /= 0) then
+ call operatevert4r_min(dminfo, blocklist, regions, variable, levels)
+ else
+ call operate4r_min(dminfo, blocklist, regions, variable)
+ end if
+ else
+ if (variable % has_vertical /= 0) then
+ call operatevert4r_max(dminfo, blocklist, regions, variable, levels)
+ else
+ call operate4r_max(dminfo, blocklist, regions, variable)
+ end if
+ end if
+ else
+ if (regions % operation == AVG_OP) then
+ if (variable % has_vertical /= 0) then
+ call operatevert5r_avg(dminfo, blocklist, regions, variable, levels)
+ else
+ call operate5r_avg(dminfo, blocklist, regions, variable)
+ end if
+ else if (regions % operation == MIN_OP) then
+ if (variable % has_vertical /= 0) then
+ call operatevert5r_min(dminfo, blocklist, regions, variable, levels)
+ else
+ call operate5r_min(dminfo, blocklist, regions, variable)
+ end if
+ else
+ if (variable % has_vertical /= 0) then
+ call operatevert5r_max(dminfo, blocklist, regions, variable, levels)
+ else
+ call operate5r_max(dminfo, blocklist, regions, variable)
+ end if
+ end if
+ end if
+
+end subroutine typed_operate!}}}
+
+
+
+!***********************************************************************
+! routine copy_field_X
+!
+!> \brief Functions to create a new N-1 D field from an existing ND field
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> This routine conducts initializations required for
+!> duplicating a ND field and adding a N-1D to the AM's pool.
+!> This will only create an output in the first block of a blocklist.
+!-----------------------------------------------------------------------
+subroutine copy_field_1r(all_fields, inpool, outpool, &
+ inname, outname, elem_name, &
+ has_vertical, vertical_dim)!{{{
+#include "regional_stats_inc/regional_field_1d_1.inc"
+ type (field1DReal), pointer :: src
+ type (field0DReal), pointer :: dst
+#include "regional_stats_inc/regional_field_1d_2.inc"
+end subroutine copy_field_1r!}}}
+
+
+subroutine copy_field_2r(all_fields, inpool, outpool, &
+ inname, outname, elem_name, &
+ has_vertical, vertical_dim)!{{{
+#include "regional_stats_inc/regional_field_nd_1.inc"
+ type (field2DReal), pointer :: src
+ type (field1DReal), pointer :: dst
+ integer, dimension(2) :: src_dims
+#include "regional_stats_inc/regional_field_nd_2.inc"
+ allocate(dst % array(src_dims(1)))
+#include "regional_stats_inc/regional_field_nd_3.inc"
+end subroutine copy_field_2r!}}}
+
+
+subroutine copy_field_3r(all_fields, inpool, outpool, &
+ inname, outname, elem_name, &
+ has_vertical, vertical_dim)!{{{
+#include "regional_stats_inc/regional_field_nd_1.inc"
+ type (field3DReal), pointer :: src
+ type (field2DReal), pointer :: dst
+ integer, dimension(3) :: src_dims
+#include "regional_stats_inc/regional_field_nd_2.inc"
+ allocate(dst % array(src_dims(1), src_dims(2)))
+#include "regional_stats_inc/regional_field_nd_3.inc"
+end subroutine copy_field_3r!}}}
+
+
+subroutine copy_field_4r(all_fields, inpool, outpool, &
+ inname, outname, elem_name, &
+ has_vertical, vertical_dim)!{{{
+#include "regional_stats_inc/regional_field_nd_1.inc"
+ type (field4DReal), pointer :: src
+ type (field3DReal), pointer :: dst
+ integer, dimension(4) :: src_dims
+#include "regional_stats_inc/regional_field_nd_2.inc"
+ allocate(dst % array(src_dims(1), src_dims(2), src_dims(3)))
+#include "regional_stats_inc/regional_field_nd_3.inc"
+end subroutine copy_field_4r!}}}
+
+
+subroutine copy_field_5r(all_fields, inpool, outpool, &
+ inname, outname, elem_name, &
+ has_vertical, vertical_dim)!{{{
+#include "regional_stats_inc/regional_field_nd_1.inc"
+ type (field5DReal), pointer :: src
+ type (field4DReal), pointer :: dst
+ integer, dimension(5) :: src_dims
+#include "regional_stats_inc/regional_field_nd_2.inc"
+ allocate(dst % array(src_dims(1), src_dims(2), src_dims(3), src_dims(4)))
+#include "regional_stats_inc/regional_field_nd_3.inc"
+end subroutine copy_field_5r!}}}
+
+
+
+!***********************************************************************
+! routine operateX_Y
+!
+!> \brief Series of subroutines to support operations on run-time types
+!> \author Jon Woodring
+!> \date December 17, 2015
+!> \details
+!> These subroutines encapsulate the different operations that can occur
+!> based on the run-time types. (This would likely be
+!> instantiated generics/templates in other languages.)
+!>
+!> We will do the reductions using slicing operations rather
+!> than for loops, and then copy to and from a flattened array,
+!> during distributed communication.
+!>
+!> This will be slower than for loops using flattened array output
+!> indexing on the first copy, because we're going to have to copy twice
+!> on the distributed communication. (Because the framework reduceAll
+!> only works for rank-1 arrays.) The reason to do this is that
+!> to preserve the dimensionality semantics for legibility and
+!> for fewer bugs in the reduction. Basically, we flatten and unflatten,
+!> and could remove the flatten, and reduce in a for loop with indexing
+!> on a flattened array, and then reshape. While it could be possible to
+!> do manual for loops without slicing, and increasing the code,
+!> I doubt the performance gain for doing one less copy of a small
+!> array will be that significant.
+!-----------------------------------------------------------------------
+
+subroutine operate2r_avg (dminfo, start_block, regions, variable)
+#include "regional_stats_inc/regional_op_start_1.inc"
+ real (kind=RKIND), dimension(:, :), pointer :: in_array
+ real (kind=RKIND), dimension(:), pointer :: out_array
+#include "regional_stats_inc/regional_op_start_2.inc"
+ out_array = 0
+#include "regional_stats_inc/regional_op_start_3.inc"
+
+#include "regional_stats_inc/regional_op_avg_1.inc"
+ out_array = out_array + in_array(:, i) * mask(m, i)
+#include "regional_stats_inc/regional_op_avg_2.inc"
+ out_array = out_array + in_array(:, i) * (weights(i) * mask(m, i))
+#include "regional_stats_inc/regional_op_avg_3.inc"
+end subroutine operate2r_avg
+
+
+subroutine operate5r_avg (dminfo, start_block, regions, variable)
+#include "regional_stats_inc/regional_op_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :, :, :), pointer :: out_array
+#include "regional_stats_inc/regional_op_start_2.inc"
+ out_array = 0
+#include "regional_stats_inc/regional_op_start_3.inc"
+
+#include "regional_stats_inc/regional_op_avg_1.inc"
+ out_array = out_array + in_array(:, :, :, :, i) * mask(m, i)
+#include "regional_stats_inc/regional_op_avg_2.inc"
+ out_array = out_array + in_array(:, :, :, :, i) * (weights(i) * mask(m, i))
+#include "regional_stats_inc/regional_op_avg_3.inc"
+end subroutine operate5r_avg
+
+
+subroutine operate4r_avg (dminfo, start_block, regions, variable)
+#include "regional_stats_inc/regional_op_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :, :), pointer :: out_array
+#include "regional_stats_inc/regional_op_start_2.inc"
+ out_array = 0
+#include "regional_stats_inc/regional_op_start_3.inc"
+
+#include "regional_stats_inc/regional_op_avg_1.inc"
+ out_array = out_array + in_array(:, :, :, i) * mask(m, i)
+#include "regional_stats_inc/regional_op_avg_2.inc"
+ out_array = out_array + in_array(:, :, :, i) * (weights(i) * mask(m, i))
+#include "regional_stats_inc/regional_op_avg_3.inc"
+end subroutine operate4r_avg
+
+
+subroutine operate3r_avg (dminfo, start_block, regions, variable)
+#include "regional_stats_inc/regional_op_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :), pointer :: out_array
+#include "regional_stats_inc/regional_op_start_2.inc"
+ out_array = 0
+#include "regional_stats_inc/regional_op_start_3.inc"
+
+#include "regional_stats_inc/regional_op_avg_1.inc"
+ out_array = out_array + in_array(:, :, i) * mask(m, i)
+#include "regional_stats_inc/regional_op_avg_2.inc"
+ out_array = out_array + in_array(:, :, i) * (weights(i) * mask(m, i))
+#include "regional_stats_inc/regional_op_avg_3.inc"
+end subroutine operate3r_avg
+
+
+subroutine operate1r_avg (dminfo, start_block, regions, variable)
+#include "regional_stats_inc/regional_op_start_1.inc"
+ real (kind=RKIND), dimension(:), pointer :: in_array
+ real (kind=RKIND), pointer :: out_array
+#include "regional_stats_inc/regional_op_start_2.inc"
+ out_array = 0
+#include "regional_stats_inc/regional_op_start_3.inc"
+
+#include "regional_stats_inc/regional_op_avg1d_1.inc"
+ out_array = out_array + in_array(i) * mask(m, i)
+#include "regional_stats_inc/regional_op_avg1d_2.inc"
+ out_array = out_array + in_array(i) * (weights(i) * mask(m, i))
+#include "regional_stats_inc/regional_op_avg1d_3.inc"
+end subroutine operate1r_avg
+
+
+subroutine operate2r_min (dminfo, start_block, regions, variable)
+#include "regional_stats_inc/regional_op_start_1.inc"
+ real (kind=RKIND), dimension(:, :), pointer :: in_array
+ real (kind=RKIND), dimension(:), pointer :: out_array
+#include "regional_stats_inc/regional_op_start_2.inc"
+ out_array = DEFAULT_MPAS_MAX_VALUE
+#include "regional_stats_inc/regional_op_start_3.inc"
+
+#include "regional_stats_inc/regional_op_min_1.inc"
+ out_array = min(out_array, &
+ in_array(:, i) * mask(m, i) + &
+ DEFAULT_MPAS_MAX_VALUE * (1 - mask(m, i)))
+#include "regional_stats_inc/regional_op_min_2.inc"
+end subroutine operate2r_min
+
+
+subroutine operate5r_min (dminfo, start_block, regions, variable)
+#include "regional_stats_inc/regional_op_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :, :, :), pointer :: out_array
+#include "regional_stats_inc/regional_op_start_2.inc"
+ out_array = DEFAULT_MPAS_MAX_VALUE
+#include "regional_stats_inc/regional_op_start_3.inc"
+
+#include "regional_stats_inc/regional_op_min_1.inc"
+ out_array = min(out_array, &
+ in_array(:, :, :, :, i) * mask(m, i) + &
+ DEFAULT_MPAS_MAX_VALUE * (1 - mask(m, i)))
+#include "regional_stats_inc/regional_op_min_2.inc"
+end subroutine operate5r_min
+
+
+subroutine operate4r_min (dminfo, start_block, regions, variable)
+#include "regional_stats_inc/regional_op_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :, :), pointer :: out_array
+#include "regional_stats_inc/regional_op_start_2.inc"
+ out_array = DEFAULT_MPAS_MAX_VALUE
+#include "regional_stats_inc/regional_op_start_3.inc"
+
+#include "regional_stats_inc/regional_op_min_1.inc"
+ out_array = min(out_array, &
+ in_array(:, :, :, i) * mask(m, i) + &
+ DEFAULT_MPAS_MAX_VALUE * (1 - mask(m, i)))
+#include "regional_stats_inc/regional_op_min_2.inc"
+end subroutine operate4r_min
+
+
+subroutine operate3r_min (dminfo, start_block, regions, variable)
+#include "regional_stats_inc/regional_op_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :), pointer :: out_array
+#include "regional_stats_inc/regional_op_start_2.inc"
+ out_array = DEFAULT_MPAS_MAX_VALUE
+#include "regional_stats_inc/regional_op_start_3.inc"
+
+#include "regional_stats_inc/regional_op_min_1.inc"
+ out_array = min(out_array, &
+ in_array(:, :, i) * mask(m, i) + &
+ DEFAULT_MPAS_MAX_VALUE * (1 - mask(m, i)))
+#include "regional_stats_inc/regional_op_min_2.inc"
+end subroutine operate3r_min
+
+
+subroutine operate1r_min (dminfo, start_block, regions, variable)
+#include "regional_stats_inc/regional_op_start_1.inc"
+ real (kind=RKIND), dimension(:), pointer :: in_array
+ real (kind=RKIND), pointer :: out_array
+#include "regional_stats_inc/regional_op_start_2.inc"
+ out_array = DEFAULT_MPAS_MAX_VALUE
+#include "regional_stats_inc/regional_op_start_3.inc"
+
+#include "regional_stats_inc/regional_op_min1d_1.inc"
+ out_array = min(out_array, &
+ in_array(i) * mask(m, i) + &
+ DEFAULT_MPAS_MAX_VALUE * (1 - mask(m, i)))
+#include "regional_stats_inc/regional_op_min1d_2.inc"
+end subroutine operate1r_min
+
+
+subroutine operate2r_max (dminfo, start_block, regions, variable)
+#include "regional_stats_inc/regional_op_start_1.inc"
+ real (kind=RKIND), dimension(:, :), pointer :: in_array
+ real (kind=RKIND), dimension(:), pointer :: out_array
+#include "regional_stats_inc/regional_op_start_2.inc"
+ out_array = DEFAULT_MPAS_MIN_VALUE
+#include "regional_stats_inc/regional_op_start_3.inc"
+
+#include "regional_stats_inc/regional_op_max_1.inc"
+ out_array = max(out_array, &
+ in_array(:, i) * mask(m, i) + &
+ DEFAULT_MPAS_MIN_VALUE * (1 - mask(m, i)))
+#include "regional_stats_inc/regional_op_max_2.inc"
+end subroutine operate2r_max
+
+
+subroutine operate5r_max (dminfo, start_block, regions, variable)
+#include "regional_stats_inc/regional_op_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :, :, :), pointer :: out_array
+#include "regional_stats_inc/regional_op_start_2.inc"
+ out_array = DEFAULT_MPAS_MIN_VALUE
+#include "regional_stats_inc/regional_op_start_3.inc"
+
+#include "regional_stats_inc/regional_op_max_1.inc"
+ out_array = max(out_array, &
+ in_array(:, :, :, :, i) * mask(m, i) + &
+ DEFAULT_MPAS_MIN_VALUE * (1 - mask(m, i)))
+#include "regional_stats_inc/regional_op_max_2.inc"
+end subroutine operate5r_max
+
+
+subroutine operate4r_max (dminfo, start_block, regions, variable)
+#include "regional_stats_inc/regional_op_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :, :), pointer :: out_array
+#include "regional_stats_inc/regional_op_start_2.inc"
+ out_array = DEFAULT_MPAS_MIN_VALUE
+#include "regional_stats_inc/regional_op_start_3.inc"
+
+#include "regional_stats_inc/regional_op_max_1.inc"
+ out_array = max(out_array, &
+ in_array(:, :, :, i) * mask(m, i) + &
+ DEFAULT_MPAS_MIN_VALUE * (1 - mask(m, i)))
+#include "regional_stats_inc/regional_op_max_2.inc"
+end subroutine operate4r_max
+
+
+subroutine operate3r_max (dminfo, start_block, regions, variable)
+#include "regional_stats_inc/regional_op_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :), pointer :: out_array
+#include "regional_stats_inc/regional_op_start_2.inc"
+ out_array = DEFAULT_MPAS_MIN_VALUE
+#include "regional_stats_inc/regional_op_start_3.inc"
+
+#include "regional_stats_inc/regional_op_max_1.inc"
+ out_array = max(out_array, &
+ in_array(:, :, i) * mask(m, i) + &
+ DEFAULT_MPAS_MIN_VALUE * (1 - mask(m, i)))
+#include "regional_stats_inc/regional_op_max_2.inc"
+end subroutine operate3r_max
+
+
+subroutine operate1r_max (dminfo, start_block, regions, variable)
+#include "regional_stats_inc/regional_op_start_1.inc"
+ real (kind=RKIND), dimension(:), pointer :: in_array
+ real (kind=RKIND), pointer :: out_array
+#include "regional_stats_inc/regional_op_start_2.inc"
+ out_array = DEFAULT_MPAS_MIN_VALUE
+#include "regional_stats_inc/regional_op_start_3.inc"
+
+#include "regional_stats_inc/regional_op_max1d_1.inc"
+ out_array = max(out_array, &
+ in_array(i) * mask(m, i) + &
+ DEFAULT_MPAS_MIN_VALUE * (1 - mask(m, i)))
+#include "regional_stats_inc/regional_op_max1d_2.inc"
+end subroutine operate1r_max
+
+
+subroutine operatevert2r_avg (dminfo, start_block, regions, variable, levels)
+#include "regional_stats_inc/regional_opvert_start_1.inc"
+ real (kind=RKIND), dimension(:, :), pointer :: in_array
+ real (kind=RKIND), dimension(:), pointer :: out_array
+#include "regional_stats_inc/regional_opvert_start_2.inc"
+ out_array = 0
+#include "regional_stats_inc/regional_opvert_start_3.inc"
+
+#include "regional_stats_inc/regional_opvert_avg_1.inc"
+ out_array(v) = out_array(v) + in_array(v, i) * &
+ (mask(m, i) * vertical_mask(v, i))
+#include "regional_stats_inc/regional_opvert_avg_2.inc"
+ out_array(v) = out_array(v) + in_array(v, i) * &
+ (weights(v, i) * (mask(m, i) * vertical_mask(v, i)))
+#include "regional_stats_inc/regional_opvert_avg_3.inc"
+ do v = 1, levels
+ if (count_array(v) > 0) then
+ if (regions % function_twod == ID_FUNC) then
+ out_array(v) = out_array(v) / count_array(v)
+ else
+ out_array(v) = out_array(v) / weight_total(v)
+ end if
+ end if
+ end do
+#include "regional_stats_inc/regional_opvert_avg_4.inc"
+end subroutine operatevert2r_avg
+
+
+subroutine operatevert5r_avg (dminfo, start_block, regions, variable, levels)
+#include "regional_stats_inc/regional_opvert_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :, :, :), pointer :: out_array
+#include "regional_stats_inc/regional_opvert_start_2.inc"
+ out_array = 0
+#include "regional_stats_inc/regional_opvert_start_3.inc"
+
+#include "regional_stats_inc/regional_opvert_avg_1.inc"
+ out_array(:, :, :, v) = out_array(:, :, :, v) + in_array(:, :, :, v, i) * &
+ (mask(m, i) * vertical_mask(v, i))
+#include "regional_stats_inc/regional_opvert_avg_2.inc"
+ out_array(:, :, :, v) = out_array(:, :, :, v) + in_array(:, :, :, v, i) * &
+ (weights(v, i) * (mask(m, i) * vertical_mask(v, i)))
+#include "regional_stats_inc/regional_opvert_avg_3.inc"
+ do v = 1, levels
+ if (count_array(v) > 0) then
+ if (regions % function_twod == ID_FUNC) then
+ out_array(:, :, :, v) = out_array(:, :, :, v) / count_array(v)
+ else
+ out_array(:, :, :, v) = out_array(:, :, :, v) / weight_total(v)
+ end if
+ end if
+ end do
+#include "regional_stats_inc/regional_opvert_avg_4.inc"
+end subroutine operatevert5r_avg
+
+
+subroutine operatevert4r_avg (dminfo, start_block, regions, variable, levels)
+#include "regional_stats_inc/regional_opvert_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :, :), pointer :: out_array
+#include "regional_stats_inc/regional_opvert_start_2.inc"
+ out_array = 0
+#include "regional_stats_inc/regional_opvert_start_3.inc"
+
+#include "regional_stats_inc/regional_opvert_avg_1.inc"
+ out_array(:, :, v) = out_array(:, :, v) + in_array(:, :, v, i) * &
+ (mask(m, i) * vertical_mask(v, i))
+#include "regional_stats_inc/regional_opvert_avg_2.inc"
+ out_array(:, :, v) = out_array(:, :, v) + in_array(:, :, v, i) * &
+ (weights(v, i) * (mask(m, i) * vertical_mask(v, i)))
+#include "regional_stats_inc/regional_opvert_avg_3.inc"
+ do v = 1, levels
+ if (count_array(v) > 0) then
+ if (regions % function_twod == ID_FUNC) then
+ out_array(:, :, v) = out_array(:, :, v) / count_array(v)
+ else
+ out_array(:, :, v) = out_array(:, :, v) / weight_total(v)
+ end if
+ end if
+ end do
+#include "regional_stats_inc/regional_opvert_avg_4.inc"
+end subroutine operatevert4r_avg
+
+
+subroutine operatevert3r_avg (dminfo, start_block, regions, variable, levels)
+#include "regional_stats_inc/regional_opvert_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :), pointer :: out_array
+#include "regional_stats_inc/regional_opvert_start_2.inc"
+ out_array = 0
+#include "regional_stats_inc/regional_opvert_start_3.inc"
+
+#include "regional_stats_inc/regional_opvert_avg_1.inc"
+ out_array(:, v) = out_array(:, v) + in_array(:, v, i) * &
+ (mask(m, i) * vertical_mask(v, i))
+#include "regional_stats_inc/regional_opvert_avg_2.inc"
+ out_array(:, v) = out_array(:, v) + in_array(:, v, i) * &
+ (weights(v, i) * (mask(m, i) * vertical_mask(v, i)))
+#include "regional_stats_inc/regional_opvert_avg_3.inc"
+ do v = 1, levels
+ if (count_array(v) > 0) then
+ if (regions % function_twod == ID_FUNC) then
+ out_array(:, v) = out_array(:, v) / count_array(v)
+ else
+ out_array(:, v) = out_array(:, v) / weight_total(v)
+ end if
+ end if
+ end do
+#include "regional_stats_inc/regional_opvert_avg_4.inc"
+end subroutine operatevert3r_avg
+
+
+subroutine operatevert2r_min (dminfo, start_block, regions, variable, levels)
+#include "regional_stats_inc/regional_opvert_start_1.inc"
+ real (kind=RKIND), dimension(:, :), pointer :: in_array
+ real (kind=RKIND), dimension(:), pointer :: out_array
+#include "regional_stats_inc/regional_opvert_start_2.inc"
+ out_array = DEFAULT_MPAS_MAX_VALUE
+#include "regional_stats_inc/regional_opvert_start_3.inc"
+
+#include "regional_stats_inc/regional_opvert_min_1.inc"
+ out_array(v) = min(out_array(v), &
+ in_array(v, i) * (mask(m, i) * vertical_mask(v, i)) + &
+ DEFAULT_MPAS_MAX_VALUE * (1 - (mask(m, i) * vertical_mask(v, i))))
+#include "regional_stats_inc/regional_opvert_min_2.inc"
+end subroutine operatevert2r_min
+
+
+subroutine operatevert5r_min (dminfo, start_block, regions, variable, levels)
+#include "regional_stats_inc/regional_opvert_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :, :, :), pointer :: out_array
+#include "regional_stats_inc/regional_opvert_start_2.inc"
+ out_array = DEFAULT_MPAS_MAX_VALUE
+#include "regional_stats_inc/regional_opvert_start_3.inc"
+
+#include "regional_stats_inc/regional_opvert_min_1.inc"
+ out_array(:, :, :, v) = min(out_array(:, :, :, v), &
+ in_array(:, :, :, v, i) * (mask(m, i) * vertical_mask(v, i)) + &
+ DEFAULT_MPAS_MAX_VALUE * (1 - (mask(m, i) * vertical_mask(v, i))))
+#include "regional_stats_inc/regional_opvert_min_2.inc"
+end subroutine operatevert5r_min
+
+
+subroutine operatevert4r_min (dminfo, start_block, regions, variable, levels)
+#include "regional_stats_inc/regional_opvert_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :, :), pointer :: out_array
+#include "regional_stats_inc/regional_opvert_start_2.inc"
+ out_array = DEFAULT_MPAS_MAX_VALUE
+#include "regional_stats_inc/regional_opvert_start_3.inc"
+
+#include "regional_stats_inc/regional_opvert_min_1.inc"
+ out_array(:, :, v) = min(out_array(:, :, v), &
+ in_array(:, :, v, i) * (mask(m, i) * vertical_mask(v, i)) + &
+ DEFAULT_MPAS_MAX_VALUE * (1 - (mask(m, i) * vertical_mask(v, i))))
+#include "regional_stats_inc/regional_opvert_min_2.inc"
+end subroutine operatevert4r_min
+
+
+subroutine operatevert3r_min (dminfo, start_block, regions, variable, levels)
+#include "regional_stats_inc/regional_opvert_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :), pointer :: out_array
+#include "regional_stats_inc/regional_opvert_start_2.inc"
+ out_array = DEFAULT_MPAS_MAX_VALUE
+#include "regional_stats_inc/regional_opvert_start_3.inc"
+
+#include "regional_stats_inc/regional_opvert_min_1.inc"
+ out_array(:, v) = min(out_array(:, v), &
+ in_array(:, v, i) * (mask(m, i) * vertical_mask(v, i)) + &
+ DEFAULT_MPAS_MAX_VALUE * (1 - (mask(m, i) * vertical_mask(v, i))))
+#include "regional_stats_inc/regional_opvert_min_2.inc"
+end subroutine operatevert3r_min
+
+
+subroutine operatevert2r_max (dminfo, start_block, regions, variable, levels)
+#include "regional_stats_inc/regional_opvert_start_1.inc"
+ real (kind=RKIND), dimension(:, :), pointer :: in_array
+ real (kind=RKIND), dimension(:), pointer :: out_array
+#include "regional_stats_inc/regional_opvert_start_2.inc"
+ out_array = DEFAULT_MPAS_MIN_VALUE
+#include "regional_stats_inc/regional_opvert_start_3.inc"
+
+#include "regional_stats_inc/regional_opvert_max_1.inc"
+ out_array(v) = max(out_array(v), &
+ in_array(v, i) * (mask(m, i) * vertical_mask(v, i)) + &
+ DEFAULT_MPAS_MIN_VALUE * (1 - (mask(m, i) * vertical_mask(v, i))))
+#include "regional_stats_inc/regional_opvert_max_2.inc"
+end subroutine operatevert2r_max
+
+
+subroutine operatevert5r_max (dminfo, start_block, regions, variable, levels)
+#include "regional_stats_inc/regional_opvert_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :, :, :), pointer :: out_array
+#include "regional_stats_inc/regional_opvert_start_2.inc"
+ out_array = DEFAULT_MPAS_MIN_VALUE
+#include "regional_stats_inc/regional_opvert_start_3.inc"
+
+#include "regional_stats_inc/regional_opvert_max_1.inc"
+ out_array(:, :, :, v) = max(out_array(:, :, :, v), &
+ in_array(:, :, :, v, i) * (mask(m, i) * vertical_mask(v, i)) + &
+ DEFAULT_MPAS_MIN_VALUE * (1 - (mask(m, i) * vertical_mask(v, i))))
+#include "regional_stats_inc/regional_opvert_max_2.inc"
+end subroutine operatevert5r_max
+
+
+subroutine operatevert4r_max (dminfo, start_block, regions, variable, levels)
+#include "regional_stats_inc/regional_opvert_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :, :), pointer :: out_array
+#include "regional_stats_inc/regional_opvert_start_2.inc"
+ out_array = DEFAULT_MPAS_MIN_VALUE
+#include "regional_stats_inc/regional_opvert_start_3.inc"
+
+#include "regional_stats_inc/regional_opvert_max_1.inc"
+ out_array(:, :, v) = max(out_array(:, :, v), &
+ in_array(:, :, v, i) * (mask(m, i) * vertical_mask(v, i)) + &
+ DEFAULT_MPAS_MIN_VALUE * (1 - (mask(m, i) * vertical_mask(v, i))))
+#include "regional_stats_inc/regional_opvert_max_2.inc"
+end subroutine operatevert4r_max
+
+
+subroutine operatevert3r_max (dminfo, start_block, regions, variable, levels)
+#include "regional_stats_inc/regional_opvert_start_1.inc"
+ real (kind=RKIND), dimension(:, :, :), pointer :: in_array
+ real (kind=RKIND), dimension(:, :), pointer :: out_array
+#include "regional_stats_inc/regional_opvert_start_2.inc"
+ out_array = DEFAULT_MPAS_MIN_VALUE
+#include "regional_stats_inc/regional_opvert_start_3.inc"
+
+#include "regional_stats_inc/regional_opvert_max_1.inc"
+ out_array(:, v) = max(out_array(:, v), &
+ in_array(:, v, i) * (mask(m, i) * vertical_mask(v, i)) + &
+ DEFAULT_MPAS_MIN_VALUE * (1 - (mask(m, i) * vertical_mask(v, i))))
+#include "regional_stats_inc/regional_opvert_max_2.inc"
+end subroutine operatevert3r_max
+
+
+end module ocn_regional_stats
+! vim: foldmethod=marker
diff --git a/src/core_ocean/analysis_members/mpas_ocn_rpn_calculator.F b/src/core_ocean/analysis_members/mpas_ocn_rpn_calculator.F
new file mode 100644
index 0000000000..f47a56b3ac
--- /dev/null
+++ b/src/core_ocean/analysis_members/mpas_ocn_rpn_calculator.F
@@ -0,0 +1,1240 @@
+! Copyright (c) 2015, 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
+!
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! ocn_rpn_calculator
+!
+!> \brief MPAS ocean analysis core member: rpn_calculator
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details
+!> Flexible vector RPN calculator of MPAS fields for up to 2D fields.
+!-----------------------------------------------------------------------
+module ocn_rpn_calculator
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_dmpar
+ use mpas_timekeeping
+ use mpas_stream_manager
+
+ use ocn_constants
+ use ocn_diagnostics_routines
+
+ implicit none
+ private
+ save
+
+ ! Public parameters
+ !--------------------------------------------------------------------
+
+ ! Public member functions
+ !--------------------------------------------------------------------
+ public :: &
+ ocn_init_rpn_calculator, &
+ ocn_compute_rpn_calculator, &
+ ocn_restart_rpn_calculator, &
+ ocn_finalize_rpn_calculator
+
+ ! Private module variables
+ !--------------------------------------------------------------------
+
+ type rpn_stack_value_type
+ integer :: symbol_type
+ integer :: number_of_dims
+
+ type (field0DReal), pointer :: d0
+ type (field1DReal), pointer :: d1
+ type (field2DReal), pointer :: d2
+ end type rpn_stack_value_type
+
+ integer, parameter :: SYMBOL_NOT_FOUND = 0
+
+ integer, parameter :: IS_OPERATOR = 10
+ integer, parameter :: IS_VARIABLE = 100
+ integer, parameter :: IS_TEMPORARY = 1000
+
+ integer, parameter :: MAX_STACK_SIZE = StrKIND / 2
+
+ character (len=1), dimension(8), parameter :: variable_names = &
+ (/ 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h' /)
+ character (len=3), dimension(4) :: operator_names = &
+ (/ '* ' , '+ ', '- ', '/ ' /)
+ integer, parameter :: MUL_OP = 1
+ integer, parameter :: PLUS_OP = 2
+ integer, parameter :: MINUS_OP = 3
+ integer, parameter :: DIV_OP = 4
+ ! TODO FIXME
+ ! integer, parameter :: SUM_OP = 5
+
+ character (len=1), dimension(4) :: expression_names = &
+ (/ '1', '2', '3', '4' /)
+
+ character (len=StrKIND), parameter :: VARIABLE_PREFIX = &
+ 'config_AM_rpnCalculator_variable_'
+ character (len=StrKIND), parameter :: EXPRESSION_PREFIX = &
+ 'config_AM_rpnCalculator_expression_'
+ character (len=StrKIND), parameter :: OUTPUT_PREFIX = &
+ 'config_AM_rpnCalculator_output_name_'
+
+ character (len=StrKIND), parameter :: OUTPUT_STREAM_CONFIG = &
+ 'config_AM_rpnCalculator_output_stream'
+
+ character (len=StrKIND), parameter :: NONE_TOKEN = 'none'
+
+ character (len=StrKIND), parameter :: MPAS_CORE_NAME = 'MPAS-Ocean'
+
+!***********************************************************************
+contains
+
+
+
+!***********************************************************************
+! routine ocn_init_rpn_calculator
+!
+!> \brief Initialize MPAS-Ocean analysis member
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details
+!> This routine conducts all initializations required for the
+!> MPAS-Ocean analysis member.
+!-----------------------------------------------------------------------
+subroutine ocn_init_rpn_calculator(domain, err)!{{{
+ ! input variables
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+
+ ! output variables
+ integer, intent(out) :: err !< Output: error flag
+
+ ! local variables
+ integer :: i, last, stack_pointer
+ character (len=StrKIND) :: config, field_name
+ character (len=StrKIND), pointer :: config_result
+ type (rpn_stack_value_type) :: output_value
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE) :: stack
+
+ ! start procedure
+ err = 0
+
+ ! typecheck all the expressions
+ last = size(expression_names)
+ do i = 1, last
+ config = trim(EXPRESSION_PREFIX) // trim(expression_names(i))
+ call mpas_pool_get_config(domain % configs, config, config_result)
+
+ if (trim(config_result) /= trim(NONE_TOKEN)) then
+ stack_pointer = -1 ! typecheck with an empty stack
+ call eval_expression(domain, config_result, i, stack, stack_pointer)
+
+ ! check the stack size
+ if (stack_pointer /= 1) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'expression #' // trim(expression_names(i)) // &
+ ' in the RPN calculator AM ' // &
+ 'resulted in the stack size not being equal to 1: ' // &
+ 'i.e., the return result of the expression should be the only ' // &
+ 'value on the stack after evaluation')
+ end if
+
+ ! check that it's a new value
+ if (stack(stack_pointer) % symbol_type /= IS_TEMPORARY) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'expression #' // trim(expression_names(i)) // &
+ ' in the RPN calculator AM did not calculate anything, ' // &
+ ' i.e., it only pushed a variable onto the stack')
+ end if
+
+ ! rename the stack field and put in allFields pool
+ config = trim(OUTPUT_PREFIX) // trim(expression_names(i))
+ call mpas_pool_get_config(domain % configs, config, config_result)
+
+ if (trim(config_result) == (NONE_TOKEN)) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'expression #' // trim(expression_names(i)) // &
+ ' in the RPN calculator AM was set, but the output field name ' // &
+ 'for that expression was set to "none"')
+ end if
+
+ if (stack(1) % number_of_dims == 0) then
+ stack(1) % d0 % fieldName = config_result
+ call mpas_pool_add_field(domain % blocklist % allFields, &
+ config_result, stack(1) % d0)
+ else if (stack(1) % number_of_dims == 1) then
+ stack(1) % d1 % fieldName = config_result
+ call mpas_pool_add_field(domain % blocklist % allFields, &
+ config_result, stack(1) % d1)
+ else if (stack(1) % number_of_dims == 2) then
+ stack(1) % d2 % fieldName = config_result
+ call mpas_pool_add_field(domain % blocklist % allFields, &
+ config_result, stack(1) % d2)
+ else
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'the impossible happened, the dimensions of the result on the ' // &
+ 'stack, for expression #' // trim(expression_names(i)) // &
+ ' was not between 0 and 2 in the RPN calculator AM')
+ end if
+ field_name = config_result
+
+ ! put them in the stream if necessary
+ call mpas_pool_get_config(domain % configs, &
+ OUTPUT_STREAM_CONFIG, config_result)
+
+ if (trim(config_result) /= trim(NONE_TOKEN)) then
+ call mpas_stream_mgr_add_field(domain % streamManager, &
+ config_result, field_name, ierr=err)
+ end if
+ end if
+ end do
+
+end subroutine ocn_init_rpn_calculator!}}}
+
+
+
+!***********************************************************************
+! routine ocn_compute_rpn_calculator
+!
+!> \brief Compute MPAS-Ocean analysis member
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details
+!> This routine conducts all computation required for this
+!> MPAS-Ocean analysis member.
+!-----------------------------------------------------------------------
+subroutine ocn_compute_rpn_calculator(domain, timeLevel, err)!{{{
+ ! input variables
+ integer, intent(in) :: timeLevel
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+
+ ! output variables
+ integer, intent(out) :: err !< Output: error flag
+
+ ! local variables
+ integer :: i, stack_pointer, last
+ character (len=StrKIND) :: config
+ character (len=StrKIND), pointer :: config_result
+ type (rpn_stack_value_type) :: output_value
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE) :: stack
+ type (field0DReal), pointer :: d0
+ type (field1DReal), pointer :: d1, t1
+ type (field2DReal), pointer :: d2, t2
+ real (kind=RKIND), dimension(:), pointer :: s1
+ real (kind=RKIND), dimension(:,:), pointer :: s2
+
+ ! start procedure
+ err = 0
+
+ ! do all the expressions
+ last = size(expression_names)
+ do i = 1, last
+ config = trim(EXPRESSION_PREFIX) // trim(expression_names(i))
+ call mpas_pool_get_config(domain % configs, config, config_result)
+
+ if (trim(config_result) /= trim(NONE_TOKEN)) then
+ stack_pointer = 0 ! evaluate with an empty stack
+ call eval_expression(domain, config_result, i, stack, stack_pointer)
+
+ ! lookup the field and reassign pointers - then deallocate stack
+ config = trim(OUTPUT_PREFIX) // trim(expression_names(i))
+ call mpas_pool_get_config(domain % configs, config, config_result)
+ if (stack(1) % number_of_dims == 0) then
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ config_result, d0, 1)
+ d0 % scalar = stack(1) % d0 % scalar
+ call mpas_deallocate_field(stack(1) % d0)
+ else if (stack(1) % number_of_dims == 1) then
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ config_result, d1, 1)
+ t1 => stack(1) % d1
+ do while (associated(d1))
+ s1 => d1 % array
+ d1 % array => t1 % array
+ t1 % array => s1
+
+ d1 => d1 % next
+ t1 => t1 % next
+ end do
+ call mpas_deallocate_field(stack(1) % d1)
+ else
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ config_result, d2, 1)
+ t2 => stack(1) % d2
+ do while (associated(d2))
+ s2 => d2 % array
+ d2 % array => t2 % array
+ t2 % array => s2
+
+ d2 => d2 % next
+ t2 => t2 % next
+ end do
+ call mpas_deallocate_field(stack(1) % d2)
+ end if
+
+ end if
+ end do
+
+end subroutine ocn_compute_rpn_calculator!}}}
+
+
+
+!***********************************************************************
+! routine ocn_restart_rpn_calculator
+!
+!> \brief Save restart for MPAS-Ocean analysis member
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details
+!> This routine conducts computation required to save a restart state
+!> for the MPAS-Ocean analysis member.
+!-----------------------------------------------------------------------
+subroutine ocn_restart_rpn_calculator(domain, err)!{{{
+ ! input variables
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+
+ ! output variables
+ integer, intent(out) :: err !< Output: error flag
+
+ ! local variables
+
+ ! start procedure
+ err = 0
+
+end subroutine ocn_restart_rpn_calculator!}}}
+
+
+
+!***********************************************************************
+! routine ocn_finalize_rpn_calculator
+!
+!> \brief Finalize MPAS-Ocean analysis member
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details
+!> This routine conducts all finalizations required for this
+!> MPAS-Ocean analysis member.
+!-----------------------------------------------------------------------
+subroutine ocn_finalize_rpn_calculator(domain, err)!{{{
+ ! input variables
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+
+ ! output variables
+ integer, intent(out) :: err !< Output: error flag
+
+ ! local variables
+
+ ! start procedure
+ err = 0
+
+end subroutine ocn_finalize_rpn_calculator!}}}
+
+!
+! local subroutines
+!
+
+!***********************************************************************
+! routine eval_expression
+!
+!> \brief Given a character string, evaluate the stack expression
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details Given a character string, evaluate the stack expression
+!> and copy the bottom (top) of a 1-length stack into the target MPAS field.
+!-----------------------------------------------------------------------
+subroutine eval_expression (domain, expression, exp_number, &
+ stack, stack_pointer)!{{{
+ ! input variables
+ character (len=StrKIND), intent(in) :: expression
+ integer, intent(in) :: exp_number
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+
+ ! output variables
+
+ ! local variables
+ integer :: symbol_type
+ logical :: eol, typechecking
+ character (len=StrKIND) :: symbol, remainder
+
+ ! start procedure
+ if(stack_pointer < 0) then
+ typechecking = .true.
+ stack_pointer = -1 - stack_pointer
+ else
+ typechecking = .false.
+ end if
+
+ eol = .false.
+ remainder = expression
+
+ ! get the first symbol
+ call stack_token(symbol, remainder, eol)
+
+ ! iterate over symbols
+ do while(.not. eol)
+ symbol_type = symbol_table(symbol)
+
+ ! operator
+ if ((symbol_type > IS_OPERATOR) .and. (symbol_type < IS_VARIABLE)) then
+ call eval_operator(exp_number, &
+ symbol_type - IS_OPERATOR, stack, stack_pointer, typechecking)
+ ! variable
+ else &
+ if ((symbol_type > IS_VARIABLE) .and. (symbol_type < IS_TEMPORARY)) then
+ call eval_variable(domain, exp_number, &
+ symbol_type - IS_VARIABLE, stack, stack_pointer, typechecking)
+ ! symbol not found
+ else
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: "' // &
+ trim(symbol) // '" found in expression #' // &
+ trim(expression_names(exp_number)) // &
+ ' in the RPN calculator AM was not found.')
+ end if
+
+ ! get the next symbol
+ call stack_token(symbol, remainder, eol)
+ end do
+
+end subroutine eval_expression!}}}
+
+
+
+!***********************************************************************
+! routine stack_token
+!
+!> \brief Get the next stack token given a character string
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details Parses a character string to get the next stack token to eval.
+!-----------------------------------------------------------------------
+subroutine stack_token(substr, next, eol)!{{{
+ ! input variables
+
+ ! input/output variables
+ character (len=StrKIND), intent(inout) :: next
+
+ ! output variables
+ character (len=StrKIND), intent(out) :: substr
+ logical, intent(out) :: eol
+
+ ! local variables
+ integer :: i
+ character (len=StrKIND) :: copy
+
+ ! make a copy
+ copy = trim(next)
+
+ ! if there's anything in it other than whitespace, pass through
+ i = verify(copy, ' ')
+ eol = i < 1
+ if (eol) then
+ return
+ end if
+ copy = trim(next(i:))
+
+ ! find the first whitespace and split
+ i = scan(copy, ' ')
+
+ ! return that substring and the remainder
+ if (i > 0) then
+ substr = trim(copy(1:i-1))
+ next = trim(copy(i+1:))
+ else
+ substr = trim(copy)
+ next = ''
+ end if
+
+end subroutine stack_token!}}}
+
+
+
+!***********************************************************************
+! function symbol_table
+!
+!> \brief Tries to find the symbol in the symbol table and its value
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details Will attempt to find a symbol in the symbol table. The value
+!> results are dependent on the return code of the symbol table lookup.
+!-----------------------------------------------------------------------
+integer function symbol_table (symbol)!{{{
+ ! input variables
+ character (len=StrKIND), intent(in) :: symbol
+
+ ! input/output variables
+
+ ! local variables
+ integer :: i, last
+
+ ! start procedure
+
+ ! check the operations
+ last = size(variable_names)
+ do i = 1, last
+ if (trim(symbol) == trim(variable_names(i))) then
+ symbol_table = IS_VARIABLE + i
+ return
+ end if
+ end do
+
+ ! check the variables
+ last = size(operator_names)
+ do i = 1, last
+ if (trim(symbol) == trim(operator_names(i))) then
+ symbol_table = IS_OPERATOR + i
+ return
+ end if
+ end do
+
+ ! else not found
+ symbol_table = SYMBOL_NOT_FOUND
+
+end function symbol_table!}}}
+
+
+
+!***********************************************************************
+! routine eval_operator
+!
+!> \brief Given a operator index number, put it on the stack
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details Given a operator index number, put the result on the top of
+!> the stack. It will combine whatever is on the stack to be able to
+!> generate results and push them into the stack.
+!-----------------------------------------------------------------------
+subroutine eval_operator (exp_number, &
+ op_index, stack, stack_pointer, type_checking)!{{{
+ ! input variables
+ integer, intent(in) :: exp_number, op_index
+ logical, intent(in) :: type_checking
+
+ ! input/output variables
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+
+ ! output variables
+
+ ! local variables
+
+ ! start procedure
+ if (op_index == MUL_OP) then
+ call mul_operator(exp_number, stack, stack_pointer, type_checking)
+ else if (op_index == PLUS_OP) then
+ call plus_operator(exp_number, stack, stack_pointer, type_checking)
+ else if (op_index == MINUS_OP) then
+ call minus_operator(exp_number, stack, stack_pointer, type_checking)
+ else if (op_index == DIV_OP) then
+ call div_operator(exp_number, stack, stack_pointer, type_checking)
+ ! TODO FIXME
+ ! sum (and other reduces) needs to be fixed,
+ ! because it is using (:) over decomposed dimensions, which is wrong
+ !
+ ! else if (op_index == SUM_OP) then
+ ! call sum_operator(exp_number, stack, stack_pointer, type_checking)
+ else
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'the impossible happened, tried to apply an unknown operator ' // &
+ 'in expression #' // trim(expression_names(exp_number)) // &
+ ' in the RPN calculator AM')
+ end if
+
+end subroutine eval_operator!}}}
+
+
+
+!***********************************************************************
+! routine eval_variable
+!
+!> \brief Given a variable index number, put it on the stack
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details Given a variable index number, put the result on the top of
+!> the stack. This will look up the field names in the variable and look
+!> it up from the framework to push the pointer onto the stack.
+!-----------------------------------------------------------------------
+subroutine eval_variable (domain, exp_number, &
+ var_index, stack, stack_pointer, type_checking)!{{{
+ ! input variables
+ integer, intent(in) :: exp_number, var_index
+ logical, intent(in) :: type_checking
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+
+ ! output variables
+
+ ! local variables
+ character (len=StrKIND) :: config
+ character (len=StrKIND), pointer :: config_result
+ type (mpas_pool_field_info_type) :: info
+
+ ! start procedure
+ config = trim(VARIABLE_PREFIX) // trim(variable_names(var_index))
+ call mpas_pool_get_config(domain % configs, config, config_result)
+
+ if (type_checking) then
+ if (trim(config_result) == trim(NONE_TOKEN)) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'the MPAS field assigned to variable ' // &
+ trim(variable_names(var_index)) // ' was evaluated, but it is ' // &
+ 'currently set to "none"')
+ end if
+ end if
+
+ call mpas_pool_get_field_info &
+ (domain % blocklist % allFields, config_result, info)
+
+ ! check if it's real
+ if (type_checking) then
+ if (info % fieldType /= MPAS_POOL_REAL) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'the MPAS field "' // trim(config_result) // &
+ '"assigned to variable ' // &
+ trim(variable_names(var_index)) // ' in the RPN calculator AM is ' // &
+ 'not a real field')
+ end if
+
+ ! check if it's 0D-2D
+ if (info % nDims > 2) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'the MPAS field "' // trim(config_result) // &
+ '"assigned to variable ' // &
+ trim(variable_names(var_index)) // ' in the RPN calculator AM is ' // &
+ 'not a 0D, 1D, or 2D field')
+ end if
+ end if
+
+ ! increment the stack and put it on the stack
+ stack_pointer = stack_pointer + 1
+ stack(stack_pointer) % number_of_dims = info % nDims
+ stack(stack_pointer) % symbol_type = IS_VARIABLE
+
+ ! get the dimension name if it is 1D
+ if (info % nDims == 0) then
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ config_result, stack(stack_pointer) % d0, 1)
+ else if (info % nDims == 1) then
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ config_result, stack(stack_pointer) % d1, 1)
+ else
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ config_result, stack(stack_pointer) % d2, 1)
+ end if
+end subroutine eval_variable!}}}
+
+
+
+!***********************************************************************
+! routine create_2d_field_from_1ds
+!
+!> \brief Generates a new 2D field from 1D fields
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details This will take two 1D fields (second and top) and
+!> generate a new 2D field (head) with second's dimension as its
+!> first dimension, and top's as it's second dimension. If top is
+!> decomposed, head will be decomposed as well. If second has
+!> constituent names, head will have constituent names as well.
+!> Both fields need to be active, otherwise head will be inactive.
+!-----------------------------------------------------------------------
+subroutine create_2d_field_from_1ds(second, top_head, head)!{{{
+#include "rpn_calc_inc/field_2d_from_1ds.inc"
+end subroutine create_2d_field_from_1ds!}}}
+
+
+
+!***********************************************************************
+! routine create_1d_field_from_2d
+!
+!> \brief Generates a new 1D field from a 2D
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details This will take a 2D field (top_head) and
+!> generate a new 1D field (head) with top's dimension as its
+!> dimension. If top is decomposed, head will be decomposed as well.
+!-----------------------------------------------------------------------
+subroutine create_1d_field_from_2d(top_head, head)!{{{
+#include "rpn_calc_inc/field_1d_from_2d.inc"
+end subroutine create_1d_field_from_2d!}}}
+
+
+
+!***********************************************************************
+! routine create_0d_field_from_1d
+!
+!> \brief Generates a new 1D field from a 2D
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details This will take a 1D field (top) and
+!> generate a new 0D field (dst).
+!-----------------------------------------------------------------------
+subroutine create_0d_field_from_1d(top, dst)!{{{
+#include "rpn_calc_inc/field_0d_from_1d.inc"
+end subroutine create_0d_field_from_1d!}}}
+
+
+
+!***********************************************************************
+! routine mul_operator
+!
+!> \brief Do mul on the stack
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details Given a stack, take two arguments off the stack and
+!> multiply them together, pushing the result back to the stack.
+!-----------------------------------------------------------------------
+subroutine mul_operator ( &
+ exp_number, stack, stack_pointer, type_checking)!{{{
+#include "rpn_calc_inc/binary_op_dispatch_start.inc"
+ op_name = '*'
+#include "rpn_calc_inc/binary_op_dispatch_0d_0d.inc"
+ call mul_op_0d_0d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_0d_1d.inc"
+ call mul_op_0d_1d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_0d_2d.inc"
+ call mul_op_0d_2d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_1d_0d.inc"
+ call mul_op_1d_0d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_1d_1d_same.inc"
+ call mul_op_1d_1d_same(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_1d_1d_diff.inc"
+ call mul_op_1d_1d_diff(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_1d_2d_first.inc"
+ call mul_op_1d_2d_first(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_1d_2d_second.inc"
+ call mul_op_1d_2d_second(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_2d_0d.inc"
+ call mul_op_2d_0d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_2d_1d_first.inc"
+ call mul_op_2d_1d_first(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_2d_1d_second.inc"
+ call mul_op_2d_1d_second(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_2d_2d.inc"
+ call mul_op_2d_2d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_end.inc"
+end subroutine mul_operator!}}}
+
+subroutine mul_op_0d_0d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_0d_0d_1.inc"
+ second * top
+#include "rpn_calc_inc/binary_op_0d_0d_2.inc"
+end subroutine mul_op_0d_0d!}}}
+
+subroutine mul_op_0d_1d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_0d_1d_1.inc"
+ second * top
+#include "rpn_calc_inc/binary_op_0d_1d_2.inc"
+end subroutine mul_op_0d_1d!}}}
+
+subroutine mul_op_0d_2d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_0d_2d_1.inc"
+ second * top
+#include "rpn_calc_inc/binary_op_0d_2d_2.inc"
+end subroutine mul_op_0d_2d!}}}
+
+subroutine mul_op_1d_0d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_1d_0d_1.inc"
+ second * top
+#include "rpn_calc_inc/binary_op_1d_0d_2.inc"
+end subroutine mul_op_1d_0d!}}}
+
+subroutine mul_op_1d_1d_same (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_1d_1d_same_1.inc"
+ second * top
+#include "rpn_calc_inc/binary_op_1d_1d_same_2.inc"
+end subroutine mul_op_1d_1d_same!}}}
+
+subroutine mul_op_1d_1d_diff (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_1d_1d_diff_1.inc"
+ second(i) * top(j)
+#include "rpn_calc_inc/binary_op_1d_1d_diff_2.inc"
+end subroutine mul_op_1d_1d_diff!}}}
+
+subroutine mul_op_1d_2d_first (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_1d_2d_first_1.inc"
+ second * top(:,j)
+#include "rpn_calc_inc/binary_op_1d_2d_first_2.inc"
+end subroutine mul_op_1d_2d_first!}}}
+
+subroutine mul_op_1d_2d_second (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_1d_2d_second_1.inc"
+ second * top(i,:)
+#include "rpn_calc_inc/binary_op_1d_2d_second_2.inc"
+end subroutine mul_op_1d_2d_second!}}}
+
+subroutine mul_op_2d_0d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_2d_0d_1.inc"
+ second * top
+#include "rpn_calc_inc/binary_op_2d_0d_2.inc"
+end subroutine mul_op_2d_0d!}}}
+
+subroutine mul_op_2d_1d_first (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_2d_1d_first_1.inc"
+ second(:,j) * top
+#include "rpn_calc_inc/binary_op_2d_1d_first_2.inc"
+end subroutine mul_op_2d_1d_first!}}}
+
+subroutine mul_op_2d_1d_second (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_2d_1d_second_1.inc"
+ second(i,:) * top
+#include "rpn_calc_inc/binary_op_2d_1d_second_2.inc"
+end subroutine mul_op_2d_1d_second!}}}
+
+subroutine mul_op_2d_2d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_2d_2d_1.inc"
+ second * top
+#include "rpn_calc_inc/binary_op_2d_2d_2.inc"
+end subroutine mul_op_2d_2d!}}}
+
+
+
+!***********************************************************************
+! routine plus_operator
+!
+!> \brief Do plus on the stack
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details Given a stack, take two arguments off the stack and
+!> add them together, pushing the result back to the stack.
+!-----------------------------------------------------------------------
+subroutine plus_operator ( &
+ exp_number, stack, stack_pointer, type_checking)!{{{
+#include "rpn_calc_inc/binary_op_dispatch_start.inc"
+ op_name = '+'
+#include "rpn_calc_inc/binary_op_dispatch_0d_0d.inc"
+ call plus_op_0d_0d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_0d_1d.inc"
+ call plus_op_0d_1d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_0d_2d.inc"
+ call plus_op_0d_2d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_1d_0d.inc"
+ call plus_op_1d_0d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_1d_1d_same.inc"
+ call plus_op_1d_1d_same(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_1d_1d_diff.inc"
+ call plus_op_1d_1d_diff(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_1d_2d_first.inc"
+ call plus_op_1d_2d_first(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_1d_2d_second.inc"
+ call plus_op_1d_2d_second(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_2d_0d.inc"
+ call plus_op_2d_0d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_2d_1d_first.inc"
+ call plus_op_2d_1d_first(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_2d_1d_second.inc"
+ call plus_op_2d_1d_second(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_2d_2d.inc"
+ call plus_op_2d_2d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_end.inc"
+end subroutine plus_operator!}}}
+
+subroutine plus_op_0d_0d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_0d_0d_1.inc"
+ second + top
+#include "rpn_calc_inc/binary_op_0d_0d_2.inc"
+end subroutine plus_op_0d_0d!}}}
+
+subroutine plus_op_0d_1d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_0d_1d_1.inc"
+ second + top
+#include "rpn_calc_inc/binary_op_0d_1d_2.inc"
+end subroutine plus_op_0d_1d!}}}
+
+subroutine plus_op_0d_2d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_0d_2d_1.inc"
+ second + top
+#include "rpn_calc_inc/binary_op_0d_2d_2.inc"
+end subroutine plus_op_0d_2d!}}}
+
+subroutine plus_op_1d_0d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_1d_0d_1.inc"
+ second + top
+#include "rpn_calc_inc/binary_op_1d_0d_2.inc"
+end subroutine plus_op_1d_0d!}}}
+
+subroutine plus_op_1d_1d_same (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_1d_1d_same_1.inc"
+ second + top
+#include "rpn_calc_inc/binary_op_1d_1d_same_2.inc"
+end subroutine plus_op_1d_1d_same!}}}
+
+subroutine plus_op_1d_1d_diff (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_1d_1d_diff_1.inc"
+ second(i) + top(j)
+#include "rpn_calc_inc/binary_op_1d_1d_diff_2.inc"
+end subroutine plus_op_1d_1d_diff!}}}
+
+subroutine plus_op_1d_2d_first (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_1d_2d_first_1.inc"
+ second + top(:,j)
+#include "rpn_calc_inc/binary_op_1d_2d_first_2.inc"
+end subroutine plus_op_1d_2d_first!}}}
+
+subroutine plus_op_1d_2d_second (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_1d_2d_second_1.inc"
+ second + top(i,:)
+#include "rpn_calc_inc/binary_op_1d_2d_second_2.inc"
+end subroutine plus_op_1d_2d_second!}}}
+
+subroutine plus_op_2d_0d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_2d_0d_1.inc"
+ second + top
+#include "rpn_calc_inc/binary_op_2d_0d_2.inc"
+end subroutine plus_op_2d_0d!}}}
+
+subroutine plus_op_2d_1d_first (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_2d_1d_first_1.inc"
+ second(:,j) + top
+#include "rpn_calc_inc/binary_op_2d_1d_first_2.inc"
+end subroutine plus_op_2d_1d_first!}}}
+
+subroutine plus_op_2d_1d_second (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_2d_1d_second_1.inc"
+ second(i,:) + top
+#include "rpn_calc_inc/binary_op_2d_1d_second_2.inc"
+end subroutine plus_op_2d_1d_second!}}}
+
+subroutine plus_op_2d_2d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_2d_2d_1.inc"
+ second + top
+#include "rpn_calc_inc/binary_op_2d_2d_2.inc"
+end subroutine plus_op_2d_2d!}}}
+
+
+
+!***********************************************************************
+! routine minus_operator
+!
+!> \brief Do minus on the stack
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details Given a stack, take two arguments off the stack and
+!> subtract top from second, pushing the result back to the stack.
+!-----------------------------------------------------------------------
+subroutine minus_operator ( &
+ exp_number, stack, stack_pointer, type_checking)!{{{
+#include "rpn_calc_inc/binary_op_dispatch_start.inc"
+ op_name = '-'
+#include "rpn_calc_inc/binary_op_dispatch_0d_0d.inc"
+ call minus_op_0d_0d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_0d_1d.inc"
+ if (type_checking) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'unable to subtract a 1d from a 0d in expression #' // &
+ trim(expression_names(exp_number)) // ' in the RPN calculator AM')
+ end if
+#include "rpn_calc_inc/binary_op_dispatch_0d_2d.inc"
+ if (type_checking) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'unable to subtract a 2d from a 0d in expression #' // &
+ trim(expression_names(exp_number)) // ' in the RPN calculator AM')
+ end if
+#include "rpn_calc_inc/binary_op_dispatch_1d_0d.inc"
+ call minus_op_1d_0d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_1d_1d_same.inc"
+ call minus_op_1d_1d_same(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_1d_1d_diff.inc"
+ call minus_op_1d_1d_diff(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_1d_2d_first.inc"
+ if (type_checking) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'unable to subtract a 2d from a 1d in expression #' // &
+ trim(expression_names(exp_number)) // ' in the RPN calculator AM')
+ end if
+#include "rpn_calc_inc/binary_op_dispatch_1d_2d_second.inc"
+ if (type_checking) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'unable to subtract a 2d from a 1d in expression #' // &
+ trim(expression_names(exp_number)) // ' in the RPN calculator AM')
+ end if
+#include "rpn_calc_inc/binary_op_dispatch_2d_0d.inc"
+ call minus_op_2d_0d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_2d_1d_first.inc"
+ call minus_op_2d_1d_first(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_2d_1d_second.inc"
+ call minus_op_2d_1d_second(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_2d_2d.inc"
+ call minus_op_2d_2d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_end.inc"
+end subroutine minus_operator!}}}
+
+subroutine minus_op_0d_0d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_0d_0d_1.inc"
+ second - top
+#include "rpn_calc_inc/binary_op_0d_0d_2.inc"
+end subroutine minus_op_0d_0d!}}}
+
+subroutine minus_op_1d_0d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_1d_0d_1.inc"
+ second - top
+#include "rpn_calc_inc/binary_op_1d_0d_2.inc"
+end subroutine minus_op_1d_0d!}}}
+
+subroutine minus_op_1d_1d_same (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_1d_1d_same_1.inc"
+ second - top
+#include "rpn_calc_inc/binary_op_1d_1d_same_2.inc"
+end subroutine minus_op_1d_1d_same!}}}
+
+subroutine minus_op_1d_1d_diff (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_1d_1d_diff_1.inc"
+ second(i) - top(j)
+#include "rpn_calc_inc/binary_op_1d_1d_diff_2.inc"
+end subroutine minus_op_1d_1d_diff!}}}
+
+subroutine minus_op_2d_0d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_2d_0d_1.inc"
+ second - top
+#include "rpn_calc_inc/binary_op_2d_0d_2.inc"
+end subroutine minus_op_2d_0d!}}}
+
+subroutine minus_op_2d_1d_first (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_2d_1d_first_1.inc"
+ second(:,j) - top
+#include "rpn_calc_inc/binary_op_2d_1d_first_2.inc"
+end subroutine minus_op_2d_1d_first!}}}
+
+subroutine minus_op_2d_1d_second (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_2d_1d_second_1.inc"
+ second(i,:) - top
+#include "rpn_calc_inc/binary_op_2d_1d_second_2.inc"
+end subroutine minus_op_2d_1d_second!}}}
+
+subroutine minus_op_2d_2d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_2d_2d_1.inc"
+ second - top
+#include "rpn_calc_inc/binary_op_2d_2d_2.inc"
+end subroutine minus_op_2d_2d!}}}
+
+
+
+!***********************************************************************
+! routine div_operator
+!
+!> \brief Do div on the stack
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details Given a stack, take two arguments off the stack and
+!> divide the second by the top, pushing the result back to the stack.
+!-----------------------------------------------------------------------
+subroutine div_operator ( &
+ exp_number, stack, stack_pointer, type_checking)!{{{
+#include "rpn_calc_inc/binary_op_dispatch_start.inc"
+ op_name = '/'
+#include "rpn_calc_inc/binary_op_dispatch_0d_0d.inc"
+ call div_op_0d_0d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_0d_1d.inc"
+ if (type_checking) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'unable to divide a 0d by a 1d in expression #' // &
+ trim(expression_names(exp_number)) // ' in the RPN calculator AM')
+ end if
+#include "rpn_calc_inc/binary_op_dispatch_0d_2d.inc"
+ if (type_checking) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'unable to divide a 0d by a 2d in expression #' // &
+ trim(expression_names(exp_number)) // ' in the RPN calculator AM')
+ end if
+#include "rpn_calc_inc/binary_op_dispatch_1d_0d.inc"
+ call div_op_1d_0d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_1d_1d_same.inc"
+ call div_op_1d_1d_same(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_1d_1d_diff.inc"
+ call div_op_1d_1d_diff(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_1d_2d_first.inc"
+ if (type_checking) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'unable to divide a 1d by a 2d in expression #' // &
+ trim(expression_names(exp_number)) // ' in the RPN calculator AM')
+ end if
+#include "rpn_calc_inc/binary_op_dispatch_1d_2d_second.inc"
+ if (type_checking) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'unable to divide a 1d by a 2d in expression #' // &
+ trim(expression_names(exp_number)) // ' in the RPN calculator AM')
+ end if
+#include "rpn_calc_inc/binary_op_dispatch_2d_0d.inc"
+ call div_op_2d_0d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_2d_1d_first.inc"
+ call div_op_2d_1d_first(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_2d_1d_second.inc"
+ call div_op_2d_1d_second(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_2d_2d.inc"
+ call div_op_2d_2d(stack, stack_pointer)
+#include "rpn_calc_inc/binary_op_dispatch_end.inc"
+end subroutine div_operator!}}}
+
+function safe_divide_0d_0d(second, top)
+ implicit none
+ real (kind=RKIND), intent(in) :: second
+ real (kind=RKIND), intent(in) :: top
+
+ real (kind=RKIND) :: safe_divide_0d_0d
+
+ if (abs(top) > 0.0_RKIND) then
+ safe_divide_0d_0d = second / top
+ else
+ safe_divide_0d_0d = huge(second)
+ end if
+end function safe_divide_0d_0d
+
+function safe_divide_1d_0d(second, top)
+ implicit none
+ real (kind=RKIND), dimension(:), intent(in) :: second
+ real (kind=RKIND), intent(in) :: top
+
+ real (kind=RKIND), dimension(size(second)) :: safe_divide_1d_0d
+
+ if (abs(top) > 0.0_RKIND) then
+ safe_divide_1d_0d = second / top
+ else
+ safe_divide_1d_0d = huge(second)
+ end if
+end function safe_divide_1d_0d
+
+function safe_divide_2d_0d(second, top)
+ implicit none
+ real (kind=RKIND), dimension(:, :), intent(in) :: second
+ real (kind=RKIND), intent(in) :: top
+
+ real (kind=RKIND), dimension(size(second, 1), size(second, 2)) :: &
+ safe_divide_2d_0d
+
+ if (abs(top) > 0.0_RKIND) then
+ safe_divide_2d_0d = second / top
+ else
+ safe_divide_2d_0d = huge(second)
+ end if
+end function safe_divide_2d_0d
+
+function safe_divide_1d_1d(second, top)
+ implicit none
+ real (kind=RKIND), dimension(:), intent(in) :: second
+ real (kind=RKIND), dimension(:), intent(in) :: top
+
+ real (kind=RKIND), dimension(size(second)) :: safe_divide_1d_1d
+
+ where (abs(top) > 0.0_RKIND)
+ safe_divide_1d_1d = second / top
+ elsewhere
+ safe_divide_1d_1d = huge(second)
+ end where
+end function safe_divide_1d_1d
+
+function safe_divide_2d_2d(second, top)
+ implicit none
+ real (kind=RKIND), dimension(:, :), intent(in) :: second
+ real (kind=RKIND), dimension(:, :), intent(in) :: top
+
+ real (kind=RKIND), dimension(size(second, 1), size(second, 2)) :: &
+ safe_divide_2d_2d
+
+ where (abs(top) > 0.0_RKIND)
+ safe_divide_2d_2d = second / top
+ elsewhere
+ safe_divide_2d_2d = huge(second)
+ end where
+end function safe_divide_2d_2d
+
+subroutine div_op_0d_0d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_0d_0d_1.inc"
+ safe_divide_0d_0d(second, top)
+#include "rpn_calc_inc/binary_op_0d_0d_2.inc"
+end subroutine div_op_0d_0d!}}}
+
+subroutine div_op_1d_0d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_1d_0d_1.inc"
+ safe_divide_1d_0d(second, top)
+#include "rpn_calc_inc/binary_op_1d_0d_2.inc"
+end subroutine div_op_1d_0d!}}}
+
+subroutine div_op_1d_1d_same (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_1d_1d_same_1.inc"
+ safe_divide_1d_1d(second, top)
+#include "rpn_calc_inc/binary_op_1d_1d_same_2.inc"
+end subroutine div_op_1d_1d_same!}}}
+
+subroutine div_op_1d_1d_diff (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_1d_1d_diff_1.inc"
+ safe_divide_0d_0d(second(i), top(j))
+#include "rpn_calc_inc/binary_op_1d_1d_diff_2.inc"
+end subroutine div_op_1d_1d_diff!}}}
+
+subroutine div_op_2d_0d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_2d_0d_1.inc"
+ safe_divide_2d_0d(second, top)
+#include "rpn_calc_inc/binary_op_2d_0d_2.inc"
+end subroutine div_op_2d_0d!}}}
+
+subroutine div_op_2d_1d_first (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_2d_1d_first_1.inc"
+ safe_divide_1d_1d(second(:,j), top)
+#include "rpn_calc_inc/binary_op_2d_1d_first_2.inc"
+end subroutine div_op_2d_1d_first!}}}
+
+subroutine div_op_2d_1d_second (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_2d_1d_second_1.inc"
+ safe_divide_1d_1d(second(i,:), top)
+#include "rpn_calc_inc/binary_op_2d_1d_second_2.inc"
+end subroutine div_op_2d_1d_second!}}}
+
+subroutine div_op_2d_2d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/binary_op_2d_2d_1.inc"
+ safe_divide_2d_2d(second, top)
+#include "rpn_calc_inc/binary_op_2d_2d_2.inc"
+end subroutine div_op_2d_2d!}}}
+
+!***********************************************************************
+! routine sum_operator
+!
+!> \brief Do sum on the stack
+!> \author Jon Woodring
+!> \date March 21, 2016
+!> \details Given a stack, take sum argument off the stack and
+!> sum along the first dimension, pushing the result back to the stack.
+!-----------------------------------------------------------------------
+subroutine sum_operator ( &
+ exp_number, stack, stack_pointer, type_checking)!{{{
+#include "rpn_calc_inc/reduce_op_dispatch_start.inc"
+ op_name = 'sum'
+#include "rpn_calc_inc/reduce_op_dispatch_1d.inc"
+ call sum_op_1d(stack, stack_pointer)
+#include "rpn_calc_inc/reduce_op_dispatch_2d.inc"
+ call sum_op_2d(stack, stack_pointer)
+#include "rpn_calc_inc/reduce_op_dispatch_end.inc"
+end subroutine sum_operator
+
+subroutine sum_op_1d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/reduce_op_1d_1.inc"
+ 0
+#include "rpn_calc_inc/reduce_op_1d_2.inc"
+ reduced + sum(top)
+#include "rpn_calc_inc/reduce_op_1d_3.inc"
+end subroutine sum_op_1d!}}}
+
+subroutine sum_op_2d (stack, stack_pointer)!{{{
+#include "rpn_calc_inc/reduce_op_2d_1.inc"
+ 0
+#include "rpn_calc_inc/reduce_op_2d_2.inc"
+ reduced(j) + sum(top(:,j))
+#include "rpn_calc_inc/reduce_op_2d_3.inc"
+end subroutine sum_op_2d!}}}
+
+end module ocn_rpn_calculator
+! vim: foldmethod=marker
diff --git a/src/core_ocean/analysis_members/mpas_ocn_surface_area_weighted_averages.F b/src/core_ocean/analysis_members/mpas_ocn_surface_area_weighted_averages.F
index 086d762159..80ee43ec12 100644
--- a/src/core_ocean/analysis_members/mpas_ocn_surface_area_weighted_averages.F
+++ b/src/core_ocean/analysis_members/mpas_ocn_surface_area_weighted_averages.F
@@ -156,10 +156,12 @@ subroutine ocn_compute_surface_area_weighted_averages(domain, timeLevel, err)!{{
type (block_type), pointer :: block
type (mpas_pool_type), pointer :: surfaceAreaWeightedAveragesAMPool
type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: tracersPool
type (mpas_pool_type), pointer :: meshPool
type (mpas_pool_type), pointer :: scratchPool
type (mpas_pool_type), pointer :: diagnosticsPool
type (mpas_pool_type), pointer :: forcingPool
+ type (mpas_pool_type), pointer :: tracersSurfaceFluxPool
real (kind=RKIND), dimension(:,:), pointer :: minValueWithinOceanRegion
real (kind=RKIND), dimension(:,:), pointer :: maxValueWithinOceanRegion
@@ -184,17 +186,17 @@ subroutine ocn_compute_surface_area_weighted_averages(domain, timeLevel, err)!{{
real (kind=RKIND), dimension(:), pointer :: seaIceEnergy
real (kind=RKIND), dimension(:), pointer :: surfaceThicknessFlux
- real (kind=RKIND), dimension(:,:), pointer :: surfaceTracerFlux
+ real (kind=RKIND), dimension(:,:), pointer :: activeTracersSurfaceFlux
real (kind=RKIND), dimension(:), pointer :: penetrativeTemperatureFlux
real (kind=RKIND), dimension(:), pointer :: seaIceSalinityFlux
- real (kind=RKIND), dimension(:), pointer :: surfaceWindStressMagnitude
+ real (kind=RKIND), dimension(:), pointer :: surfaceStressMagnitude
real (kind=RKIND), dimension(:), pointer :: windStressZonal
real (kind=RKIND), dimension(:), pointer :: windStressMeridional
real (kind=RKIND), dimension(:), pointer :: seaSurfacePressure
real (kind=RKIND), dimension(:), pointer :: ssh
real (kind=RKIND), dimension(:), pointer :: boundaryLayerDepth
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
! pointers to data in mesh pool
integer, pointer :: nCells, nCellsSolve, nSfcAreaWeightedAvgFields, nOceanRegions
@@ -212,8 +214,7 @@ subroutine ocn_compute_surface_area_weighted_averages(domain, timeLevel, err)!{{
integer :: iCell, iRegion, iTracer, err_tmp
! package flag
- logical, pointer :: surfaceAreaWeightedAveragesAMPKGActive
- logical, pointer :: bulkForcingPkgActive
+ logical, pointer :: activeTracersBulkRestoringPKG
logical, pointer :: frazilIcePkgActive
! buffers data for message passaging
@@ -226,7 +227,7 @@ subroutine ocn_compute_surface_area_weighted_averages(domain, timeLevel, err)!{{
err = 0
! get status of other packages
- call mpas_pool_get_package(ocnPackages, 'bulkForcingActive', bulkForcingPkgActive)
+ call mpas_pool_get_package(ocnPackages, 'activeTracersBulkRestoringPKGActive', activeTracersBulkRestoringPKG)
call mpas_pool_get_package(ocnPackages, 'frazilIceActive', frazilIcePkgActive)
! set highest level pointer
@@ -247,12 +248,12 @@ subroutine ocn_compute_surface_area_weighted_averages(domain, timeLevel, err)!{{
allocate(workBufferSumReduced(kBufferLength))
allocate(workBufferMinReduced(kBufferLength))
allocate(workBufferMaxReduced(kBufferLength))
- workBufferSum=0.0
- workBufferMin=0.0
- workBufferMax=0.0
- workBufferSumReduced=0.0
- workBufferMinReduced=0.0
- workBufferMaxReduced=0.0
+ workBufferSum=0.0_RKIND
+ workBufferMin=0.0_RKIND
+ workBufferMax=0.0_RKIND
+ workBufferSumReduced=0.0_RKIND
+ workBufferMinReduced=0.0_RKIND
+ workBufferMaxReduced=0.0_RKIND
! loop over all ocean regions
do iRegion=1,nOceanRegions
@@ -287,17 +288,19 @@ subroutine ocn_compute_surface_area_weighted_averages(domain, timeLevel, err)!{{
do while (associated(block))
! get pointers to pools
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool)
+ call mpas_pool_get_subpool(forcingPool, 'tracersSurfaceFlux', tracersSurfaceFluxPool)
! get pointers to mesh
call mpas_pool_get_dimension(block % dimensions, 'nCellsSolve', nCellsSolve)
call mpas_pool_get_dimension(block % dimensions, 'nCells', nCells)
call mpas_pool_get_dimension(block % dimensions, 'nSfcAreaWeightedAvgFields', nSfcAreaWeightedAvgFields)
call mpas_pool_get_dimension(block % dimensions, 'nOceanRegions', nOceanRegions)
- call mpas_pool_get_dimension(statePool, 'index_temperature', indexTemperature)
- call mpas_pool_get_dimension(statePool, 'index_salinity', indexSalinity)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', indexTemperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', indexSalinity)
call mpas_pool_get_array(meshPool, 'areaCell', areaCell)
call mpas_pool_get_array(meshPool, 'lonCell', lonCell)
call mpas_pool_get_array(meshPool, 'latCell', latCell)
@@ -307,73 +310,75 @@ subroutine ocn_compute_surface_area_weighted_averages(domain, timeLevel, err)!{{
if (nDefinedDataFields > nSfcAreaWeightedAvgFields) then
write (stderrUnit,*) 'Abort: nDefinedDataFields > nSfcAreaWeightedAvgFields'
write (stderrUnit,*) ' : increase size of ocn_surface_area_weighted_averages scratch space'
- call mpas_dmpar_abort(dminfo)
+ call mpas_dmpar_global_abort('MPAS-ocean: Abort: nDefinedDataFields > nSfcAreaWeightedAvgFields')
endif
! get pointers to data that will be analyzed
! listed in the order in which the fields appear in {avg,min,max}SurfaceStatistics
- if (bulkForcingPkgActive) call mpas_pool_get_array(forcingPool, 'latentHeatFlux', latentHeatFlux)
- if (bulkForcingPkgActive) call mpas_pool_get_array(forcingPool, 'sensibleHeatFlux', sensibleHeatFlux)
- if (bulkForcingPkgActive) call mpas_pool_get_array(forcingPool, 'longWaveHeatFluxUp', longWaveHeatFluxUp)
- if (bulkForcingPkgActive) call mpas_pool_get_array(forcingPool, 'longWaveHeatFluxDown', longWaveHeatFluxDown)
- if (bulkForcingPkgActive) call mpas_pool_get_array(forcingPool, 'seaIceHeatFlux', seaIceHeatFlux)
- if (bulkForcingPkgActive) call mpas_pool_get_array(forcingPool, 'shortWaveHeatFlux', shortWaveHeatFlux)
- if (bulkForcingPkgActive) call mpas_pool_get_array(forcingPool, 'evaporationFlux', evaporationFlux)
- if (bulkForcingPkgActive) call mpas_pool_get_array(forcingPool, 'seaIceFreshWaterFlux', seaIceFreshWaterFlux)
- if (bulkForcingPkgActive) call mpas_pool_get_array(forcingPool, 'riverRunoffFlux', riverRunoffFlux)
- if (bulkForcingPkgActive) call mpas_pool_get_array(forcingPool, 'iceRunoffFlux', iceRunoffFlux)
- if (bulkForcingPkgActive) call mpas_pool_get_array(forcingPool, 'rainFlux', rainFlux)
- if (bulkForcingPkgActive) call mpas_pool_get_array(forcingPool, 'snowFlux', snowFlux)
+ if (activeTracersBulkRestoringPKG) call mpas_pool_get_array(forcingPool, 'latentHeatFlux', latentHeatFlux)
+ if (activeTracersBulkRestoringPKG) call mpas_pool_get_array(forcingPool, 'sensibleHeatFlux', sensibleHeatFlux)
+ if (activeTracersBulkRestoringPKG) call mpas_pool_get_array(forcingPool, 'longWaveHeatFluxUp', longWaveHeatFluxUp)
+ if (activeTracersBulkRestoringPKG) call mpas_pool_get_array(forcingPool, 'longWaveHeatFluxDown', longWaveHeatFluxDown)
+ if (activeTracersBulkRestoringPKG) call mpas_pool_get_array(forcingPool, 'seaIceHeatFlux', seaIceHeatFlux)
+ if (activeTracersBulkRestoringPKG) call mpas_pool_get_array(forcingPool, 'shortWaveHeatFlux', shortWaveHeatFlux)
+ if (activeTracersBulkRestoringPKG) call mpas_pool_get_array(forcingPool, 'evaporationFlux', evaporationFlux)
+ if (activeTracersBulkRestoringPKG) call mpas_pool_get_array(forcingPool, 'seaIceFreshWaterFlux', seaIceFreshWaterFlux)
+ if (activeTracersBulkRestoringPKG) call mpas_pool_get_array(forcingPool, 'riverRunoffFlux', riverRunoffFlux)
+ if (activeTracersBulkRestoringPKG) call mpas_pool_get_array(forcingPool, 'iceRunoffFlux', iceRunoffFlux)
+ if (activeTracersBulkRestoringPKG) call mpas_pool_get_array(forcingPool, 'rainFlux', rainFlux)
+ if (activeTracersBulkRestoringPKG) call mpas_pool_get_array(forcingPool, 'snowFlux', snowFlux)
if (frazilIcePkgActive) call mpas_pool_get_array(forcingPool, 'seaIceEnergy', seaIceEnergy)
call mpas_pool_get_array(forcingPool, 'surfaceThicknessFlux', surfaceThicknessFlux)
- call mpas_pool_get_array(forcingPool, 'surfaceTracerFlux', surfaceTracerFlux)
- if (bulkForcingPkgActive) call mpas_pool_get_array(forcingPool, 'seaIceSalinityFlux', seaIceSalinityFlux)
- call mpas_pool_get_array(forcingPool, 'surfaceWindStressMagnitude', surfaceWindStressMagnitude)
- if (bulkForcingPkgActive) call mpas_pool_get_array(forcingPool, 'windStressZonal', windStressZonal)
- if (bulkForcingPkgActive) call mpas_pool_get_array(forcingPool, 'windStressMeridional', windStressMeridional)
+ call mpas_pool_get_array(tracersSurfaceFluxPool, 'activeTracersSurfaceFlux', activeTracersSurfaceFlux)
+ if (activeTracersBulkRestoringPKG) call mpas_pool_get_array(forcingPool, 'seaIceSalinityFlux', seaIceSalinityFlux)
+ call mpas_pool_get_array(forcingPool, 'surfaceStressMagnitude', surfaceStressMagnitude)
+ if (activeTracersBulkRestoringPKG) call mpas_pool_get_array(forcingPool, 'windStressZonal', windStressZonal)
+ if (activeTracersBulkRestoringPKG) call mpas_pool_get_array(forcingPool, 'windStressMeridional', windStressMeridional)
call mpas_pool_get_array(forcingPool, 'seaSurfacePressure', seaSurfacePressure)
call mpas_pool_get_array(statePool, 'ssh', ssh, 1)
- call mpas_pool_get_array(statePool, 'tracers', tracers, 1)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
call mpas_pool_get_array(diagnosticsPool, 'boundaryLayerDepth',boundaryLayerDepth)
! compute mask
call compute_mask(nCells, nCellsSolve, iRegion, lonCell, latCell, workMask)
! copy data into work array
- workArray( :,:) = 0.0
+ workArray( :,:) = 0.0_RKIND
workArray( 1,:) = workMask(:)
workArray( 2,:) = areaCell(:)
- if (bulkForcingPkgActive) workArray( 3,:) = latentHeatFlux(:)
- if (bulkForcingPkgActive) workArray( 4,:) = sensibleHeatFlux(:)
- if (bulkForcingPkgActive) workArray( 5,:) = longWaveHeatFluxUp(:)
- if (bulkForcingPkgActive) workArray( 6,:) = longWaveHeatFluxDown(:)
- if (bulkForcingPkgActive) workArray( 7,:) = seaIceHeatFlux(:)
- if (bulkForcingPkgActive) workArray( 8,:) = shortWaveHeatFlux(:)
- if (bulkForcingPkgActive) workArray( 9,:) = evaporationFlux(:)
- if (bulkForcingPkgActive) workArray(10,:) = seaIceFreshWaterFlux(:)
- if (bulkForcingPkgActive) workArray(11,:) = riverRunoffFlux(:)
- if (bulkForcingPkgActive) workArray(12,:) = iceRunoffFlux(:)
- if (bulkForcingPkgActive) workArray(13,:) = rainFlux(:)
- if (bulkForcingPkgActive) workArray(14,:) = snowFlux(:)
+ if (activeTracersBulkRestoringPKG) workArray( 3,:) = latentHeatFlux(:)
+ if (activeTracersBulkRestoringPKG) workArray( 4,:) = sensibleHeatFlux(:)
+ if (activeTracersBulkRestoringPKG) workArray( 5,:) = longWaveHeatFluxUp(:)
+ if (activeTracersBulkRestoringPKG) workArray( 6,:) = longWaveHeatFluxDown(:)
+ if (activeTracersBulkRestoringPKG) workArray( 7,:) = seaIceHeatFlux(:)
+ if (activeTracersBulkRestoringPKG) workArray( 8,:) = shortWaveHeatFlux(:)
+ if (activeTracersBulkRestoringPKG) workArray( 9,:) = evaporationFlux(:)
+ if (activeTracersBulkRestoringPKG) workArray(10,:) = seaIceFreshWaterFlux(:)
+ if (activeTracersBulkRestoringPKG) workArray(11,:) = riverRunoffFlux(:)
+ if (activeTracersBulkRestoringPKG) workArray(12,:) = iceRunoffFlux(:)
+ if (activeTracersBulkRestoringPKG) workArray(13,:) = rainFlux(:)
+ if (activeTracersBulkRestoringPKG) workArray(14,:) = snowFlux(:)
if (frazilIcePkgActive) workArray(15,:) = seaIceEnergy(:)
workArray(16,:) = surfaceThicknessFlux(:)
- workArray(17,:) = surfaceTracerFlux(indexTemperature,:)
- workArray(18,:) = surfaceTracerFlux(indexSalinity,:)
- if (bulkForcingPkgActive) workArray(19,:) = seaIceSalinityFlux(:)
- workArray(20,:) = surfaceWindStressMagnitude(:)
- if (bulkForcingPkgActive) workArray(21,:) = windStressZonal(:)
- if (bulkForcingPkgActive) workArray(22,:) = windStressMeridional(:)
+ workArray(17,:) = activeTracersSurfaceFlux(indexTemperature,:)
+ workArray(18,:) = activeTracersSurfaceFlux(indexSalinity,:)
+ if (activeTracersBulkRestoringPKG) workArray(19,:) = seaIceSalinityFlux(:)
+ workArray(20,:) = surfaceStressMagnitude(:)
+ if (activeTracersBulkRestoringPKG) workArray(21,:) = windStressZonal(:)
+ if (activeTracersBulkRestoringPKG) workArray(22,:) = windStressMeridional(:)
workArray(23,:) = seaSurfacePressure(:)
workArray(24,:) = ssh(:)
- workArray(25,:) = tracers(indexTemperature,1,:)
- workArray(26,:) = tracers(indexSalinity,1,:)
+ workArray(25,:) = activeTracers(indexTemperature,1,:)
+ workArray(26,:) = activeTracers(indexSalinity,1,:)
workArray(27,:) = boundaryLayerDepth(:)
! build net heat, salinity and fresh water budget
- ! net heat into ocean = latentHeatFlux+sensibleHeatFlux+longWaveHeatFluxUp+longWaveHeatFluxDown+shortWaveHeatFlux+seaIceHeatFlux+(?seaIceEnergy?)
+ ! net heat into ocean = latentHeatFlux + sensibleHeatFlux + longWaveHeatFluxUp + longWaveHeatFluxDown
+ ! + shortWaveHeatFlux + seaIceHeatFlux + (?seaIceEnergy?)
! net salinity into ocean = seaIceSalinityFlux
- ! net freshwater into ocean = evaporationFlux+seaIceFreshWaterFlux+riverRunoffFlux+iceRunoffFlux+rainFlux+snowFlux+(?seaIceEnergy?)
- if (bulkForcingPkgActive) then
+ ! net freshwater into ocean = evaporationFlux + seaIceFreshWaterFlux + riverRunoffFlux + iceRunoffFlux
+ ! + rainFlux + snowFlux + (?seaIceEnergy?)
+ if (activeTracersBulkRestoringPKG) then
workArray(28,:) = latentHeatFlux(:) &
+ sensibleHeatFlux(:) &
+ longWaveHeatFluxUp(:) &
@@ -426,10 +431,12 @@ subroutine ocn_compute_surface_area_weighted_averages(domain, timeLevel, err)!{{
do iRegion=1,nOceanRegions
! normalize all field by total area
do iDataField=3,nDefinedDataFields
- avgValueWithinOceanRegion(iDataField,iRegion) = avgValueWithinOceanRegion(iDataField,iRegion) / max(avgValueWithinOceanRegion(2,iRegion),1.0e-8_RKIND)
+ avgValueWithinOceanRegion(iDataField,iRegion) = avgValueWithinOceanRegion(iDataField,iRegion) &
+ / max(avgValueWithinOceanRegion(2,iRegion),1.0e-8_RKIND)
enddo
! normalize total area by number of cells in region
- avgValueWithinOceanRegion(2,iRegion) = avgValueWithinOceanRegion(2,iRegion) / max(avgValueWithinOceanRegion(1,iRegion),1.0e-8_RKIND)
+ avgValueWithinOceanRegion(2,iRegion) = avgValueWithinOceanRegion(2,iRegion) &
+ / max(avgValueWithinOceanRegion(1,iRegion),1.0e-8_RKIND)
enddo
! deallocate scratch fields
@@ -458,7 +465,7 @@ subroutine compute_mask(nCells, nCellsSolve, iRegion, lonCell, latCell, workMask
integer :: iCell
real(kind=RKIND) :: dtr
- dtr = 4.0*atan(1.0) / 180.0_RKIND
+ dtr = 4.0_RKIND*atan(1.0_RKIND) / 180.0_RKIND
workMask(:) = 0.0_RKIND
do iCell=1,nCellsSolve
workMask(iCell) = 1.0_RKIND
@@ -467,42 +474,42 @@ subroutine compute_mask(nCells, nCellsSolve, iRegion, lonCell, latCell, workMask
if (iRegion.eq.1) then
! Arctic
do iCell=1,nCellsSolve
- if(latCell(iCell).lt. 60.0*dtr) workMask(iCell) = 0.0_RKIND
+ if(latCell(iCell).lt. 60.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
enddo
elseif (iRegion.eq.2) then
! Equatorial
do iCell=1,nCellsSolve
- if(latCell(iCell).gt. 15.0*dtr) workMask(iCell) = 0.0_RKIND
- if(latCell(iCell).lt.-15.0*dtr) workMask(iCell) = 0.0_RKIND
+ if(latCell(iCell).gt. 15.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
+ if(latCell(iCell).lt.-15.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
enddo
elseif (iRegion.eq.3) then
! Southern Ocean
do iCell=1,nCellsSolve
- if(latCell(iCell).gt.-50.0*dtr) workMask(iCell) = 0.0_RKIND
+ if(latCell(iCell).gt.-50.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
enddo
elseif (iRegion.eq.4) then
! Nino 3
do iCell=1,nCellsSolve
- if(latCell(iCell).gt. 5.0*dtr) workMask(iCell) = 0.0_RKIND
- if(latCell(iCell).lt. -5.0*dtr) workMask(iCell) = 0.0_RKIND
- if(lonCell(iCell).lt.210.0*dtr) workMask(iCell) = 0.0_RKIND
- if(lonCell(iCell).gt.270.0*dtr) workMask(iCell) = 0.0_RKIND
+ if(latCell(iCell).gt. 5.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
+ if(latCell(iCell).lt. -5.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
+ if(lonCell(iCell).lt.210.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
+ if(lonCell(iCell).gt.270.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
enddo
elseif (iRegion.eq.5) then
! Nino 4
do iCell=1,nCellsSolve
- if(latCell(iCell).gt. 5.0*dtr) workMask(iCell) = 0.0_RKIND
- if(latCell(iCell).lt. -5.0*dtr) workMask(iCell) = 0.0_RKIND
- if(lonCell(iCell).lt.160.0*dtr) workMask(iCell) = 0.0_RKIND
- if(lonCell(iCell).gt.210.0*dtr) workMask(iCell) = 0.0_RKIND
+ if(latCell(iCell).gt. 5.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
+ if(latCell(iCell).lt. -5.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
+ if(lonCell(iCell).lt.160.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
+ if(lonCell(iCell).gt.210.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
enddo
elseif (iRegion.eq.6) then
! Nino 3.4
do iCell=1,nCellsSolve
- if(latCell(iCell).gt. 5.0*dtr) workMask(iCell) = 0.0_RKIND
- if(latCell(iCell).lt. -5.0*dtr) workMask(iCell) = 0.0_RKIND
- if(lonCell(iCell).lt.190.0*dtr) workMask(iCell) = 0.0_RKIND
- if(lonCell(iCell).gt.240.0*dtr) workMask(iCell) = 0.0_RKIND
+ if(latCell(iCell).gt. 5.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
+ if(latCell(iCell).lt. -5.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
+ if(lonCell(iCell).lt.190.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
+ if(lonCell(iCell).gt.240.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
enddo
else
! global (do nothing!)
@@ -521,7 +528,7 @@ subroutine compute_statistics(nDefinedDataFields, nCellsSolve, workArray, workMa
real(kind=RKIND), dimension(:), intent(out) :: workMin, workMax, workSum
integer :: iCell, iData
- workSum = 0.0
+ workSum = 0.0_RKIND
do iCell=1,nCellsSolve
workSum(1) = workSum(1) + workMask(iCell)
workSum(2) = workSum(2) + workArray(2,iCell)*workMask(iCell)
diff --git a/src/core_ocean/analysis_members/mpas_ocn_test_compute_interval.F b/src/core_ocean/analysis_members/mpas_ocn_test_compute_interval.F
index e215f315d1..5d00ddd341 100644
--- a/src/core_ocean/analysis_members/mpas_ocn_test_compute_interval.F
+++ b/src/core_ocean/analysis_members/mpas_ocn_test_compute_interval.F
@@ -14,7 +14,7 @@
!> \date May 2015
!> \details
!> MPAS ocean analysis core member: test_compute_interval
-!>
+!>
!
!-----------------------------------------------------------------------
@@ -67,8 +67,8 @@ module ocn_test_compute_interval
!> \brief Initialize MPAS-Ocean analysis member
!> \author Mark Petersen
!> \date May 2015
-!> \details
-!> This routine conducts all initializations required for the
+!> \details
+!> This routine conducts all initializations required for the
!> MPAS-Ocean analysis member.
!
!-----------------------------------------------------------------------
@@ -128,7 +128,7 @@ end subroutine ocn_init_test_compute_interval!}}}
!> \brief Compute MPAS-Ocean analysis member
!> \author Mark Petersen
!> \date May 2015
-!> \details
+!> \details
!> This routine conducts all computation required for this
!> MPAS-Ocean analysis member.
!
@@ -209,7 +209,7 @@ end subroutine ocn_compute_test_compute_interval!}}}
!> \brief Save restart for MPAS-Ocean analysis member
!> \author Mark Petersen
!> \date May 2015
-!> \details
+!> \details
!> This routine conducts computation required to save a restart state
!> for the MPAS-Ocean analysis member.
!
@@ -256,7 +256,7 @@ end subroutine ocn_restart_test_compute_interval!}}}
!> \brief Finalize MPAS-Ocean analysis member
!> \author Mark Petersen
!> \date May 2015
-!> \details
+!> \details
!> This routine conducts all finalizations required for this
!> MPAS-Ocean analysis member.
!
diff --git a/src/core_ocean/analysis_members/mpas_ocn_time_filters.F b/src/core_ocean/analysis_members/mpas_ocn_time_filters.F
new file mode 100644
index 0000000000..f922c47d98
--- /dev/null
+++ b/src/core_ocean/analysis_members/mpas_ocn_time_filters.F
@@ -0,0 +1,477 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_time_filters
+!
+!> \brief MPAS ocean analysis mode member: time_filters
+!> \author Phillip J. Wolfram
+!> \date 07/17/2015
+!> \details
+!> Performs time high and low pass filtering.
+!>
+!-----------------------------------------------------------------------
+
+!#define TIME_FILTERS_DEBUG
+
+module ocn_time_filters
+
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_dmpar
+ use mpas_timekeeping
+ use mpas_stream_manager
+ use mpas_vector_reconstruction
+
+ use ocn_constants
+ use ocn_diagnostics_routines
+#ifdef TIME_FILTERS_DEBUG
+ use mpas_constants
+#endif
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_time_filters, &
+ ocn_compute_time_filters, &
+ ocn_restart_time_filters, &
+ ocn_finalize_time_filters
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+#ifdef TIME_FILTERS_DEBUG
+ integer :: iEdgeOutput = 0, iBlockOutput = 0, iklevel = 1
+ real (kind=RKIND) :: lonEdgePoint = 10.0_RKIND*pii/180.0_RKIND, latEdgePoint = 30.0_RKIND*pii/180.0_RKIND
+#endif
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_time_filters
+!
+!> \brief Initialize MPAS-Ocean analysis member
+!> \author Phillip J. Wolfram
+!> \date 07/17/2015
+!> \details
+!> This routine conducts all initializations required for the
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_time_filters(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+ type (block_type), pointer :: block
+ logical, pointer :: initializeFilters
+ type (mpas_pool_type), pointer :: timeFiltersAMPool, statePool
+ real (kind=RKIND), dimension(:,:), pointer :: normalVelocity, normalVelocityLowPass, normalVelocityHighPass
+
+#ifdef TIME_FILTERS_DEBUG
+ real (kind=RKIND), dimension(:), pointer :: lonEdge, latEdge
+ real (kind=RKIND) :: dist, distmax = 1e9
+ integer :: i, iBlock
+ integer, pointer :: nEdgesSolve
+#endif
+
+ err = 0
+
+ call mpas_pool_get_config(ocnConfigs, 'config_AM_timeFilters_initialize_filters', initializeFilters)
+ if (initializeFilters) then
+#ifdef TIME_FILTERS_DEBUG
+ write(stderrUnit,*) 'initializing time filters'
+#endif
+
+ ! loop over all blocks and make assignments
+ block => domain % blocklist
+ do while (associated(block))
+
+ ! get high and low pass velocity components
+ call mpas_pool_get_subpool(block % structs, 'timeFiltersAM', timeFiltersAMPool)
+ call mpas_pool_get_array(timeFiltersAMPool, 'normalVelocityLowPass', normalVelocityLowPass)
+ call mpas_pool_get_array(timeFiltersAMPool, 'normalVelocityHighPass', normalVelocityHighPass)
+
+ ! get normal velocity
+ call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, timeLevel=1)
+
+ ! initialize normal velocities
+ normalVelocityLowPass(:,:) = normalVelocity(:,:)
+ normalVelocityHighPass(:,:) = normalVelocity(:,:)
+
+ block => block % next
+ end do
+
+ end if
+
+#ifdef TIME_FILTERS_DEBUG
+ ! get index for edge nearest to a location
+ block => domain % blocklist
+ iBlock = 0
+ do while (associated(block))
+ iBlock = iBlock + 1
+ call mpas_pool_get_subpool(block % structs, 'mesh', statePool)
+ call mpas_pool_get_array(statePool, 'latEdge', latEdge)
+ call mpas_pool_get_array(statePool, 'lonEdge', lonEdge)
+ call mpas_pool_get_dimension(block % dimensions, 'nEdgesSolve', nEdgesSolve)
+
+ do i=1,nEdgesSolve
+ dist = sqrt((latEdge(i) - latEdgePoint)**2 + (lonEdge(i) - lonEdgePoint)**2)
+ if (dist < distmax) then
+ distmax = dist
+ iEdgeOutput = i
+ iBlockOutput = iBlock
+ end if
+ end do
+
+ block => block % next
+ end do
+
+ block => domain % blocklist
+ ! get the right block number
+ do i=1,iBlockOutput-1
+ block => block % next
+ end do
+ call mpas_pool_get_subpool(block % structs, 'mesh', statePool)
+ call mpas_pool_get_array(statePool, 'latEdge', latEdge)
+ call mpas_pool_get_array(statePool, 'lonEdge', lonEdge)
+ write(stderrUnit,*) 'lon = ', 180.0_RKIND/pii*lonEdge(iEdgeOutput), ' lat = ', 180.0_RKIND/pii*latEdge(iEdgeOutput), &
+ ' iklevel=',iklevel, ' iEdgeOutput=',iEdgeOutput, ' iBlockOutput = ', iBlockOutput
+#endif
+
+#ifdef TIME_FILTERS_DEBUG
+ write(stderrUnit,*) 'finished initializing time filters'
+#endif
+
+ end subroutine ocn_init_time_filters!}}}
+
+!***********************************************************************
+!
+! routine ocn_compute_time_filters
+!
+!> \brief Compute MPAS-Ocean analysis member
+!> \author Phillip J. Wolfram
+!> \date 07/17/2015
+!> \details
+!> This routine conducts all computation required for this
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_compute_time_filters(domain, timeLevel, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(in) :: timeLevel
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mpas_pool_type), pointer :: timeFiltersAMPool
+ type (dm_info) :: dminfo
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: scratchPool
+ type (mpas_pool_type), pointer :: diagnosticsPool
+ type (mpas_pool_type), pointer :: timeFiltersAM
+ real (kind=RKIND), dimension(:,:), pointer :: normalVelocity, normalVelocityLowPass, normalVelocityHighPass, &
+ normalVelocityTest
+
+ type (field2DReal), pointer :: normalVelocityLowPassField, normalVelocityHighPassField
+
+ real (kind=RKIND), dimension(:,:), pointer :: velocityZonalLowPass, velocityMeridionalLowPass, &
+ velocityXLowPass, velocityYLowPass, velocityZLowPass, &
+ velocityZonalHighPass, velocityMeridionalHighPass, &
+ velocityXHighPass, velocityYHighPass, velocityZHighPass
+ integer, pointer :: nVertLevels, nEdgesSolve
+ integer :: k, iEdge
+ integer, dimension(:), pointer :: maxLevelEdgeBot
+
+ type (MPAS_timeInterval_type) :: timeStepESMF
+ character(len=StrKIND), pointer :: config_dt
+ logical, pointer :: computeCC
+ real (kind=RKIND) :: dt, tau
+#ifdef TIME_FILTERS_DEBUG
+ integer :: iBlock
+#endif
+
+ err = 0
+
+ dminfo = domain % dminfo
+
+#ifdef TIME_FILTERS_DEBUG
+ write(stderrUnit,*) 'start computing time filters'
+#endif
+
+ ! get dt
+ call mpas_pool_get_config(domain % configs, 'config_dt', config_dt)
+ call mpas_set_timeInterval(timeStepESMF, timeString=config_dt, ierr=err)
+ call mpas_get_timeInterval(timeStepESMF, dt=dt)
+ ! get tau
+ call mpas_pool_get_config(domain % configs, 'config_AM_timeFilters_tau', config_dt)
+ call mpas_set_timeInterval(timeStepESMF, timeString=config_dt, ierr=err)
+ call mpas_get_timeInterval(timeStepESMF, dt=tau)
+
+#ifdef TIME_FILTERS_DEBUG
+ !write(stderrUnit,*) 'dt = ', dt, ' tau = ', tau
+#endif
+
+ block => domain % blocklist
+#ifdef TIME_FILTERS_DEBUG
+ iBlock = 0
+#endif
+ do while (associated(block))
+#ifdef TIME_FILTERS_DEBUG
+ iBlock = iBlock + 1
+#endif
+ call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
+ call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(block % structs, 'timeFiltersAM', timeFiltersAMPool)
+
+ call mpas_pool_get_dimension(block % dimensions, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(block % dimensions, 'nEdgesSolve', nEdgesSolve)
+ call mpas_pool_get_array(meshPool, 'maxLevelEdgeBot', maxLevelEdgeBot)
+
+ ! get high and low pass velocity components
+ call mpas_pool_get_array(timeFiltersAMPool, 'normalVelocityLowPass', normalVelocityLowPass)
+ call mpas_pool_get_array(timeFiltersAMPool, 'normalVelocityHighPass', normalVelocityHighPass)
+ call mpas_pool_get_array(timeFiltersAMPool, 'normalVelocityFilterTest', normalVelocityTest)
+ ! get normal velocity
+ call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, timeLevel=1)
+
+ ! perform filter computations (in place)
+ do iEdge = 1,nEdgesSolve
+ do k = 1, maxLevelEdgeBot(iEdge)
+ normalVelocityLowPass(k,iEdge) = normalVelocityLowPass(k,iEdge)*(1.0_RKIND - dt/tau) + dt/tau*normalVelocity(k,iEdge)
+ normalVelocityHighPass(k,iEdge) = normalVelocity(k,iEdge) - normalVelocityLowPass(k,iEdge)
+ ! normalVelocityTest line can possibly be removed (needed for testing purposes)
+ normalVelocityTest(k,iEdge) = normalVelocity(k,iEdge)
+ end do
+#ifdef TIME_FILTERS_DEBUG
+ if (iEdge == iEdgeOutput .and. iBlock == iBlockOutput) then
+ write(stderrUnit,*) 'vl=', normalVelocityLowPass(iklevel, iEdge), ' v=', normalVelocity(iklevel, iEdge)
+ end if
+#endif
+ end do
+ ! exchange halo information in order to ensure that particles on halo are advected properly
+ call mpas_pool_get_field(timeFiltersAMPool, 'normalVelocityLowPass', normalVelocityLowPassField)
+ call mpas_pool_get_field(timeFiltersAMPool, 'normalVelocityHighPass', normalVelocityHighPassField)
+ call mpas_dmpar_exch_halo_field(normalVelocityLowPassField)
+ call mpas_dmpar_exch_halo_field(normalVelocityHighPassField)
+
+ block => block % next
+ end do
+
+ ! do IO communications if this is an output time step
+ call mpas_pool_get_config(domain % configs, 'config_AM_timeFilters_compute_cell_centered_values', computeCC)
+ if (mpas_stream_mgr_ringing_alarms(domain % streamManager, streamID='timeFiltersOutput', direction=MPAS_STREAM_OUTPUT, ierr=err) &
+ .and. computeCC) then
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block % structs, 'timeFiltersAM', timeFiltersAMPool)
+ ! get variables for computations
+ call mpas_pool_get_array(timeFiltersAMPool, 'normalVelocityLowPass', normalVelocityLowPass)
+ call mpas_pool_get_array(timeFiltersAMPool, 'velocityZonalLowPass', velocityZonalLowPass)
+ call mpas_pool_get_array(timeFiltersAMPool, 'velocityMeridionalLowPass', velocityMeridionalLowPass)
+ call mpas_pool_get_array(timeFiltersAMPool, 'velocityXLowPass', velocityXLowPass)
+ call mpas_pool_get_array(timeFiltersAMPool, 'velocityYLowPass', velocityYLowPass)
+ call mpas_pool_get_array(timeFiltersAMPool, 'velocityZLowPass', velocityZLowPass)
+ call mpas_pool_get_array(timeFiltersAMPool, 'normalVelocityHighPass', normalVelocityHighPass)
+ call mpas_pool_get_array(timeFiltersAMPool, 'velocityZonalHighPass', velocityZonalHighPass)
+ call mpas_pool_get_array(timeFiltersAMPool, 'velocityMeridionalHighPass', velocityMeridionalHighPass)
+ call mpas_pool_get_array(timeFiltersAMPool, 'velocityXHighPass', velocityXHighPass)
+ call mpas_pool_get_array(timeFiltersAMPool, 'velocityYHighPass', velocityYHighPass)
+ call mpas_pool_get_array(timeFiltersAMPool, 'velocityZHighPass', velocityZHighPass)
+ ! must perform reconstruction for cell centered values
+ call mpas_reconstruct(meshPool, normalVelocityLowPass, &
+ velocityXLowPass, velocityYLowPass, velocityZLowPass, &
+ velocityZonalLowPass, velocityMeridionalLowPass, &
+ includeHalos = .false.)
+ ! must perform reconstruction for cell centered values
+ call mpas_reconstruct(meshPool, normalVelocityHighPass, &
+ velocityXHighPass, velocityYHighPass, velocityZHighPass, &
+ velocityZonalHighPass, velocityMeridionalHighPass, &
+ includeHalos = .false.)
+ block => block % next
+ end do
+ end if
+
+#ifdef TIME_FILTERS_DEBUG
+ write(stderrUnit,*) 'finished computing time filters'
+#endif
+
+ end subroutine ocn_compute_time_filters!}}}
+
+!***********************************************************************
+!
+! routine ocn_restart_time_filters
+!
+!> \brief Save restart for MPAS-Ocean analysis member
+!> \author Phillip J. Wolfram
+!> \date 07/17/2015
+!> \details
+!> This routine conducts computation required to save a restart state
+!> for the MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_restart_time_filters(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ end subroutine ocn_restart_time_filters!}}}
+
+!***********************************************************************
+!
+! routine ocn_finalize_time_filters
+!
+!> \brief Finalize MPAS-Ocean analysis member
+!> \author Phillip J. Wolfram
+!> \date 07/17/2015
+!> \details
+!> This routine conducts all finalizations required for this
+!> MPAS-Ocean analysis member.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_finalize_time_filters(domain, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ end subroutine ocn_finalize_time_filters!}}}
+
+end module ocn_time_filters
+
+! vim: foldmethod=marker
diff --git a/src/core_ocean/analysis_members/mpas_ocn_time_series_stats.F b/src/core_ocean/analysis_members/mpas_ocn_time_series_stats.F
new file mode 100644
index 0000000000..c0910a462e
--- /dev/null
+++ b/src/core_ocean/analysis_members/mpas_ocn_time_series_stats.F
@@ -0,0 +1,3020 @@
+! Copyright (c) 2015, 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
+!
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! ocn_time_series_stats
+!
+!> \brief MPAS ocean analysis core member: time_series_stats
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> Flexible time series averaging, mins, and maxes of fields.
+!-----------------------------------------------------------------------
+module ocn_time_series_stats
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_dmpar
+ use mpas_timekeeping
+ use mpas_stream_manager
+
+ use ocn_constants
+ use ocn_diagnostics_routines
+
+ implicit none
+ private
+ save
+
+ ! Public parameters
+ !--------------------------------------------------------------------
+
+ ! Public member functions
+ !--------------------------------------------------------------------
+ public :: ocn_bootstrap_time_series_stats, &
+ ocn_init_time_series_stats, &
+ ocn_compute_time_series_stats, &
+ ocn_restart_time_series_stats, &
+ ocn_finalize_time_series_stats
+
+ ! Private module variables
+ !--------------------------------------------------------------------
+
+ type time_series_alarms_type
+ type (mpas_time_type) :: start_time
+ type (mpas_timeinterval_type) :: duration_interval
+ type (mpas_timeinterval_type) :: repeat_interval
+ type (mpas_timeinterval_type) :: reset_interval
+ end type time_series_alarms_type
+
+ type time_series_variable_type
+ ! state per variable, stored in framework
+ character (len=StrKIND), pointer :: input_name
+ character (len=StrKIND), dimension(:), allocatable :: output_names
+ end type time_series_variable_type
+
+ type time_series_buffer_type
+ ! state per buffer, stored in framework
+ integer, pointer :: started_flag, accumulate_flag, reset_flag
+
+ ! strings for looking up alarms and buffers per buffer
+ character (len=StrKIND), pointer :: start_alarm_ID, repeat_alarm_ID, &
+ duration_alarm_ID, reset_alarm_ID
+
+ ! counter for accumulation
+ real (kind=RKIND), pointer :: counter
+ end type time_series_buffer_type
+
+ type time_series_type
+ ! state per instance, stored in framework
+ integer, pointer :: operation
+ integer, pointer :: number_of_variables
+ integer, pointer :: number_of_buffers
+
+ ! allocated on every instance call
+ type (time_series_variable_type), dimension(:), allocatable :: variables
+ type (time_series_buffer_type), dimension(:), allocatable :: buffers
+ end type time_series_type
+
+ ! enum of ops and types
+ integer, parameter :: AVG_OP = 1
+ integer, parameter :: MIN_OP = 2
+ integer, parameter :: MAX_OP = 3
+
+ integer, parameter :: START_TIMES = 5
+ integer, parameter :: DURATION_INTERVALS = 6
+ integer, parameter :: REPEAT_INTERVALS = 7
+ integer, parameter :: RESET_INTERVALS = 8
+
+ character (len=3), parameter :: AVG_TOKEN = 'avg'
+ character (len=3), parameter :: MIN_TOKEN = 'min'
+ character (len=3), parameter :: MAX_TOKEN = 'max'
+
+ character (len=4), parameter :: MESH_STREAM = 'mesh'
+ character (len=5), parameter :: TIME_STREAM = 'xtime'
+
+ character (len=StrKIND), parameter :: ONE_STRING_MEMORY = &
+ 'timeSeriesStatsOneString'
+ character (len=StrKIND), parameter :: ONE_INTEGER_MEMORY = &
+ 'timeSeriesStatsOneInteger'
+ character (len=StrKIND), parameter :: ONE_REAL_MEMORY = &
+ 'timeSeriesStatsOneReal'
+
+ character (len=StrKIND), parameter :: CONFIG_PREFIX = &
+ 'config_AM_timeSeriesStats'
+ character (len=StrKIND), parameter :: FRAMEWORK_PREFIX = 'timeSeriesStats'
+
+ character (len=StrKIND), parameter :: OUTPUT_STREAM_SUFFIX = '_output_stream'
+ character (len=StrKIND), parameter :: RESTART_STREAM_SUFFIX = '_restart_stream'
+ character (len=StrKIND), parameter :: OPERATION_SUFFIX = '_operation'
+ character (len=StrKIND), parameter :: ADD_MESH_SUFFIX = '_add_mesh'
+
+ character (len=StrKIND), parameter :: NUMBER_OF_BUFFERS_SUFFIX = &
+ '_number_of_buffers'
+ character (len=StrKIND), parameter :: NUMBER_OF_VARIABLES_SUFFIX = &
+ '_number_of_variables'
+
+ character (len=StrKIND), parameter :: INPUT_NAME_SUFFIX = '_input_name'
+
+ character (len=StrKIND), parameter :: REFERENCE_TIMES_SUFFIX = &
+ '_reference_times'
+ character (len=StrKIND), parameter :: DURATION_INTERVALS_SUFFIX = &
+ '_duration_intervals'
+ character (len=StrKIND), parameter :: REPEAT_INTERVALS_SUFFIX = &
+ '_repeat_intervals'
+ character (len=StrKIND), parameter :: RESET_INTERVALS_SUFFIX = &
+ '_reset_intervals'
+
+ character (len=StrKIND), parameter :: STARTED_FLAG_SUFFIX = &
+ '_started_flag'
+ character (len=StrKIND), parameter :: ACCUMULATE_FLAG_SUFFIX = &
+ '_accumulate_flag'
+ character (len=StrKIND), parameter :: RESET_FLAG_SUFFIX = &
+ '_reset_flag'
+ character (len=StrKIND), parameter :: START_ALARM_ID_SUFFIX = &
+ '_start_alarm_ID'
+ character (len=StrKIND), parameter :: REPEAT_ALARM_ID_SUFFIX = &
+ '_repeat_alarm_ID'
+ character (len=StrKIND), parameter :: DURATION_ALARM_ID_SUFFIX = &
+ '_duration_alarm_ID'
+ character (len=StrKIND), parameter :: RESET_ALARM_ID_SUFFIX = &
+ '_reset_alarm_ID'
+ character (len=StrKIND), parameter :: COUNTER_SUFFIX = &
+ '_counter_'
+
+ character (len=StrKIND), parameter :: START_ALARM_PREFIX = '_startAlarm_'
+ character (len=StrKIND), parameter :: REPEAT_ALARM_PREFIX = '_repeatAlarm_'
+ character (len=StrKIND), parameter :: DURATION_ALARM_PREFIX = &
+ '_durationAlarm_'
+ character (len=StrKIND), parameter :: RESET_ALARM_PREFIX = '_resetAlarm_'
+
+ character (len=StrKIND), parameter :: INITIAL_TIME_TOKEN = 'initial_time'
+ character (len=StrKIND), parameter :: REPEAT_INTERVAL_TOKEN = &
+ 'repeat_interval'
+ character (len=StrKIND), parameter :: RESET_INTERVAL_TOKEN = 'reset_interval'
+
+!***********************************************************************
+contains
+
+!***********************************************************************
+! routine ocn_bootstrap_time_series_stats
+!
+!> \brief Bootstrap time_series_stats analysis member
+!> \author Doug Jacobsen
+!> \date 10/08/2015
+!> \details
+!> This routine performs pre-init configuration of the analysis member.
+!> Specifically, it ensures the streams used for this instance are correctly
+!> configured.
+!-----------------------------------------------------------------------
+subroutine ocn_bootstrap_time_series_stats(domain, err)!{{{
+ ! input variables
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+
+ ! output variables
+ integer, intent(out) :: err !< Output: error flag
+
+ ! local variables
+ integer :: v
+ character (len=StrKIND) :: instance ! TODO intent(in)
+ type (time_series_type) :: series
+ type (time_series_alarms_type), allocatable, dimension(:) :: alarms
+
+ ! start procedure
+ err = 0
+
+ ! TODO placeholder for some unique ID if this code is replicated
+ instance = '' ! TODO to be passed in
+
+ ! initial allocation of instance state for this AM from the namelist
+ call start_state(domain, instance, series, err)
+
+ ! modify the output and restart streams for this AM instance
+ ! driver will do a restart read, after this, if necessary to fill values
+ call modify_stream(domain, instance, series, err)
+
+ ! clean up the instance memory
+ do v = 1, series % number_of_variables
+ deallocate(series % variables(v) % output_names)
+ end do
+ deallocate(series % variables)
+ deallocate(series % buffers)
+end subroutine ocn_bootstrap_time_series_stats!}}}
+
+!***********************************************************************
+! routine ocn_init_time_series_stats
+!
+!> \brief Initialize MPAS-Ocean analysis member
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> This routine conducts all initializations required for the
+!> MPAS-Ocean analysis member.
+!-----------------------------------------------------------------------
+subroutine ocn_init_time_series_stats(domain, err)!{{{
+ ! input variables
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+
+ ! output variables
+ integer, intent(out) :: err !< Output: error flag
+
+ ! local variables
+ integer :: v
+ character (len=StrKIND) :: instance ! TODO intent(in)
+ type (time_series_type) :: series
+ type (time_series_alarms_type), allocatable, dimension(:) :: alarms
+
+ ! start procedure
+ err = 0
+
+ ! TODO placeholder for some unique ID if this code is replicated
+ instance = '' ! TODO to be passed in
+
+ ! coming back from a potential restart read
+ ! get all of the state for this instance
+ call get_state(domain, instance, series)
+
+ ! get all of the timing configurations from namelist
+ allocate(alarms(series % number_of_buffers))
+ call get_alarms(domain, instance, series, alarms, err)
+
+ ! set the values of the alarms and current flag states based on timers
+ call set_alarms(domain, instance, series, alarms, err)
+ deallocate(alarms)
+
+ ! clean up the instance memory
+ do v = 1, series % number_of_variables
+ deallocate(series % variables(v) % output_names)
+ end do
+ deallocate(series % variables)
+ deallocate(series % buffers)
+end subroutine ocn_init_time_series_stats!}}}
+
+
+!***********************************************************************
+! routine ocn_compute_time_series_stats
+!
+!> \brief Compute MPAS-Ocean analysis member
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> This routine conducts all computation required for this
+!> MPAS-Ocean analysis member.
+!-----------------------------------------------------------------------
+subroutine ocn_compute_time_series_stats(domain, timeLevel, err)!{{{
+ ! input variables
+ integer, intent(in) :: timeLevel
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+
+ ! output variables
+ integer, intent(out) :: err !< Output: error flag
+
+ ! local variables
+ character (len=StrKIND) :: instance ! TODO intent(in)
+ integer :: v, b
+ type (time_series_type) :: series
+
+ ! start procedure
+ err = 0
+
+ ! TODO placeholder for some unique ID if this code is replicated
+ instance = '' ! TODO to be passed in
+
+ ! get all of the state for this instance to be able to compute
+ call get_state(domain, instance, series)
+
+ ! update the counter
+ do b = 1, series % number_of_buffers
+ if (series % buffers(b) % accumulate_flag == 1) then
+ if (series % buffers(b) % reset_flag == 1) then
+ series % buffers(b) % counter = 1
+ else
+ series % buffers(b) % counter = series % buffers(b) % counter + 1
+ end if
+ end if
+ end do
+
+ ! do all of the operations
+ do v = 1, series % number_of_variables
+ call typed_operate(domain % blocklist, &
+ series % variables(v), &
+ series % buffers, &
+ series % operation)
+ end do
+
+ ! do all of the time checking and flag setting
+ call timer_checking(series, domain % clock, err)
+
+ ! clean up the instance memory
+ do v = 1, series % number_of_variables
+ deallocate(series % variables(v) % output_names)
+ end do
+ deallocate(series % variables)
+ deallocate(series % buffers)
+end subroutine ocn_compute_time_series_stats!}}}
+
+
+
+!***********************************************************************
+! routine ocn_restart_time_series_stats
+!
+!> \brief Save restart for MPAS-Ocean analysis member
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> This routine conducts computation required to save a restart state
+!> for the MPAS-Ocean analysis member.
+!-----------------------------------------------------------------------
+subroutine ocn_restart_time_series_stats(domain, err)!{{{
+ ! input variables
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+
+ ! output variables
+ integer, intent(out) :: err !< Output: error flag
+
+ ! local variables
+
+ ! start procedure
+ err = 0
+
+end subroutine ocn_restart_time_series_stats!}}}
+
+
+
+!***********************************************************************
+! routine ocn_finalize_time_series_stats
+!
+!> \brief Finalize MPAS-Ocean analysis member
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> This routine conducts all finalizations required for this
+!> MPAS-Ocean analysis member.
+!-----------------------------------------------------------------------
+subroutine ocn_finalize_time_series_stats(domain, err)!{{{
+ ! input variables
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+
+ ! output variables
+ integer, intent(out) :: err !< Output: error flag
+
+ ! local variables
+
+ ! start procedure
+ err = 0
+
+end subroutine ocn_finalize_time_series_stats!}}}
+
+!
+! local subroutines
+!
+
+!***********************************************************************
+! routine get_state
+!
+!> \brief Get all of the state for this instance.
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> This will allocate and fetch all of the state necessary for this
+!> instance that is being run.
+!-----------------------------------------------------------------------
+subroutine get_state(domain, instance, series)
+ ! input variables
+ character (len=StrKIND), intent(in) :: instance
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+
+ ! output variables
+ type (time_series_type), intent(out) :: series
+
+ ! local variables
+ integer :: v, b
+ character (len=StrKIND) :: storage_prefix, var_identifier, &
+ buf_identifier, var_prefix, buf_prefix, field_name, op_name
+
+ ! start procedure
+ storage_prefix = trim(FRAMEWORK_PREFIX) // trim(instance)
+
+ !
+ ! get the base
+ !
+
+ ! number_of_variables
+ field_name = trim(storage_prefix) // trim(NUMBER_OF_VARIABLES_SUFFIX)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ field_name, series % number_of_variables, 1)
+
+ ! number_of_buffers
+ field_name = trim(storage_prefix) // trim(NUMBER_OF_BUFFERS_SUFFIX)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ field_name, series % number_of_buffers, 1)
+
+ ! operation
+ field_name = trim(storage_prefix) // trim(OPERATION_SUFFIX)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ field_name, series % operation, 1)
+
+ ! operator
+ if (series % operation == AVG_OP) then
+ op_name = AVG_TOKEN
+ else if (series % operation == MIN_OP) then
+ op_name = MIN_TOKEN
+ else
+ op_name = MAX_TOKEN
+ end if
+
+ ! create the memory
+ allocate(series % variables(series % number_of_variables))
+ allocate(series % buffers(series % number_of_buffers))
+ do v = 1, series % number_of_variables
+ allocate(series % variables(v) % output_names(series % number_of_buffers))
+ end do
+
+ !
+ ! get the instance values for variables
+ !
+
+ do v = 1, series % number_of_variables
+ ! identifier
+ write(var_identifier, '(I0)') v
+ var_prefix = trim(storage_prefix) // '_' // trim(var_identifier)
+
+ ! input_name
+ field_name = trim(var_prefix) // trim(INPUT_NAME_SUFFIX)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ field_name, series % variables(v) % input_name, 1)
+
+ do b = 1, series % number_of_buffers
+ write(buf_identifier, '(I0)') b
+
+ ! create output names
+ series % variables(v) % output_names(b) = output_naming &
+ (storage_prefix, op_name, series % variables(v) % input_name, &
+ buf_identifier)
+ end do
+ end do
+
+ !
+ ! get the instance values for buffers
+ !
+
+ do b = 1, series % number_of_buffers
+ ! identifier
+ write(buf_identifier, '(I0)') b
+ buf_prefix = trim(storage_prefix) // '_' // trim(buf_identifier)
+
+ ! started_flag
+ field_name = trim(buf_prefix) // trim(STARTED_FLAG_SUFFIX)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ field_name, series % buffers(b) % started_flag, 1)
+
+ ! accumulate_flag
+ field_name = trim(buf_prefix) // trim(ACCUMULATE_FLAG_SUFFIX)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ field_name, series % buffers(b) % accumulate_flag, 1)
+
+ ! reset_flag
+ field_name = trim(buf_prefix) // trim(RESET_FLAG_SUFFIX)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ field_name, series % buffers(b) % reset_flag, 1)
+
+ ! start_alarm_ID
+ field_name = trim(buf_prefix) // trim(START_ALARM_ID_SUFFIX)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ field_name, series % buffers(b) % start_alarm_ID, 1)
+
+ ! repeat_alarm_ID
+ field_name = trim(buf_prefix) // trim(REPEAT_ALARM_ID_SUFFIX)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ field_name, series % buffers(b) % repeat_alarm_ID, 1)
+
+ ! duration_alarm_ID
+ field_name = trim(buf_prefix) // trim(DURATION_ALARM_ID_SUFFIX)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ field_name, series % buffers(b) % duration_alarm_ID, 1)
+
+ ! reset_alarm_ID
+ field_name = trim(buf_prefix) // trim(RESET_ALARM_ID_SUFFIX)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ field_name, series % buffers(b) % reset_alarm_ID, 1)
+
+ ! counter
+ field_name = counter_naming(storage_prefix, buf_identifier)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ field_name, series % buffers(b) % counter, 1)
+ end do
+
+end subroutine get_state
+
+!***********************************************************************
+! routine start_state
+!
+!> \brief Begin the initialization of this analysis member
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> This will count the number of variables, number of buffers, and
+!> also get the stream name and operation strings.
+!-----------------------------------------------------------------------
+subroutine start_state(domain, instance, series, err)
+ ! input variables
+ character (len=StrKIND), intent(in) :: instance
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+
+ ! output variables
+ type (time_series_type), intent(out) :: series
+ integer, intent(out) :: err !< Output: error flag
+
+ ! local variables
+ character (len=StrKIND), pointer :: config_results, output_stream_name
+ character (len=StrKIND) :: config, namelist_prefix, storage_prefix, &
+ var_identifier, buf_identifier, var_prefix, buf_prefix
+ integer :: b, v
+ type (field0DChar), pointer :: srcString, dstString
+ type (field0DInteger), pointer :: srcInteger, dstInteger
+
+ ! start procedure
+ err = 0
+
+ namelist_prefix = trim(CONFIG_PREFIX) // trim(instance)
+ storage_prefix = trim(FRAMEWORK_PREFIX) // trim(instance)
+
+ !
+ ! allocate some framework memory for instance state
+ !
+
+ ! number_of_variables
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ ONE_INTEGER_MEMORY, srcInteger, 1)
+ call mpas_duplicate_field(srcInteger, dstInteger)
+ dstInteger % fieldName = &
+ trim(storage_prefix) // trim(NUMBER_OF_VARIABLES_SUFFIX)
+ call mpas_pool_add_field(domain % blocklist % allFields, &
+ dstInteger % fieldName, dstInteger)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ dstInteger % fieldName, series % number_of_variables, 1)
+
+ ! number_of_buffers
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ ONE_INTEGER_MEMORY, srcInteger, 1)
+ call mpas_duplicate_field(srcInteger, dstInteger)
+ dstInteger % fieldName = &
+ trim(storage_prefix) // trim(NUMBER_OF_BUFFERS_SUFFIX)
+ call mpas_pool_add_field(domain % blocklist % allFields, &
+ dstInteger % fieldName, dstInteger)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ dstInteger % fieldName, series % number_of_buffers, 1)
+
+ ! operation
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ ONE_INTEGER_MEMORY, srcInteger, 1)
+ call mpas_duplicate_field(srcInteger, dstInteger)
+ dstInteger % fieldName = &
+ trim(storage_prefix) // trim(OPERATION_SUFFIX)
+ call mpas_pool_add_field(domain % blocklist % allFields, &
+ dstInteger % fieldName, dstInteger)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ dstInteger % fieldName, series % operation, 1)
+
+ !
+ ! assign some instance values
+ !
+
+ ! get the stream name
+ config = trim(namelist_prefix) // trim(OUTPUT_STREAM_SUFFIX)
+ call mpas_pool_get_config(domain % configs, config, output_stream_name)
+
+ if (output_stream_name == 'none') then
+ call mpas_dmpar_global_abort('MPAS-ocean: Error: stream cannot be "none" ' // &
+ 'for time series stats.')
+ end if
+
+ ! count the number of variables
+ call mpas_stream_mgr_begin_iteration(domain % streamManager, &
+ output_stream_name, err)
+ series % number_of_variables = 0
+ do while (mpas_stream_mgr_get_next_field(domain % streamManager, &
+ output_stream_name, config))
+ series % number_of_variables = series % number_of_variables + 1
+ end do
+
+ ! count the number of buffers
+ config = trim(namelist_prefix) // trim(REFERENCE_TIMES_SUFFIX)
+ call mpas_pool_get_config(domain % configs, config, config_results)
+ config = config_results
+ series % number_of_buffers = 1
+ b = scan(config, ';')
+ do while (b > 0)
+ series % number_of_buffers = series % number_of_buffers + 1
+ config = config(b+1:)
+ b = scan(config, ';')
+ end do
+
+ ! get our operation
+ config = trim(namelist_prefix) // trim(OPERATION_SUFFIX)
+ call mpas_pool_get_config(domain % configs, config, config_results)
+ if (config_results == AVG_TOKEN) then
+ series % operation = AVG_OP
+ else if (config_results == MIN_TOKEN) then
+ series % operation = MIN_OP
+ else if (config_results == MAX_TOKEN) then
+ series % operation = MAX_OP
+ else
+ ! error if unknown operation
+ call mpas_dmpar_global_abort('MPAS-ocean: Error: unknown operation in time ' // &
+ 'averaging analysis member configuration.')
+ end if
+
+ ! create the memory
+ allocate(series % variables(series % number_of_variables))
+ allocate(series % buffers(series % number_of_buffers))
+ do v = 1, series % number_of_variables
+ allocate(series % variables(v) % output_names(series % number_of_buffers))
+ end do
+
+ !
+ ! duplicate memory for storing AM instance state in the framework
+ !
+
+ ! create variable space
+ do v = 1, series % number_of_variables
+ ! identifier
+ write(var_identifier, '(I0)') v
+ var_prefix = trim(storage_prefix) // '_' // trim(var_identifier)
+
+ ! input_name
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ ONE_STRING_MEMORY, srcString, 1)
+ call mpas_duplicate_field(srcString, dstString)
+ dstString % fieldName = trim(var_prefix) // trim(INPUT_NAME_SUFFIX)
+ call mpas_pool_add_field(domain % blocklist % allFields, &
+ dstString % fieldName, dstString)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ dstString % fieldName, series % variables(v) % input_name, 1)
+ end do
+
+ ! create buffer space
+ do b = 1, series % number_of_buffers
+ ! identifier
+ write(buf_identifier, '(I0)') b
+ buf_prefix = trim(storage_prefix) // '_' // trim(buf_identifier)
+
+ ! started_flag
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ ONE_INTEGER_MEMORY, srcInteger, 1)
+ call mpas_duplicate_field(srcInteger, dstInteger)
+ dstInteger % fieldName = trim(buf_prefix) // trim(STARTED_FLAG_SUFFIX)
+ call mpas_pool_add_field(domain % blocklist % allFields, &
+ dstInteger % fieldName, dstInteger)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ dstInteger % fieldName, series % buffers(b) % started_flag, 1)
+
+ ! accumulate_flag
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ ONE_INTEGER_MEMORY, srcInteger, 1)
+ call mpas_duplicate_field(srcInteger, dstInteger)
+ dstInteger % fieldName = trim(buf_prefix) // trim(ACCUMULATE_FLAG_SUFFIX)
+ call mpas_pool_add_field(domain % blocklist % allFields, &
+ dstInteger % fieldName, dstInteger)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ dstInteger % fieldName, series % buffers(b) % accumulate_flag, 1)
+
+ ! reset_flag
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ ONE_INTEGER_MEMORY, srcInteger, 1)
+ call mpas_duplicate_field(srcInteger, dstInteger)
+ dstInteger % fieldName = trim(buf_prefix) // trim(RESET_FLAG_SUFFIX)
+ call mpas_pool_add_field(domain % blocklist % allFields, &
+ dstInteger % fieldName, dstInteger)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ dstInteger % fieldName, series % buffers(b) % reset_flag, 1)
+
+ ! start_alarm_ID
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ ONE_STRING_MEMORY, srcString, 1)
+ call mpas_duplicate_field(srcString, dstString)
+ dstString % fieldName = trim(buf_prefix) // trim(START_ALARM_ID_SUFFIX)
+ call mpas_pool_add_field(domain % blocklist % allFields, &
+ dstString % fieldName, dstString)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ dstString % fieldName, series % buffers(b) % start_alarm_ID, 1)
+
+ ! repeat_alarm_ID
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ ONE_STRING_MEMORY, srcString, 1)
+ call mpas_duplicate_field(srcString, dstString)
+ dstString % fieldName = trim(buf_prefix) // trim(REPEAT_ALARM_ID_SUFFIX)
+ call mpas_pool_add_field(domain % blocklist % allFields, &
+ dstString % fieldName, dstString)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ dstString % fieldName, series % buffers(b) % repeat_alarm_ID, 1)
+
+ ! duration_alarm_ID
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ ONE_STRING_MEMORY, srcString, 1)
+ call mpas_duplicate_field(srcString, dstString)
+ dstString % fieldName = trim(buf_prefix) // trim(DURATION_ALARM_ID_SUFFIX)
+ call mpas_pool_add_field(domain % blocklist % allFields, &
+ dstString % fieldName, dstString)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ dstString % fieldName, series % buffers(b) % duration_alarm_ID, 1)
+
+ ! reset_alarm_ID
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ ONE_STRING_MEMORY, srcString, 1)
+ call mpas_duplicate_field(srcString, dstString)
+ dstString % fieldName = trim(buf_prefix) // trim(RESET_ALARM_ID_SUFFIX)
+ call mpas_pool_add_field(domain % blocklist % allFields, &
+ dstString % fieldName, dstString)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ dstString % fieldName, series % buffers(b) % reset_alarm_ID, 1)
+
+ !
+ ! counter is not allocated here, because it is part of the restart stream,
+ ! and not just the internal AM state
+ !
+ ! it is allocated in modify_stream
+ !
+ end do
+end subroutine start_state
+
+
+
+!***********************************************************************
+! routine modify_stream
+!
+!> \brief Remove existing variables and replace them with new ones
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> Given a stream name, this will remove the existing variables
+!> in a stream and replace them with similiarly named ones for
+!> their accumulation. It will also add xtime and optionally the mesh.
+!-----------------------------------------------------------------------
+subroutine modify_stream(domain, instance, series, err)!{{{
+ ! input variables
+ character (len=StrKIND), intent(in) :: instance
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+ type (time_series_type), intent(inout) :: series
+
+ ! output variables
+ integer, intent(out) :: err !< Output: error flag
+
+ ! local variables
+ integer :: v, b
+ logical :: emptyRestartStream
+ character (len=StrKIND), pointer :: output_stream_name, restart_stream_name
+ character (len=StrKIND) :: fieldName
+ type (field0DReal), pointer :: srcReal, dstReal
+ logical, pointer :: copy_mesh
+ character (len=StrKIND) :: field_name, config, op_name
+ character (len=StrKIND) :: namelist_prefix, &
+ storage_prefix, buf_identifier, buf_prefix
+ type (mpas_pool_field_info_type) :: info
+
+ ! start procedure
+ err = 0
+
+ namelist_prefix = trim(CONFIG_PREFIX) // trim(instance)
+ storage_prefix = trim(FRAMEWORK_PREFIX) // trim(instance)
+
+ ! get the output stream name
+ config = trim(namelist_prefix) // trim(OUTPUT_STREAM_SUFFIX)
+ call mpas_pool_get_config(domain % configs, config, output_stream_name)
+
+ ! get restart stream name
+ config = trim(namelist_prefix) // trim(RESTART_STREAM_SUFFIX)
+ call mpas_pool_get_config(domain % configs, config, restart_stream_name)
+
+ ! operator
+ if (series % operation == AVG_OP) then
+ op_name = AVG_TOKEN
+ else if (series % operation == MIN_OP) then
+ op_name = MIN_TOKEN
+ else
+ op_name = MAX_TOKEN
+ end if
+
+ ! get the old field names
+ call mpas_stream_mgr_begin_iteration(domain % streamManager, &
+ output_stream_name, err)
+ v = 1
+ do while (mpas_stream_mgr_get_next_field(domain % streamManager, &
+ output_stream_name, field_name))
+ series % variables(v) % input_name = field_name
+ v = v + 1
+ end do
+
+ ! remove the old ones from the stream
+ do v = 1, series % number_of_variables
+ call mpas_stream_mgr_remove_field(domain % streamManager, &
+ output_stream_name, series % variables(v) % input_name)
+ end do
+
+ !
+ ! create memory and modify the stream
+ !
+
+ ! add xtime to the output stream
+ call mpas_stream_mgr_add_field(domain % streamManager, &
+ output_stream_name, TIME_STREAM, ierr=err)
+
+ ! optionally add mesh to output stream
+ config = trim(namelist_prefix) // trim(ADD_MESH_SUFFIX)
+ call mpas_pool_get_config(domain % configs, config, copy_mesh)
+ if (copy_mesh) then
+ call mpas_stream_mgr_begin_iteration(domain % streamManager, &
+ MESH_STREAM, err)
+ do while (mpas_stream_mgr_get_next_field(domain % streamManager, &
+ MESH_STREAM, field_name))
+ call mpas_stream_mgr_add_field(domain % streamManager, &
+ output_stream_name, field_name, ierr=err)
+ end do
+ end if
+
+ ! ensure restart stream is empty
+ emptyRestartStream = .true.
+ call mpas_stream_mgr_begin_iteration(domain % streamManager, streamID=restart_stream_name, ierr=err)
+ do while (mpas_stream_mgr_get_next_field(domain % streamManager, streamID=restart_stream_name, fieldName=fieldName) &
+ .and. emptyRestartStream)
+ emptyRestartStream = .false.
+ end do
+
+ if (.not. emptyRestartStream) then
+ write(stderrUnit, *) 'ERROR: Stream named ''' // trim(restart_stream_name) // ''' is not empty, but is used in '
+ write(stderrUnit, *) ' an instance of the time series stats analysis member. This stream will be built'
+ write(stderrUnit, *) ' based on the contents of the ''' // trim(output_stream_name) // ''' stream.'
+ write(stderrUnit, *) ' Please ensure it is empty in the streams file.'
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: Misconfigured streams for time series stats analysis member.')
+ end if
+
+ ! create and put the counters in the streams
+ do b = 1, series % number_of_buffers
+ write(buf_identifier, '(I0)') b
+
+ field_name = counter_naming(storage_prefix, buf_identifier)
+
+ ! allocate counter memory
+ call mpas_pool_get_field(domain % blocklist % allFields, &
+ ONE_REAL_MEMORY, srcReal, 1)
+ call mpas_duplicate_field(srcReal, dstReal)
+ dstReal % fieldName = field_name
+ call mpas_pool_add_field(domain % blocklist % allFields, &
+ dstReal % fieldName, dstReal)
+ call mpas_pool_get_array(domain % blocklist % allFields, &
+ dstReal % fieldName, series % buffers(b) % counter, 1)
+
+ ! put it in the output stream
+ call mpas_stream_mgr_add_field(domain % streamManager, &
+ output_stream_name, dstReal % fieldName, ierr=err)
+
+ ! put it in the restart stream
+ call mpas_stream_mgr_add_field(domain % streamManager, &
+ restart_stream_name, dstReal % fieldName, ierr=err)
+ end do
+
+ ! set up the variables
+ call mpas_stream_mgr_begin_iteration(domain % streamManager, &
+ output_stream_name, err)
+ do v = 1, series % number_of_variables
+ ! get the info of the field
+ call mpas_pool_get_field_info(domain % blocklist % allFields, &
+ series % variables(v) % input_name, info)
+
+ ! check if we can handle it
+ if(.not. ((info % fieldType == MPAS_POOL_REAL) &
+ .or. (info % fieldType == MPAS_POOL_INTEGER))) then
+ call mpas_dmpar_global_abort('MPAS-ocean: Error: field "' // &
+ trim(series % variables(v) % input_name) // '" listed in the ' // &
+ 'output stream, for time series stats analysis member ' // &
+ 'stream, is not real or integer.')
+ end if
+
+ ! allocate a number of fields and add field
+ do b = 1, series % number_of_buffers
+ write(buf_identifier, '(I0)') b
+
+ field_name = output_naming(storage_prefix, op_name, &
+ series % variables(v) % input_name, buf_identifier)
+
+ ! create the name of the output var
+ series % variables(v) % output_names(b) = field_name
+
+ ! create the field and add to pool
+ call add_new_field(info, &
+ series % variables(v) % input_name, &
+ series % variables(v) % output_names(b), &
+ domain % blocklist % allFields)
+
+ ! add the field to the output stream
+ call mpas_stream_mgr_add_field(domain % streamManager, &
+ output_stream_name, series % variables(v) % output_names(b), ierr=err)
+
+ ! put it in the restart stream
+ call mpas_stream_mgr_add_field(domain % streamManager, &
+ restart_stream_name, series % variables(v) % output_names(b), ierr=err)
+ end do
+ end do ! number_of_variables
+
+end subroutine modify_stream!}}}
+
+
+!***********************************************************************
+! function output_naming
+!
+!> \brief Given an input name, create a cooresponding output name
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> Code to create consistent output names from input names.
+!-----------------------------------------------------------------------
+character (len=StrKIND) function output_naming &
+(storage_prefix, op_name, input_name, buf_identifier)
+ character (len=StrKIND), intent(in) :: storage_prefix, op_name, &
+ input_name, buf_identifier
+
+ output_naming = trim(storage_prefix) // '_' // trim(op_name) // '_' // &
+ trim(input_name) // '_' // trim(buf_identifier)
+end function output_naming
+
+
+!***********************************************************************
+! function counter_naming
+!
+!> \brief Given an buffer number, create a cooresponding counter name
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> Code to create consistent counter names from buffer numbers.
+!-----------------------------------------------------------------------
+character (len=StrKIND) function counter_naming &
+(storage_prefix, buf_identifier)
+ character (len=StrKIND), intent(in) :: storage_prefix, buf_identifier
+
+ counter_naming = trim(storage_prefix) // trim(COUNTER_SUFFIX) // &
+ trim(buf_identifier)
+end function counter_naming
+
+
+
+!***********************************************************************
+! routine get_alarms
+!
+!> \brief Read the namelist for timings
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> This will read the namelist and get the strings and set the clocks
+!> for the different timers to be used. The actual alarms are not set.
+!-----------------------------------------------------------------------
+subroutine get_alarms(domain, instance, series, alarms, err)
+ ! input variables
+ character (len=StrKIND), intent(in) :: instance
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+ type (time_series_type), intent(inout) :: series
+
+ ! output variables
+ integer, intent(out) :: err !< Output: error flag
+ type (time_series_alarms_type), dimension(:), intent(out) :: alarms
+
+ ! local variables
+ character (len=StrKIND), pointer :: config_results
+ character (len=StrKIND) :: config, namelist_prefix
+ integer :: b, n
+ logical :: ok
+ type (mpas_timeinterval_type) :: rem, zero
+
+ ! create prefix
+ namelist_prefix = trim(CONFIG_PREFIX) // trim(instance)
+
+ ! configure start times - we don't have to check ok
+ ! because the timer count is based on reference_times tokens
+ config = trim(namelist_prefix) // trim(REFERENCE_TIMES_SUFFIX)
+ call mpas_pool_get_config(domain % configs, config, config_results)
+ call set_times(series, alarms, domain % clock, START_TIMES, &
+ config_results, ok, err)
+
+ ! order matters, don't reorder these following ones!
+ ! it matters because times/intervals can be configured to be equal
+ ! to other ones
+
+ ! configure reset intervals
+ config = trim(namelist_prefix) // trim(RESET_INTERVALS_SUFFIX)
+ call mpas_pool_get_config(domain % configs, config, config_results)
+ call set_times(series, alarms, domain % clock, RESET_INTERVALS, &
+ config_results, ok, err)
+ if (.not. ok) then
+ call mpas_dmpar_global_abort('MPAS-ocean: Error: number of times in ' // &
+ 'reset_intervals is not consistent with number of times ' // &
+ 'in reference_times in time series stats analysis member ' // &
+ 'configuration.')
+ end if
+
+ ! configure repeat intervals
+ config = trim(namelist_prefix) // trim(REPEAT_INTERVALS_SUFFIX)
+ call mpas_pool_get_config(domain % configs, config, config_results)
+ call set_times(series, alarms, domain % clock, REPEAT_INTERVALS, &
+ config_results, ok, err)
+ if (.not. ok) then
+ call mpas_dmpar_global_abort('MPAS-ocean: Error: number of times in ' // &
+ 'repeat_intervals is not consistent with number of times ' // &
+ 'in reference_times in time series stats analysis member ' // &
+ 'configuration.')
+ end if
+
+ ! configure duration intervals
+ config = trim(namelist_prefix) // trim(DURATION_INTERVALS_SUFFIX)
+ call mpas_pool_get_config(domain % configs, config, config_results)
+ call set_times(series, alarms, domain % clock, DURATION_INTERVALS, &
+ config_results, ok, err)
+ if (.not. ok) then
+ call mpas_dmpar_global_abort('MPAS-ocean: Error: number of times in ' // &
+ 'duration_intervals is not consistent with number of times ' // &
+ 'in reference_times in time series stats analysis member ' // &
+ 'configuration.')
+ end if
+
+ ! check if some of the time configuration is sensible
+ call mpas_set_timeInterval(zero, s=0)
+
+ do b = 1, series % number_of_buffers
+ call mpas_interval_division(alarms(b) % start_time, &
+ alarms(b) % repeat_interval, &
+ alarms(b) % reset_interval, n, rem)
+
+ if (n > 1 .or. (n == 1 .and. rem /= zero)) then
+ write(stderrUnit,*) 'Warning: repeat_interval > ' // &
+ 'reset_interval in time averaging analysis member ' // &
+ 'configuration. Truncating repeat_interval.'
+ alarms(b) % repeat_interval = alarms(b) % reset_interval
+ end if
+
+ call mpas_interval_division(alarms(b) % start_time, &
+ alarms(b) % duration_interval, &
+ alarms(b) % repeat_interval, n, rem)
+
+ if (n > 1 .or. (n == 1 .and. rem /= zero)) then
+ write(stderrUnit,*) 'Warning: duration_interval > ' // &
+ 'repeat_interval in time averaging analysis member ' // &
+ 'configuration. Truncating duration_interval.'
+ alarms(b) % repeat_interval = alarms(b) % reset_interval
+ end if
+ end do
+end subroutine get_alarms
+
+
+
+!***********************************************************************
+! routine set_alarms
+!
+!> \brief Set the alarms based on the clocks
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> Alarms for the different timers are set, such that temporal
+!> window alarms are configured.
+!-----------------------------------------------------------------------
+subroutine set_alarms(domain, instance, series, alarms, err)
+ ! input variables
+ character (len=StrKIND), intent(in) :: instance
+
+ ! input/output variables
+ type (domain_type), intent(inout) :: domain
+ type (time_series_type), intent(inout) :: series
+ type (time_series_alarms_type), dimension(:), intent(inout) :: alarms
+
+ ! output variables
+ integer, intent(out) :: err !< Output: error flag
+
+ ! local variables
+ integer :: b, repeat_n, duration_n, reset_n
+ character (len=StrKIND) :: buf_identifier, alarm_prefix
+ type (mpas_time_type) :: current_time, when, &
+ duration_time, repeat_time, reset_time
+ type (mpas_timeinterval_type) :: elapsed, zero, &
+ repeat_rem, duration_rem, reset_rem, zero_intv
+
+ ! start procedure
+ alarm_prefix = trim(FRAMEWORK_PREFIX) // trim(instance)
+
+ ! get current time
+ current_time = mpas_get_clock_time(domain % clock, MPAS_NOW, err)
+ call mpas_set_timeInterval(zero_intv, S=0)
+
+ ! configure alarms
+ do b = 1, series % number_of_buffers
+ write(buf_identifier, '(I0)') b
+
+ ! zero flags
+ series % buffers(b) % started_flag = 0
+ series % buffers(b) % reset_flag = 0
+ series % buffers(b) % accumulate_flag = 0
+
+ ! set start time and flag
+ if (current_time >= alarms(b) % start_time) then
+ series % buffers(b) % started_flag = 1
+
+ ! no start alarm
+ series % buffers(b) % start_alarm_ID = ''
+ else
+ ! set the start alarm
+ series % buffers(b) % start_alarm_ID = trim(alarm_prefix) // &
+ trim(START_ALARM_PREFIX) // trim(buf_identifier)
+ call mpas_add_clock_alarm(domain % clock, &
+ series % buffers(b) % start_alarm_ID, &
+ alarms(b) % start_time, ierr=err)
+ end if
+
+ ! set next reset time and flag
+ when = alarms(b) % start_time + alarms(b) % reset_interval
+ if (current_time >= when) then
+ elapsed = current_time - when
+ call mpas_interval_division(when, elapsed, &
+ alarms(b) % reset_interval, reset_n, reset_rem)
+
+ if (reset_rem == zero_intv) then
+ ! reset right now
+ reset_time = current_time + alarms(b) % reset_interval
+ series % buffers(b) % reset_flag = 1
+ else
+ reset_rem = alarms(b) % reset_interval - reset_rem
+ reset_time = current_time + reset_rem
+ end if
+ else
+ reset_time = when
+ end if
+
+ ! set next duration time and flag
+ when = alarms(b) % start_time + alarms(b) % duration_interval ! is offset
+ if (current_time >= when) then
+ elapsed = current_time - when
+ call mpas_interval_division(when, elapsed, &
+ alarms(b) % repeat_interval, & ! repeat is correct
+ duration_n, duration_rem)
+
+ if (duration_rem == zero_intv) then
+ ! turn off accumulation
+ duration_time = current_time + alarms(b) % repeat_interval ! repeat
+ else
+ duration_rem = alarms(b) % repeat_interval - duration_rem ! repeat
+ duration_time = current_time + duration_rem ! remainder of repeat
+ end if
+ else
+ duration_time = when
+ duration_n = -1
+ end if
+
+ ! set next repeat time and flag
+ when = alarms(b) % start_time + alarms(b) % repeat_interval
+ if (current_time >= when) then
+ elapsed = current_time - when
+ call mpas_interval_division(when, elapsed, &
+ alarms(b) % repeat_interval, repeat_n, repeat_rem)
+
+ if (repeat_rem == zero_intv) then
+ repeat_time = current_time + alarms(b) % repeat_interval
+ else
+ repeat_rem = alarms(b) % repeat_interval - repeat_rem
+ repeat_time = current_time + repeat_rem
+ end if
+ else
+ repeat_time = when
+ repeat_n = -1
+ end if
+
+ ! accumulate now if in a window (both duration & repeat are untriggered)
+ if ((duration_n == repeat_n) .and. &
+ (series % buffers(b) % started_flag == 1)) then
+ series % buffers(b) % accumulate_flag = 1
+ end if
+
+ !
+ ! set the reoccurring timers
+ !
+ series % buffers(b) % duration_alarm_ID = trim(alarm_prefix) // &
+ trim(DURATION_ALARM_PREFIX) // trim(buf_identifier)
+ call mpas_add_clock_alarm(domain % clock, &
+ series % buffers(b) % duration_alarm_ID, &
+ duration_time, & ! duration sets the offset
+ alarms(b) % repeat_interval, ierr=err) ! but repeat is interval
+
+ series % buffers(b) % repeat_alarm_ID = trim(alarm_prefix) // &
+ trim(REPEAT_ALARM_PREFIX) // trim(buf_identifier)
+ call mpas_add_clock_alarm(domain % clock, &
+ series % buffers(b) % repeat_alarm_ID, &
+ repeat_time, &
+ alarms(b) % repeat_interval, ierr=err)
+
+ series % buffers(b) % reset_alarm_ID = trim(alarm_prefix) // &
+ trim(RESET_ALARM_PREFIX) // trim(buf_identifier)
+ call mpas_add_clock_alarm(domain % clock, &
+ series % buffers(b) % reset_alarm_ID, &
+ reset_time, &
+ alarms(b) % reset_interval, ierr=err)
+ end do
+end subroutine set_alarms
+
+
+
+!***********************************************************************
+! routine walk_string
+!
+!> \brief Walk a semicolon delimited string to find substrings
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> Walk a string delimited by semicolons and return the first substring
+!> from start index, and modify start to point at the next candidate.
+!-----------------------------------------------------------------------
+subroutine walk_string(next, substr, ok)!{{{
+ ! input variables
+
+ ! input/output variables
+ character (len=StrKIND), intent(inout) :: next
+
+ ! output variables
+ character (len=StrKIND), intent(out) :: substr
+ logical, intent(out) :: ok
+
+ ! local variables
+ integer :: i
+ character (len=StrKIND) :: copy
+
+ ! make a copy
+ copy = trim(next)
+
+ ! if there's anything in it other than whitespace, pass through
+ i = verify(copy, ' ')
+ ok = i > 0
+ if (.not. ok) then
+ return
+ end if
+ copy = trim(next(i:))
+
+ ! find the first semicolon and split
+ i = scan(copy, ';')
+
+ ! return that substring and the remainder
+ if (i > 0) then
+ substr = trim(copy(1:i-1))
+ next = trim(copy(i+1:))
+ else
+ substr = trim(copy)
+ next = ''
+ end if
+
+end subroutine walk_string!}}}
+
+
+
+!***********************************************************************
+! routine set_times
+!
+!> \brief Set a list of times
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> Walk a list of times delimited by spaces and set the time info
+!> for the buffer structure so that alarms can be set.
+!-----------------------------------------------------------------------
+subroutine set_times(series, alarms, clock, which, config, ok, err)
+ ! input variables
+ integer, intent(in) :: which
+ character (len=StrKIND), pointer, intent(in) :: config
+
+ ! input/output variables
+ type (time_series_type), intent(inout) :: series
+ type (MPAS_Clock_type), intent(inout) :: clock
+ type (time_series_alarms_type), dimension(:), intent(inout) :: alarms
+
+ ! output variables
+ logical, intent(out) :: ok
+ integer, intent(out) :: err
+
+ ! local variables
+ character (len=StrKIND) :: next, time
+ integer :: b
+
+ ! find the first time in the list
+ next = config
+ b = 0
+ call walk_string(next, time, ok)
+
+ ! while the time string is ok
+ do while (ok)
+ ! exit if we went over
+ b = b + 1
+ if (b > series % number_of_buffers) then
+ exit
+ end if
+
+ ! set the time
+ if (which == START_TIMES) then
+ if (time == INITIAL_TIME_TOKEN) then
+ alarms(b) % start_time = &
+ mpas_get_clock_time(clock, MPAS_START_TIME, err)
+ else
+ call mpas_set_time(alarms(b) % start_time, &
+ dateTimeString=time, ierr=err)
+ end if
+ else if (which == DURATION_INTERVALS) then
+ if (time == REPEAT_INTERVAL_TOKEN) then
+ alarms(b) % duration_interval = alarms(b) % repeat_interval
+ else
+ call mpas_set_timeInterval(alarms(b) % duration_interval, &
+ timeString=time, ierr=err)
+ end if
+ else if (which == REPEAT_INTERVALS) then
+ if (time == RESET_INTERVAL_TOKEN) then
+ alarms(b) % repeat_interval = alarms(b) % reset_interval
+ else
+ call mpas_set_timeInterval(alarms(b) % repeat_interval, &
+ timeString=time, ierr=err)
+ end if
+ else
+ call mpas_set_timeInterval(alarms(b) % reset_interval, &
+ timeString=time, ierr=err)
+ end if
+
+ ! get the next time string
+ call walk_string(next, time, ok)
+ end do
+
+ ! only ok if we parsed out as many as there are number of buffers
+ ok = series % number_of_buffers == b
+ end subroutine set_times
+
+
+
+!***********************************************************************
+! routine add_new_field
+!
+!> \brief Function to create a new field from an existing field
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> This routine conducts all initializations required for
+!> duplicating a field and adding it to the allFields pool.
+!-----------------------------------------------------------------------
+subroutine add_new_field(info, inname, outname, pool)!{{{
+ ! input variables
+ type (mpas_pool_field_info_type), intent(in) :: info
+ character (len=StrKIND), intent(in) :: inname, outname
+
+ ! input/output variables
+ type (mpas_pool_type), intent(inout) :: pool
+
+ ! output variables
+
+ ! local variables
+
+ ! duplicate field and add new field to pool
+ if (info % fieldType == MPAS_POOL_REAL) then
+ if (info % nDims == 0) then
+ call copy_field_0r(inname, pool, outname)
+ else if (info % nDims == 1) then
+ call copy_field_1r(inname, pool, outname)
+ else if (info % nDims == 2) then
+ call copy_field_2r(inname, pool, outname)
+ else if (info % nDims == 3) then
+ call copy_field_3r(inname, pool, outname)
+ else if (info % nDims == 4) then
+ call copy_field_4r(inname, pool, outname)
+ else
+ call copy_field_5r(inname, pool, outname)
+ end if
+ else
+ if (info % nDims == 0) then
+ call copy_field_0i(inname, pool, outname)
+ else if (info % nDims == 1) then
+ call copy_field_1i(inname, pool, outname)
+ else if (info % nDims == 2) then
+ call copy_field_2i(inname, pool, outname)
+ else
+ call copy_field_3i(inname, pool, outname)
+ end if
+ end if
+
+end subroutine add_new_field!}}}
+
+
+
+!***********************************************************************
+! routine timer_checking
+!
+!> \brief Timer functions to determine when to run
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> This routine conducts timer checking to determine if it
+!> needs to run at this particular time.
+!-----------------------------------------------------------------------
+subroutine timer_checking(series, clock, err)!{{{
+ ! input variables
+
+ ! input/output variables
+ type (time_series_type), intent(inout) :: series
+ type (mpas_clock_type), intent(inout) :: clock
+
+ ! output variables
+ integer, intent(out) :: err
+
+ ! local variables
+ integer :: b
+
+ ! start procedure
+ err = 0
+
+ do b = 1, series % number_of_buffers
+ ! clear any resets
+ if (series % buffers(b) % reset_flag == 1) then
+ if (series % buffers(b) % accumulate_flag == 1) then
+ series % buffers(b) % reset_flag = 0
+ end if
+ end if
+
+ ! see if the started alarm is ringing
+ if (trim(series % buffers(b) % start_alarm_ID) /= '') then
+ if (mpas_is_alarm_ringing(clock, &
+ series % buffers(b) % start_alarm_ID, ierr=err)) then
+ call mpas_reset_clock_alarm(clock, &
+ series % buffers(b) % start_alarm_ID, ierr=err)
+ series % buffers(b) % started_flag = 1
+ series % buffers(b) % reset_flag = 1
+ series % buffers(b) % accumulate_flag = 1
+
+ series % buffers(b) % start_alarm_ID = ''
+ end if
+ end if
+
+ ! if we aren't started, cycle to next buffer
+ if (series % buffers(b) % started_flag == 0) then
+ cycle
+ end if
+
+ ! check various other alarms
+ ! see if we need to reset
+ if(mpas_is_alarm_ringing(clock, &
+ series % buffers(b) % reset_alarm_ID, ierr=err)) then
+ call mpas_reset_clock_alarm(clock, &
+ series % buffers(b) % reset_alarm_ID, ierr=err)
+ series % buffers(b) % reset_flag = 1
+ end if
+
+ ! turn off accumulation
+ !
+ ! duration needs to be >= 2 * compute_interval
+ ! (a series can only be 2 or more)
+ if (mpas_is_alarm_ringing(clock, &
+ series % buffers(b) % duration_alarm_ID, ierr=err)) then
+ call mpas_reset_clock_alarm(clock, &
+ series % buffers(b) % duration_alarm_ID, ierr=err)
+ series % buffers(b) % accumulate_flag = 0
+ end if
+
+ ! turn on accumulation
+ ! (this is second, in case the duration and repeat
+ ! overlaps on the same timer)
+ if (mpas_is_alarm_ringing(clock, &
+ series % buffers(b) % repeat_alarm_ID, ierr=err)) then
+ call mpas_reset_clock_alarm(clock, &
+ series % buffers(b) % repeat_alarm_ID, ierr=err)
+ series % buffers(b) % accumulate_flag = 1
+ end if
+
+ end do
+end subroutine timer_checking!}}}
+
+
+
+!***********************************************************************
+! routine typed_operate
+!
+!> \brief Do the operation, but switch on run-time type
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> Since we don't know the type of the array, we need to do some
+!> run-time type switching based on the type of the array.
+!-----------------------------------------------------------------------
+subroutine typed_operate(block, variable, buffers, operation)!{{{
+ ! input variables
+ type (block_type), pointer, intent(in) :: block
+ integer, intent(in) :: operation
+ type (time_series_variable_type), intent(in) :: variable
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+
+ ! input/output variables
+
+ ! output variables
+
+ ! local variables
+ type (mpas_pool_field_info_type) :: info
+
+ ! get the info
+ call mpas_pool_get_field_info(block % allFields, variable % input_name, info)
+
+ ! switch based on the type, dimensionality, and operation
+ if (info % fieldType == MPAS_POOL_REAL) then
+ if (info % nDims == 0) then
+ if (operation == AVG_OP) then
+ call operate0r_avg(block, variable, buffers)
+ else if (operation == MIN_OP) then
+ call operate0r_min(block, variable, buffers)
+ else
+ call operate0r_max(block, variable, buffers)
+ end if
+ else if (info % nDims == 1) then
+ if (operation == AVG_OP) then
+ call operate1r_avg(block, variable, buffers)
+ else if (operation == MIN_OP) then
+ call operate1r_min(block, variable, buffers)
+ else
+ call operate1r_max(block, variable, buffers)
+ end if
+ else if (info % nDims == 2) then
+ if (operation == AVG_OP) then
+ call operate2r_avg(block, variable, buffers)
+ else if (operation == MIN_OP) then
+ call operate2r_min(block, variable, buffers)
+ else
+ call operate2r_max(block, variable, buffers)
+ end if
+ else if (info % nDims == 3) then
+ if (operation == AVG_OP) then
+ call operate3r_avg(block, variable, buffers)
+ else if (operation == MIN_OP) then
+ call operate3r_min(block, variable, buffers)
+ else
+ call operate3r_max(block, variable, buffers)
+ end if
+ else if (info % nDims == 4) then
+ if (operation == AVG_OP) then
+ call operate4r_avg(block, variable, buffers)
+ else if (operation == MIN_OP) then
+ call operate4r_min(block, variable, buffers)
+ else
+ call operate4r_max(block, variable, buffers)
+ end if
+ else
+ if (operation == AVG_OP) then
+ call operate5r_avg(block, variable, buffers)
+ else if (operation == MIN_OP) then
+ call operate5r_min(block, variable, buffers)
+ else
+ call operate5r_max(block, variable, buffers)
+ end if
+ end if
+ else
+ if (info % nDims == 0) then
+ if (operation == AVG_OP) then
+ call operate0i_avg(block, variable, buffers)
+ else if (operation == MIN_OP) then
+ call operate0i_min(block, variable, buffers)
+ else
+ call operate0i_max(block, variable, buffers)
+ end if
+ else if (info % nDims == 1) then
+ if (operation == AVG_OP) then
+ call operate1i_avg(block, variable, buffers)
+ else if (operation == MIN_OP) then
+ call operate1i_min(block, variable, buffers)
+ else
+ call operate1i_max(block, variable, buffers)
+ end if
+ else if (info % nDims == 2) then
+ if (operation == AVG_OP) then
+ call operate2i_avg(block, variable, buffers)
+ else if (operation == MIN_OP) then
+ call operate2i_min(block, variable, buffers)
+ else
+ call operate2i_max(block, variable, buffers)
+ end if
+ else
+ if (operation == AVG_OP) then
+ call operate3i_avg(block, variable, buffers)
+ else if (operation == MIN_OP) then
+ call operate3i_min(block, variable, buffers)
+ else
+ call operate3i_max(block, variable, buffers)
+ end if
+ end if
+ end if
+end subroutine typed_operate!}}}
+
+
+
+!***********************************************************************
+! routine copy_field_X
+!
+!> \brief Functions to create a new field from an existing field
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> This routine conducts initializations required for
+!> duplicating a field and adding it to the allFields pool based on type.
+!-----------------------------------------------------------------------
+
+subroutine copy_field_0r(inname, pool, outname)!{{{
+ character (len=StrKIND), intent(in) :: inname, outname
+ type (mpas_pool_type), intent(inout) :: pool
+
+ type (field0DReal), pointer :: src, dst
+ integer :: i
+
+ call mpas_pool_get_field(pool, inname, src, 1)
+ call mpas_duplicate_field(src, dst)
+
+ dst % fieldName = outname
+
+ if (dst % isVarArray) then
+ do i = 1, size(dst % constituentNames)
+ dst % constituentNames(i) = trim(outname) // '_' // &
+ trim(dst % constituentNames(i))
+ end do
+ end if
+
+ call mpas_pool_add_field(pool, dst % fieldName, dst)
+end subroutine copy_field_0r!}}}
+
+subroutine copy_field_1r(inname, pool, outname)!{{{
+ character (len=StrKIND), intent(in) :: inname, outname
+ type (mpas_pool_type), intent(inout) :: pool
+
+ type (field1DReal), pointer :: src, dst
+ integer :: i
+
+ call mpas_pool_get_field(pool, inname, src, 1)
+ call mpas_duplicate_field(src, dst)
+
+ dst % fieldName = outname
+
+ if (dst % isVarArray) then
+ do i = 1, size(dst % constituentNames)
+ dst % constituentNames(i) = trim(outname) // '_' // &
+ trim(dst % constituentNames(i))
+ end do
+ end if
+
+ call mpas_pool_add_field(pool, dst % fieldName, dst)
+end subroutine copy_field_1r!}}}
+
+subroutine copy_field_2r(inname, pool, outname)!{{{
+ character (len=StrKIND), intent(in) :: inname, outname
+ type (mpas_pool_type), intent(inout) :: pool
+
+ type (field2DReal), pointer :: src, dst
+ integer :: i
+
+ call mpas_pool_get_field(pool, inname, src, 1)
+ call mpas_duplicate_field(src, dst)
+
+ dst % fieldName = outname
+
+ if (dst % isVarArray) then
+ do i = 1, size(dst % constituentNames)
+ dst % constituentNames(i) = trim(outname) // '_' // &
+ trim(dst % constituentNames(i))
+ end do
+ end if
+
+ call mpas_pool_add_field(pool, dst % fieldName, dst)
+end subroutine copy_field_2r!}}}
+
+subroutine copy_field_3r(inname, pool, outname)!{{{
+ character (len=StrKIND), intent(in) :: inname, outname
+ type (mpas_pool_type), intent(inout) :: pool
+
+ type (field3DReal), pointer :: src, dst
+ integer :: i
+
+ call mpas_pool_get_field(pool, inname, src, 1)
+ call mpas_duplicate_field(src, dst)
+
+ dst % fieldName = outname
+
+ if (dst % isVarArray) then
+ do i = 1, size(dst % constituentNames)
+ dst % constituentNames(i) = trim(outname) // '_' // &
+ trim(dst % constituentNames(i))
+ end do
+ end if
+
+ call mpas_pool_add_field(pool, dst % fieldName, dst)
+end subroutine copy_field_3r!}}}
+
+subroutine copy_field_4r(inname, pool, outname)!{{{
+ character (len=StrKIND), intent(in) :: inname, outname
+ type (mpas_pool_type), intent(inout) :: pool
+
+ type (field4DReal), pointer :: src, dst
+ integer :: i
+
+ call mpas_pool_get_field(pool, inname, src, 1)
+ call mpas_duplicate_field(src, dst)
+
+ dst % fieldName = outname
+
+ if (dst % isVarArray) then
+ do i = 1, size(dst % constituentNames)
+ dst % constituentNames(i) = trim(outname) // '_' // &
+ trim(dst % constituentNames(i))
+ end do
+ end if
+
+ call mpas_pool_add_field(pool, dst % fieldName, dst)
+end subroutine copy_field_4r!}}}
+
+subroutine copy_field_5r(inname, pool, outname)!{{{
+ character (len=StrKIND), intent(in) :: inname, outname
+ type (mpas_pool_type), intent(inout) :: pool
+
+ type (field5DReal), pointer :: src, dst
+ integer :: i
+
+ call mpas_pool_get_field(pool, inname, src, 1)
+ call mpas_duplicate_field(src, dst)
+
+ dst % fieldName = outname
+
+ if (dst % isVarArray) then
+ do i = 1, size(dst % constituentNames)
+ dst % constituentNames(i) = trim(outname) // '_' // &
+ trim(dst % constituentNames(i))
+ end do
+ end if
+
+ call mpas_pool_add_field(pool, dst % fieldName, dst)
+end subroutine copy_field_5r!}}}
+
+subroutine copy_field_0i(inname, pool, outname)!{{{
+ character (len=StrKIND), intent(in) :: inname, outname
+ type (mpas_pool_type), intent(inout) :: pool
+
+ type (field0DInteger), pointer :: src, dst
+ integer :: i
+
+ call mpas_pool_get_field(pool, inname, src, 1)
+ call mpas_duplicate_field(src, dst)
+
+ dst % fieldName = outname
+
+ if (dst % isVarArray) then
+ do i = 1, size(dst % constituentNames)
+ dst % constituentNames(i) = trim(outname) // '_' // &
+ trim(dst % constituentNames(i))
+ end do
+ end if
+
+ call mpas_pool_add_field(pool, dst % fieldName, dst)
+end subroutine copy_field_0i!}}}
+
+subroutine copy_field_1i(inname, pool, outname)!{{{
+ character (len=StrKIND), intent(in) :: inname, outname
+ type (mpas_pool_type), intent(inout) :: pool
+
+ type (field1DInteger), pointer :: src, dst
+ integer :: i
+
+ call mpas_pool_get_field(pool, inname, src, 1)
+ call mpas_duplicate_field(src, dst)
+
+ dst % fieldName = outname
+
+ if (dst % isVarArray) then
+ do i = 1, size(dst % constituentNames)
+ dst % constituentNames(i) = trim(outname) // '_' // &
+ trim(dst % constituentNames(i))
+ end do
+ end if
+
+ call mpas_pool_add_field(pool, dst % fieldName, dst)
+end subroutine copy_field_1i!}}}
+
+subroutine copy_field_2i(inname, pool, outname)!{{{
+ character (len=StrKIND), intent(in) :: inname, outname
+ type (mpas_pool_type), intent(inout) :: pool
+
+ type (field2DInteger), pointer :: src, dst
+ integer :: i
+
+ call mpas_pool_get_field(pool, inname, src, 1)
+ call mpas_duplicate_field(src, dst)
+
+ dst % fieldName = outname
+
+ if (dst % isVarArray) then
+ do i = 1, size(dst % constituentNames)
+ dst % constituentNames(i) = trim(outname) // '_' // &
+ trim(dst % constituentNames(i))
+ end do
+ end if
+
+ call mpas_pool_add_field(pool, dst % fieldName, dst)
+end subroutine copy_field_2i!}}}
+
+subroutine copy_field_3i(inname, pool, outname)!{{{
+ character (len=StrKIND), intent(in) :: inname, outname
+ type (mpas_pool_type), intent(inout) :: pool
+
+ type (field3DInteger), pointer :: src, dst
+ integer :: i
+
+ call mpas_pool_get_field(pool, inname, src, 1)
+ call mpas_duplicate_field(src, dst)
+
+ dst % fieldName = outname
+
+ if (dst % isVarArray) then
+ do i = 1, size(dst % constituentNames)
+ dst % constituentNames(i) = trim(outname) // '_' // &
+ trim(dst % constituentNames(i))
+ end do
+ end if
+
+ call mpas_pool_add_field(pool, dst % fieldName, dst)
+end subroutine copy_field_3i!}}}
+
+
+!***********************************************************************
+! routine operateX_Y
+!
+!> \brief Series of subroutines to support operations on run-time types
+!> \author Jon Woodring
+!> \date September 1, 2015
+!> \details
+!> These subroutines encapsulate the different opertions that can occur
+!> based on the run-time types. (This would likely be
+!> instantiated generics/templates in other languages.)
+!>
+!> Averaging is done by multiplying out and dividing such that
+!> the average state is always in a normalized form -- while
+!> this could (will) cause more error in the long run, it does
+!> mean that other AMs will be able to use this data and it will
+!> always be prenormalized (it also means that we don't have to
+!> have a special case of normalizing the data before writing it
+!> to disk).
+!-----------------------------------------------------------------------
+subroutine operate0r_avg (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+ out_array = (out_array * &
+ (buffers(b) % counter - 1) + in_array) &
+ / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate0r_avg
+
+subroutine operate1r_avg (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), dimension(:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+ out_array = (out_array * &
+ (buffers(b) % counter - 1) + in_array) &
+ / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate1r_avg
+
+subroutine operate2r_avg (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), dimension(:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+ out_array = (out_array * &
+ (buffers(b) % counter - 1) + in_array) &
+ / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate2r_avg
+
+subroutine operate3r_avg (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), dimension(:,:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+ out_array = (out_array * &
+ (buffers(b) % counter - 1) + in_array) &
+ / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate3r_avg
+
+subroutine operate4r_avg (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), dimension(:,:,:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+ out_array = (out_array * &
+ (buffers(b) % counter - 1) + in_array) &
+ / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate4r_avg
+
+subroutine operate5r_avg (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), dimension(:,:,:,:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+ out_array = (out_array * &
+ (buffers(b) % counter - 1) + in_array) &
+ / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate5r_avg
+
+subroutine operate0i_avg (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ integer, pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+ out_array = (out_array * &
+ (buffers(b) % counter - 1) + in_array) &
+ / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate0i_avg
+
+subroutine operate1i_avg (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ integer, dimension(:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+ out_array = (out_array * &
+ (buffers(b) % counter - 1) + in_array) &
+ / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate1i_avg
+
+subroutine operate2i_avg (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ integer, dimension(:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+ out_array = (out_array * &
+ (buffers(b) % counter - 1) + in_array) &
+ / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate2i_avg
+
+subroutine operate3i_avg (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ integer, dimension(:,:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+ out_array = (out_array * &
+ (buffers(b) % counter - 1) + in_array) &
+ / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate3i_avg
+
+subroutine operate0r_min (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+ out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate0r_min
+
+subroutine operate1r_min (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), dimension(:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+ out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate1r_min
+
+subroutine operate2r_min (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), dimension(:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+ out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate2r_min
+
+subroutine operate3r_min (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), dimension(:,:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+ out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate3r_min
+
+subroutine operate4r_min (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), dimension(:,:,:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+ out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate4r_min
+
+subroutine operate5r_min (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), dimension(:,:,:,:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+ out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate5r_min
+
+subroutine operate0i_min (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ integer, pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+ out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate0i_min
+
+subroutine operate1i_min (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ integer, dimension(:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+ out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate1i_min
+
+subroutine operate2i_min (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ integer, dimension(:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+ out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate2i_min
+
+subroutine operate3i_min (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ integer, dimension(:,:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+ out_array = min(out_array, in_array) ;
+! out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate3i_min
+
+subroutine operate0r_max (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+ out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate0r_max
+
+subroutine operate1r_max (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), dimension(:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+ out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate1r_max
+
+subroutine operate2r_max (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), dimension(:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+ out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate2r_max
+
+subroutine operate3r_max (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), dimension(:,:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+ out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate3r_max
+
+subroutine operate4r_max (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), dimension(:,:,:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+ out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate4r_max
+
+subroutine operate5r_max (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), dimension(:,:,:,:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+ out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate5r_max
+
+subroutine operate0i_max (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ integer, pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+ out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate0i_max
+
+subroutine operate1i_max (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ integer, dimension(:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+ out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate1i_max
+
+subroutine operate2i_max (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ integer, dimension(:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+ out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate2i_max
+
+subroutine operate3i_max (start_block, variable, buffers)
+ type (block_type), pointer, intent(in) :: start_block
+ type (time_series_buffer_type), dimension(:), intent(in) :: buffers
+ type (time_series_variable_type), intent(in) :: variable
+
+ integer, dimension(:,:,:), pointer :: in_array, out_array
+ integer :: b
+ type (block_type), pointer :: block
+
+ block => start_block
+ do while (associated(block))
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+
+ do b = 1, size(buffers)
+ if (buffers(b) % accumulate_flag == 0) then
+ cycle
+ end if
+
+ call mpas_pool_get_array(block % allFields, &
+ variable % output_names(b), out_array, 1)
+
+ if (buffers(b) % reset_flag == 1) then
+ out_array = in_array
+ else
+! out_array = (out_array * &
+! (buffers(b) % counter - 1) + in_array) &
+! / buffers(b) % counter ;
+! out_array = min(out_array, in_array) ;
+ out_array = max(out_array, in_array) ;
+
+ end if
+ end do
+
+ block => block % next
+ end do
+end subroutine operate3i_max
+
+end module ocn_time_series_stats
+! vim: foldmethod=marker
diff --git a/src/core_ocean/analysis_members/mpas_ocn_water_mass_census.F b/src/core_ocean/analysis_members/mpas_ocn_water_mass_census.F
index 423b4b8a8c..e2d482538b 100644
--- a/src/core_ocean/analysis_members/mpas_ocn_water_mass_census.F
+++ b/src/core_ocean/analysis_members/mpas_ocn_water_mass_census.F
@@ -159,6 +159,7 @@ subroutine ocn_compute_water_mass_census(domain, timeLevel, err)!{{{
type (mpas_pool_type), pointer :: statePool
type (mpas_pool_type), pointer :: meshPool
type (mpas_pool_type), pointer :: diagnosticsPool
+ type (mpas_pool_type), pointer :: tracersPool
real (kind=RKIND), dimension(:,:,:), pointer :: waterMassFractionalDistribution
real (kind=RKIND), dimension(:,:,:), pointer :: potentialDensityOfTSDiagram
@@ -168,9 +169,9 @@ subroutine ocn_compute_water_mass_census(domain, timeLevel, err)!{{{
! pointers to data in pools required for T/S water mass census
real (kind=RKIND), dimension(:,:), pointer :: layerThickness
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers
real (kind=RKIND), dimension(:,:), pointer :: potentialDensity
real (kind=RKIND), dimension(:,:), pointer :: zMid
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
! pointers to data in mesh pool
! (note: nOceanRegionsTmpCensus, lonCell, latCell to be removed when region mask is intent(in))
@@ -187,9 +188,6 @@ subroutine ocn_compute_water_mass_census(domain, timeLevel, err)!{{{
real (kind=RKIND), pointer :: minSalinity, maxSalinity
real (kind=RKIND) :: deltaTemperature, deltaSalinity, temperature, salinity, density, zPosition, volume
- ! package flag
- logical, pointer :: waterMassCensusAMPKGActive
-
! buffers data for message passaging
integer :: kBuffer, kBufferLength
real (kind=RKIND), dimension(:), allocatable :: workBufferSum, workBufferSumReduced
@@ -279,13 +277,16 @@ subroutine ocn_compute_water_mass_census(domain, timeLevel, err)!{{{
call mpas_pool_get_subpool(block % structs, 'state', statePool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
+ ! get indices for T and S
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', index_temperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', index_salinity)
! get pointers to mesh
call mpas_pool_get_dimension(block % dimensions, 'nCellsSolve', nCellsSolve)
call mpas_pool_get_dimension(block % dimensions, 'nCells', nCells)
call mpas_pool_get_dimension(block % dimensions, 'nOceanRegionsTmpCensus', nOceanRegionsTmpCensus)
- call mpas_pool_get_dimension(statePool, 'index_temperature', index_temperature)
- call mpas_pool_get_dimension(statePool, 'index_salinity', index_salinity)
call mpas_pool_get_array(meshPool, 'areaCell', areaCell)
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
@@ -293,44 +294,46 @@ subroutine ocn_compute_water_mass_census(domain, timeLevel, err)!{{{
call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, timeLevel)
call mpas_pool_get_array(diagnosticsPool, 'potentialDensity', potentialDensity)
call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
- call mpas_pool_get_array(statePool, 'tracers', tracers, timeLevel)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
! loop over and bin all data
+ if ( associated(activeTracers) ) then
do iCell=1,nCellsSolve
- do iLevel=1,maxLevelCell(iCell)
-
- ! make copies of data for convienence
- temperature = tracers(index_temperature,iLevel,iCell)
- salinity = tracers(index_salinity,iLevel,iCell)
- density = potentialDensity(iLevel,iCell)
- zPosition = zMid(iLevel,iCell)
- volume = layerThickness(iLevel,iCell) * areaCell(iCell)
-
- ! find temperature bin, cycle if bin is out of range
- iTemperatureBin = int((temperature-minTemperature)/deltaTemperature) + 1
- if (iTemperatureBin < 1) cycle
- if (iTemperatureBin > nTemperatureBins) cycle
-
- ! find salinity bin, cycle if bin is out of range
- iSalinityBin = int((salinity-minSalinity)/deltaSalinity) + 1
- if (iSalinityBin < 1) cycle
- if (iSalinityBin > nSalinityBins) cycle
-
- do iRegion=1,nOceanRegionsTmpCensus
- ! add volume into water mass census array for each region
- waterMassFractionalDistribution(iTemperatureBin,iSalinityBin,iRegion) = &
- waterMassFractionalDistribution(iTemperatureBin,iSalinityBin,iRegion) &
- + volume * regionMask(iRegion,iCell)
- potentialDensityOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) = &
- potentialDensityOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) &
- + density * volume * regionMask(iRegion,iCell)
- zPositionOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) = &
- zPositionOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) &
- + zPosition * volume * regionMask(iRegion,iCell)
- enddo
-
- enddo ! iLevel
- enddo ! iCell
+ do iLevel=1,maxLevelCell(iCell)
+
+ ! make copies of data for convienence
+ temperature = activeTracers(index_temperature,iLevel,iCell)
+ salinity = activeTracers(index_salinity,iLevel,iCell)
+ density = potentialDensity(iLevel,iCell)
+ zPosition = zMid(iLevel,iCell)
+ volume = layerThickness(iLevel,iCell) * areaCell(iCell)
+
+ ! find temperature bin, cycle if bin is out of range
+ iTemperatureBin = int((temperature-minTemperature)/deltaTemperature) + 1
+ if (iTemperatureBin < 1) cycle
+ if (iTemperatureBin > nTemperatureBins) cycle
+
+ ! find salinity bin, cycle if bin is out of range
+ iSalinityBin = int((salinity-minSalinity)/deltaSalinity) + 1
+ if (iSalinityBin < 1) cycle
+ if (iSalinityBin > nSalinityBins) cycle
+
+ do iRegion=1,nOceanRegionsTmpCensus
+ ! add volume into water mass census array for each region
+ waterMassFractionalDistribution(iTemperatureBin,iSalinityBin,iRegion) = &
+ waterMassFractionalDistribution(iTemperatureBin,iSalinityBin,iRegion) &
+ + volume * regionMask(iRegion,iCell)
+ potentialDensityOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) = &
+ potentialDensityOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) &
+ + density * volume * regionMask(iRegion,iCell)
+ zPositionOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) = &
+ zPositionOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) &
+ + zPosition * volume * regionMask(iRegion,iCell)
+ enddo
+
+ enddo ! iLevel
+ enddo ! iCell
+ endif ! associated(activeTracers)
block => block % next
end do ! block loop
@@ -338,16 +341,16 @@ subroutine ocn_compute_water_mass_census(domain, timeLevel, err)!{{{
! store data in buffer in order to allow only one dmpar calls
kBuffer=0
do iTemperatureBin=1,nTemperatureBins
- do iSalinityBin=1,nSalinityBins
- do iRegion=1,nOceanRegionsTmpCensus
- kBuffer = kBuffer+1
- workBufferSum(kBuffer) = waterMassFractionalDistribution(iTemperatureBin,iSalinityBin,iRegion)
- kBuffer = kBuffer+1
- workBufferSum(kBuffer) = potentialDensityOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion)
- kBuffer = kBuffer+1
- workBufferSum(kBuffer) = zPositionOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion)
- enddo
- enddo
+ do iSalinityBin=1,nSalinityBins
+ do iRegion=1,nOceanRegionsTmpCensus
+ kBuffer = kBuffer+1
+ workBufferSum(kBuffer) = waterMassFractionalDistribution(iTemperatureBin,iSalinityBin,iRegion)
+ kBuffer = kBuffer+1
+ workBufferSum(kBuffer) = potentialDensityOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion)
+ kBuffer = kBuffer+1
+ workBufferSum(kBuffer) = zPositionOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion)
+ enddo
+ enddo
enddo
! communication
@@ -356,45 +359,47 @@ subroutine ocn_compute_water_mass_census(domain, timeLevel, err)!{{{
! unpack the buffer into intent(out) of this analysis member
kBuffer=0
do iTemperatureBin=1,nTemperatureBins
- do iSalinityBin=1,nSalinityBins
- do iRegion=1,nOceanRegionsTmpCensus
- kBuffer = kBuffer+1
- waterMassFractionalDistribution(iTemperatureBin,iSalinityBin,iRegion) = workBufferSumReduced(kBuffer)
- kBuffer = kBuffer+1
- potentialDensityOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) = workBufferSumReduced(kBuffer)
- kBuffer = kBuffer+1
- zPositionOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) = workBufferSumReduced(kBuffer)
- enddo
- enddo
+ do iSalinityBin=1,nSalinityBins
+ do iRegion=1,nOceanRegionsTmpCensus
+ kBuffer = kBuffer+1
+ waterMassFractionalDistribution(iTemperatureBin,iSalinityBin,iRegion) = workBufferSumReduced(kBuffer)
+ kBuffer = kBuffer+1
+ potentialDensityOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) = workBufferSumReduced(kBuffer)
+ kBuffer = kBuffer+1
+ zPositionOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) = workBufferSumReduced(kBuffer)
+ enddo
+ enddo
enddo
! normalize potentialDensityOfTSDiagram by volume in each T,S bin
do iTemperatureBin=1,nTemperatureBins
- do iSalinityBin=1,nSalinityBins
- do iRegion=1,nOceanRegionsTmpCensus
- potentialDensityOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) = &
- potentialDensityOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) / &
- max(waterMassFractionalDistribution(iTemperatureBin,iSalinityBin,iRegion), 1.0e-8_RKIND)
- zPositionOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) = &
- zPositionOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) / &
- max(waterMassFractionalDistribution(iTemperatureBin,iSalinityBin,iRegion), 1.0e-8_RKIND)
- enddo
- enddo
+ do iSalinityBin=1,nSalinityBins
+ do iRegion=1,nOceanRegionsTmpCensus
+ potentialDensityOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) = &
+ potentialDensityOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) / &
+ max(waterMassFractionalDistribution(iTemperatureBin,iSalinityBin,iRegion), 1.0e-8_RKIND)
+ zPositionOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) = &
+ zPositionOfTSDiagram(iTemperatureBin,iSalinityBin,iRegion) / &
+ max(waterMassFractionalDistribution(iTemperatureBin,iSalinityBin,iRegion), 1.0e-8_RKIND)
+ enddo
+ enddo
enddo
! use workBufferSum as workspace to find total volume for each region
workBufferSum = 0.0_RKIND
do iTemperatureBin=1,nTemperatureBins
- do iSalinityBin=1,nSalinityBins
- do iRegion=1,nOceanRegionsTmpCensus
- workBufferSum(iRegion) = workBufferSum(iRegion) + waterMassFractionalDistribution(iTemperatureBin,iSalinityBin,iRegion)
- enddo
- enddo
+ do iSalinityBin=1,nSalinityBins
+ do iRegion=1,nOceanRegionsTmpCensus
+ workBufferSum(iRegion) = workBufferSum(iRegion) &
+ + waterMassFractionalDistribution(iTemperatureBin,iSalinityBin,iRegion)
+ enddo
+ enddo
enddo
! use this sum to convert waterMassFractionalDistribution from total volume to fractional volume
do iRegion=1,nOceanRegionsTmpCensus
- waterMassFractionalDistribution(:,:,iRegion) = waterMassFractionalDistribution(:,:,iRegion) / max(workBufferSum(iRegion),1.0e-8_RKIND)
+ waterMassFractionalDistribution(:,:,iRegion) = waterMassFractionalDistribution(:,:,iRegion) &
+ / max(workBufferSum(iRegion),1.0e-8_RKIND)
enddo
! deallocate buffers
@@ -418,7 +423,7 @@ subroutine compute_mask(maxLevelCell, nCells, nCellsSolve, iRegion, lonCell, lat
integer :: iCell
real(kind=RKIND) :: dtr
- dtr = 4.0*atan(1.0) / 180.0_RKIND
+ dtr = 4.0_RKIND*atan(1.0_RKIND) / 180.0_RKIND
workMask(:) = 0.0_RKIND
do iCell=1,nCellsSolve
workMask(iCell) = 1.0_RKIND
@@ -429,20 +434,20 @@ subroutine compute_mask(maxLevelCell, nCells, nCellsSolve, iRegion, lonCell, lat
do iCell=1,nCellsSolve
if(latCell(iCell).lt. 60.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
enddo
- write(6,*) ' Arctic ', sum(workMask)
+ write(stdoutUnit,*) ' Arctic ', sum(workMask)
elseif (iRegion.eq.2) then
! Equatorial
do iCell=1,nCellsSolve
if(latCell(iCell).gt. 15.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
if(latCell(iCell).lt.-15.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
enddo
- write(6,*) ' Equatorial ', sum(workMask)
+ write(stdoutUnit,*) ' Equatorial ', sum(workMask)
elseif (iRegion.eq.3) then
! Southern Ocean
do iCell=1,nCellsSolve
if(latCell(iCell).gt.-50.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
enddo
- write(6,*) ' Southern Ocean ', sum(workMask)
+ write(stdoutUnit,*) ' Southern Ocean ', sum(workMask)
elseif (iRegion.eq.4) then
! Nino 3
do iCell=1,nCellsSolve
@@ -451,7 +456,7 @@ subroutine compute_mask(maxLevelCell, nCells, nCellsSolve, iRegion, lonCell, lat
if(lonCell(iCell).lt.210.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
if(lonCell(iCell).gt.270.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
enddo
- write(6,*) ' Nino 3 ', sum(workMask)
+ write(stdoutUnit,*) ' Nino 3 ', sum(workMask)
elseif (iRegion.eq.5) then
! Nino 4
do iCell=1,nCellsSolve
@@ -460,7 +465,7 @@ subroutine compute_mask(maxLevelCell, nCells, nCellsSolve, iRegion, lonCell, lat
if(lonCell(iCell).lt.160.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
if(lonCell(iCell).gt.210.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
enddo
- write(6,*) ' Nino 4 ', sum(workMask)
+ write(stdoutUnit,*) ' Nino 4 ', sum(workMask)
elseif (iRegion.eq.6) then
! Nino 3.4
do iCell=1,nCellsSolve
@@ -469,10 +474,10 @@ subroutine compute_mask(maxLevelCell, nCells, nCellsSolve, iRegion, lonCell, lat
if(lonCell(iCell).lt.190.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
if(lonCell(iCell).gt.240.0_RKIND*dtr) workMask(iCell) = 0.0_RKIND
enddo
- write(6,*) ' Nino 3.4 ', sum(workMask)
+ write(stdoutUnit,*) ' Nino 3.4 ', sum(workMask)
else
! global (do nothing!)
- write(6,*) ' Global ', sum(workMask)
+ write(stdoutUnit,*) ' Global ', sum(workMask)
endif
end subroutine compute_mask
diff --git a/src/core_ocean/analysis_members/mpas_ocn_zonal_mean.F b/src/core_ocean/analysis_members/mpas_ocn_zonal_mean.F
index 47e101ee2f..2ad6f1dd86 100644
--- a/src/core_ocean/analysis_members/mpas_ocn_zonal_mean.F
+++ b/src/core_ocean/analysis_members/mpas_ocn_zonal_mean.F
@@ -60,59 +60,6 @@ module ocn_zonal_mean
contains
-!***********************************************************************
-!
-! routine ocn_setup_packages_zonal_mean
-!
-!> \brief Set up packages for MPAS-Ocean analysis member
-!> \author Mark Petersen
-!> \date November 2013
-!> \details
-!> This routine is intended to configure the packages for this MPAS
-!> ocean analysis member
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_setup_packages_zonal_mean(configPool, packagePool, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
- type (mpas_pool_type), intent(in) :: configPool
- type (mpas_pool_type), intent(in) :: packagePool
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
- logical, pointer :: zonalMeanAMActive
-
- err = 0
-
- call mpas_pool_get_package(packagePool, 'zonalMeanAMActive', zonalMeanAMActive)
-
- ! turn on package for this analysis member
- zonalMeanAMActive = .true.
-
- end subroutine ocn_setup_packages_zonal_mean!}}}
-
!***********************************************************************
!
! routine ocn_init_zonal_mean
@@ -211,7 +158,7 @@ subroutine ocn_init_zonal_mean(domain, err)!{{{
call mpas_dmpar_min_real_array(dminfo, 1, minBin, minBinDomain)
call mpas_dmpar_max_real_array(dminfo, 1, maxBin, maxBinDomain)
- ! Set up bins.
+ ! Set up bins.
binBoundaryZonalMean = -1.0e34_RKIND
binCenterZonalMean = -1.0e34_RKIND
@@ -294,16 +241,17 @@ subroutine ocn_compute_zonal_mean(domain, timeLevel, err)!{{{
type (mpas_pool_type), pointer :: meshPool
type (mpas_pool_type), pointer :: scratchPool
type (mpas_pool_type), pointer :: diagnosticsPool
+ type (mpas_pool_type), pointer :: tracersPool
integer :: iTracer, k, iCell, kMax
integer :: iBin, iField, nZonalMeanVariables
- integer, pointer :: num_tracers, nCellsSolve, nVertLevels, nZonalMeanBins
+ integer, pointer :: num_activeTracers, nCellsSolve, nVertLevels, nZonalMeanBins
integer, dimension(:), pointer :: maxLevelCell
real (kind=RKIND), dimension(:), pointer :: areaCell, binVariable, binBoundaryZonalMean
real (kind=RKIND), dimension(:,:), pointer :: velocityZonal, velocityMeridional
real (kind=RKIND), dimension(:,:), pointer :: velocityZonalZonalMean, velocityMeridionalZonalMean
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
real (kind=RKIND), dimension(:,:,:), allocatable :: sumZonalMean, totalSumZonalMean, normZonalMean
real (kind=RKIND), dimension(:,:,:), pointer :: tracersZonalMean
@@ -316,8 +264,10 @@ subroutine ocn_compute_zonal_mean(domain, timeLevel, err)!{{{
call mpas_pool_get_subpool(domain % blocklist % structs, 'state', statePool)
call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool)
- call mpas_pool_get_dimension(statePool, 'num_tracers', num_tracers)
- nZonalMeanVariables = num_tracers + 3
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
+ call mpas_pool_get_dimension(tracersPool, 'num_activeTracers', num_activeTracers)
+ nZonalMeanVariables = num_activeTracers + 3
call mpas_pool_get_dimension(domain % blocklist % dimensions, 'nZonalMeanBins', nZonalMeanBins)
call mpas_pool_get_dimension(domain % blocklist % dimensions, 'nVertLevels', nVertLevels)
@@ -336,6 +286,7 @@ subroutine ocn_compute_zonal_mean(domain, timeLevel, err)!{{{
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
!state => block % state % time_levs(timeLevel) % state
@@ -343,7 +294,7 @@ subroutine ocn_compute_zonal_mean(domain, timeLevel, err)!{{{
!scratch => block % scratch
!diagnostics => block % diagnostics
- call mpas_pool_get_dimension(statePool, 'num_tracers', num_tracers)
+ call mpas_pool_get_dimension(tracersPool, 'num_activeTracers', num_activeTracers)
call mpas_pool_get_dimension(block % dimensions, 'nCellsSolve', nCellsSolve)
@@ -351,7 +302,7 @@ subroutine ocn_compute_zonal_mean(domain, timeLevel, err)!{{{
call mpas_pool_get_array(meshPool, 'areaCell', areaCell)
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
- call mpas_pool_get_array(statePool, 'tracers', tracers, timeLevel)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, timeLevel)
call mpas_pool_get_array(diagnosticsPool, 'velocityZonal', velocityZonal)
call mpas_pool_get_array(diagnosticsPool, 'velocityMeridional', velocityMeridional)
@@ -376,11 +327,12 @@ subroutine ocn_compute_zonal_mean(domain, timeLevel, err)!{{{
! Field 1 is the total area in this bin, which can vary by level due to land.
sumZonalMean(1,k,iBin) = sumZonalMean(1,k,iBin) + areaCell(iCell)
- do iField = 1,num_tracers
- sumZonalMean(iField+1,k,iBin) = sumZonalMean(iField+1,k,iBin) + tracers(iField,k,iCell)*areaCell(iCell)
+ do iField = 1,num_activeTracers
+ sumZonalMean(iField+1,k,iBin) = sumZonalMean(iField+1,k,iBin) + activeTracers(iField,k,iCell) &
+ * areaCell(iCell)
enddo
- iField = num_tracers+2
+ iField = num_activeTracers+2
sumZonalMean(iField,k,iBin) = sumZonalMean(iField,k,iBin) + velocityZonal(k,iCell)*areaCell(iCell)
iField = iField+1
sumZonalMean(iField,k,iBin) = sumZonalMean(iField,k,iBin) + velocityMeridional(k,iCell)*areaCell(iCell)
@@ -424,8 +376,9 @@ subroutine ocn_compute_zonal_mean(domain, timeLevel, err)!{{{
call mpas_pool_get_subpool(block % structs, 'zonalMeanAM', zonalMeanAMPool)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
- call mpas_pool_get_dimension(statePool, 'num_tracers', num_tracers)
+ call mpas_pool_get_dimension(tracersPool, 'num_activeTracers', num_activeTracers)
call mpas_pool_get_array(zonalMeanAMPool, 'tracersZonalMean', tracersZonalMean)
call mpas_pool_get_array(zonalMeanAMPool, 'velocityZonalZonalMean', velocityZonalZonalMean)
@@ -434,11 +387,11 @@ subroutine ocn_compute_zonal_mean(domain, timeLevel, err)!{{{
do iBin = 1, nZonalMeanBins
do k = 1, nVertLevels
- do iField = 1, num_tracers
+ do iField = 1, num_activeTracers
tracersZonalMean(iField,k,iBin) = normZonalMean(iField+1,k,iBin)
enddo
- iField = num_tracers + 2
+ iField = num_activeTracers + 2
velocityZonalZonalMean(k,iBin) = normZonalMean(iField,k,iBin)
iField = iField+1
velocityMeridionalZonalMean(k,iBin) = normZonalMean(iField,k,iBin)
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/README.md b/src/core_ocean/analysis_members/regional_stats_inc/README.md
new file mode 100644
index 0000000000..e7fe6ed386
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/README.md
@@ -0,0 +1 @@
+These are #include files used in mpas_ocn_regional_stats.F.
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_field_1d.F b/src/core_ocean/analysis_members/regional_stats_inc/regional_field_1d.F
new file mode 100644
index 0000000000..43b23dd941
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_field_1d.F
@@ -0,0 +1,56 @@
+ character (len=StrKIND), intent(in) :: inname, outname, elem_name
+ type (mpas_pool_type), pointer, intent(inout) :: inpool, outpool, all_fields
+ integer, intent(out), optional :: has_vertical
+ character (len=StrKIND), intent(in), optional :: vertical_dim
+ integer :: i
+
+! 1 -> 2
+
+ if (mpas_threading_get_thread_num() == 0) then
+ ! get the field for this pool
+ call mpas_pool_get_field(inpool, inname, src, 1)
+
+ ! check that elem_name is in the dim list
+ if (.not. check_element_dim(src % dimNames, elem_name)) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: element dimension "' // &
+ elem_name // '" was not found in field "' // src % fieldName // &
+ ', which is required for the current regional stats AM' // &
+ 'configuration.')
+ end if
+
+ ! allocate the linked list for the field blocks
+ allocate(dst)
+ nullify(dst % prev)
+ nullify(dst % next)
+
+ ! copy field info
+ dst % fieldName = outname ! name is different than src
+ dst % isDecomposed = .false. ! NOT decomposed! reducing across space
+
+ dst % block => src % block
+ dst % isVarArray = src % isVarArray
+ dst % defaultValue = src % defaultValue
+ dst % isActive = src % isActive
+ dst % hasTimeDimension = src % hasTimeDimension
+ dst % sendList => src % sendList
+ dst % recvList => src % recvList
+ dst % copyList => src % copyList
+
+ allocate(dst % attLists(1))
+
+ ! no constituent names because dst is a scalar
+
+ ! no isPersistent, dimNames, dimSizes because dst is scalar
+
+ ! no need to allocate memory or loop over blocks,
+ ! as 0D has it already in dst % scalar
+
+ ! add field to this block's pool
+ call mpas_pool_add_field(outpool, dst % fieldName, dst)
+ call mpas_pool_add_field(all_fields, dst % fieldName, dst)
+
+ if (present(has_vertical)) then
+ has_vertical = 0
+ end if
+ end if
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_field_1d_1.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_field_1d_1.inc
new file mode 100644
index 0000000000..288e1dbe0a
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_field_1d_1.inc
@@ -0,0 +1,7 @@
+ character (len=StrKIND), intent(in) :: inname, outname, elem_name
+ type (mpas_pool_type), pointer, intent(inout) :: inpool, outpool, all_fields
+ integer, intent(out), optional :: has_vertical
+ character (len=StrKIND), intent(in), optional :: vertical_dim
+ integer :: i
+
+! 1 -> 2
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_field_1d_2.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_field_1d_2.inc
new file mode 100644
index 0000000000..4b66b268ab
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_field_1d_2.inc
@@ -0,0 +1,50 @@
+! 1 -> 2
+
+ if (mpas_threading_get_thread_num() == 0) then
+ ! get the field for this pool
+ call mpas_pool_get_field(inpool, inname, src, 1)
+
+ ! check that elem_name is in the dim list
+ if (.not. check_element_dim(src % dimNames, elem_name)) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: element dimension "' // &
+ elem_name // '" was not found in field "' // src % fieldName // &
+ ', which is required for the current regional stats AM' // &
+ 'configuration.')
+ end if
+
+ ! allocate the linked list for the field blocks
+ allocate(dst)
+ nullify(dst % prev)
+ nullify(dst % next)
+
+ ! copy field info
+ dst % fieldName = outname ! name is different than src
+ dst % isDecomposed = .false. ! NOT decomposed! reducing across space
+
+ dst % block => src % block
+ dst % isVarArray = src % isVarArray
+ dst % defaultValue = src % defaultValue
+ dst % isActive = src % isActive
+ dst % hasTimeDimension = src % hasTimeDimension
+ dst % sendList => src % sendList
+ dst % recvList => src % recvList
+ dst % copyList => src % copyList
+
+ allocate(dst % attLists(1))
+
+ ! no constituent names because dst is a scalar
+
+ ! no isPersistent, dimNames, dimSizes because dst is scalar
+
+ ! no need to allocate memory or loop over blocks,
+ ! as 0D has it already in dst % scalar
+
+ ! add field to this block's pool
+ call mpas_pool_add_field(outpool, dst % fieldName, dst)
+ call mpas_pool_add_field(all_fields, dst % fieldName, dst)
+
+ if (present(has_vertical)) then
+ has_vertical = 0
+ end if
+ end if
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_field_nd.F b/src/core_ocean/analysis_members/regional_stats_inc/regional_field_nd.F
new file mode 100644
index 0000000000..cea497047f
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_field_nd.F
@@ -0,0 +1,80 @@
+ character (len=StrKIND), intent(in) :: inname, outname, elem_name
+ type (mpas_pool_type), pointer, intent(inout) :: inpool, outpool, all_fields
+ integer, intent(out), optional :: has_vertical
+ character (len=StrKIND), intent(in), optional :: vertical_dim
+ integer :: i
+
+! 1 -> 2
+
+ if (mpas_threading_get_thread_num() == 0 ) then
+ ! get the field for this pool
+ call mpas_pool_get_field(inpool, inname, src, 1)
+
+ ! check that elem_name is in the dim list
+ if (.not. check_element_dim(src % dimNames, elem_name)) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: element dimension "' // &
+ elem_name // '" was not found in field "' // src % fieldName // &
+ ', which is required for the current regional stats AM' // &
+ 'configuration.')
+ end if
+
+ ! allocate the linked list for the field blocks
+ allocate(dst)
+ nullify(dst % prev)
+ nullify(dst % next)
+
+ ! copy field info
+ dst % fieldName = outname ! has a different name
+ dst % isDecomposed = .false. ! NOT decomposed! reducing across space
+
+ dst % block => src % block
+ dst % isVarArray = src % isVarArray
+ dst % defaultValue = src % defaultValue
+ dst % isActive = src % isActive
+ dst % hasTimeDimension = src % hasTimeDimension
+ dst % sendList => src % sendList
+ dst % recvList => src % recvList
+ dst % copyList => src % copyList
+
+ ! copy constitutent names
+ if (associated(src % constituentNames)) then
+ allocate(dst % constituentNames( &
+ size(src % constituentNames, dim=1)))
+ allocate(dst % attLists(size(src % constituentNames, dim=1)))
+
+ do i = 1, size(dst % constituentNames, dim=1)
+ dst % constituentNames(i) = trim(outname) // '_' // &
+ trim(src % constituentNames(i))
+ end do
+ else
+ nullify(dst % constituentNames)
+ allocate(dst % attLists(1))
+ end if
+
+ ! field values unique to non-scalars (rank-1+ arrays)
+ dst % isPersistent = src % isPersistent
+
+ i = size(src % dimNames) - 1
+ dst % dimNames(1:i) = src % dimNames(1:i)
+ dst % dimSizes(1:i) = src % dimSizes(1:i)
+
+ ! allocate memory
+ if (src % isActive) then
+ ! create dimensions skipping the element dimension
+ src_dims = shape(src % array)
+
+! 2 -> 3
+
+ else
+ nullify(dst % array)
+ end if
+
+ ! add field to this block's pool
+ call mpas_pool_add_field(outpool, dst % fieldName, dst)
+ call mpas_pool_add_field(all_fields, dst % fieldName, dst)
+
+ if (present(has_vertical)) then
+ has_vertical = check_vertical_dim(src % dimNames, vertical_dim)
+ end if
+ end if
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_field_nd_1.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_field_nd_1.inc
new file mode 100644
index 0000000000..288e1dbe0a
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_field_nd_1.inc
@@ -0,0 +1,7 @@
+ character (len=StrKIND), intent(in) :: inname, outname, elem_name
+ type (mpas_pool_type), pointer, intent(inout) :: inpool, outpool, all_fields
+ integer, intent(out), optional :: has_vertical
+ character (len=StrKIND), intent(in), optional :: vertical_dim
+ integer :: i
+
+! 1 -> 2
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_field_nd_2.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_field_nd_2.inc
new file mode 100644
index 0000000000..353ff3a5b1
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_field_nd_2.inc
@@ -0,0 +1,61 @@
+! 1 -> 2
+
+ if (mpas_threading_get_thread_num() == 0 ) then
+ ! get the field for this pool
+ call mpas_pool_get_field(inpool, inname, src, 1)
+
+ ! check that elem_name is in the dim list
+ if (.not. check_element_dim(src % dimNames, elem_name)) then
+ call mpas_dmpar_global_abort( &
+ trim(CURRENT_CORE_NAME) // ' ERROR: element dimension "' // &
+ elem_name // '" was not found in field "' // src % fieldName // &
+ ', which is required for the current regional stats AM' // &
+ 'configuration.')
+ end if
+
+ ! allocate the linked list for the field blocks
+ allocate(dst)
+ nullify(dst % prev)
+ nullify(dst % next)
+
+ ! copy field info
+ dst % fieldName = outname ! has a different name
+ dst % isDecomposed = .false. ! NOT decomposed! reducing across space
+
+ dst % block => src % block
+ dst % isVarArray = src % isVarArray
+ dst % defaultValue = src % defaultValue
+ dst % isActive = src % isActive
+ dst % hasTimeDimension = src % hasTimeDimension
+ dst % sendList => src % sendList
+ dst % recvList => src % recvList
+ dst % copyList => src % copyList
+
+ ! copy constitutent names
+ if (associated(src % constituentNames)) then
+ allocate(dst % constituentNames( &
+ size(src % constituentNames, dim=1)))
+ allocate(dst % attLists(size(src % constituentNames, dim=1)))
+
+ do i = 1, size(dst % constituentNames, dim=1)
+ dst % constituentNames(i) = trim(outname) // '_' // &
+ trim(src % constituentNames(i))
+ end do
+ else
+ nullify(dst % constituentNames)
+ allocate(dst % attLists(1))
+ end if
+
+ ! field values unique to non-scalars (rank-1+ arrays)
+ dst % isPersistent = src % isPersistent
+
+ i = size(src % dimNames) - 1
+ dst % dimNames(1:i) = src % dimNames(1:i)
+ dst % dimSizes(1:i) = src % dimSizes(1:i)
+
+ ! allocate memory
+ if (src % isActive) then
+ ! create dimensions skipping the element dimension
+ src_dims = shape(src % array)
+
+! 2 -> 3
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_field_nd_3.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_field_nd_3.inc
new file mode 100644
index 0000000000..9eb350b29e
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_field_nd_3.inc
@@ -0,0 +1,14 @@
+! 2 -> 3
+
+ else
+ nullify(dst % array)
+ end if
+
+ ! add field to this block's pool
+ call mpas_pool_add_field(outpool, dst % fieldName, dst)
+ call mpas_pool_add_field(all_fields, dst % fieldName, dst)
+
+ if (present(has_vertical)) then
+ has_vertical = check_vertical_dim(src % dimNames, vertical_dim)
+ end if
+ end if
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg.F b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg.F
new file mode 100644
index 0000000000..ebaec4f087
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg.F
@@ -0,0 +1,41 @@
+ ! no weights
+ if (regions % function_oned == ID_FUNC) then
+ do i = 1, solve
+
+! 1 -> 2
+
+ end do
+ ! real weights
+ else
+ call mpas_pool_get_array(block % allFields, &
+ regions % weights_oned, weights, 1)
+
+ do i = 1, solve
+
+! 2 -> 3
+
+ end do
+ end if
+
+ block => block % next
+ end do
+
+ allocate(flattened(size(out_array)))
+ allocate(reduced(size(out_array)))
+
+ ! sum across processors and divide by total
+ flattened = reshape(out_array, shape(flattened))
+ call mpas_dmpar_sum_real_array(dminfo, size(flattened), flattened, reduced)
+ out_array = reshape(reduced, shape(out_array))
+ if (count_array > 0) then
+ if (regions % function_oned == ID_FUNC) then
+ out_array = out_array / count_array
+ else
+ out_array = out_array / weight_total
+ end if
+ end if
+
+ deallocate(reduced)
+ deallocate(flattened)
+
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg1d.F b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg1d.F
new file mode 100644
index 0000000000..b4cdb0ee35
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg1d.F
@@ -0,0 +1,33 @@
+ ! no weights
+ if (regions % function_oned == ID_FUNC) then
+ do i = 1, solve
+
+! 1 -> 2
+
+ end do
+ ! real weights
+ else
+ call mpas_pool_get_array(block % allFields, &
+ regions % weights_oned, weights, 1)
+
+ do i = 1, solve
+
+! 2 -> 3
+
+ end do
+ end if
+
+ block => block % next
+ end do
+
+ ! sum across processors and divide by total
+ call mpas_dmpar_sum_real(dminfo, out_array, flat_real)
+ out_array = flat_real
+ if (count_array > 0) then
+ if (regions % function_oned == ID_FUNC) then
+ out_array = out_array / count_array
+ else
+ out_array = out_array / weight_total
+ end if
+ end if
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg1d_1.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg1d_1.inc
new file mode 100644
index 0000000000..e8e3785511
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg1d_1.inc
@@ -0,0 +1,5 @@
+ ! no weights
+ if (regions % function_oned == ID_FUNC) then
+ do i = 1, solve
+
+! 1 -> 2
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg1d_2.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg1d_2.inc
new file mode 100644
index 0000000000..b9eb789bc1
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg1d_2.inc
@@ -0,0 +1,11 @@
+! 1 -> 2
+
+ end do
+ ! real weights
+ else
+ call mpas_pool_get_array(block % allFields, &
+ regions % weights_oned, weights, 1)
+
+ do i = 1, solve
+
+! 2 -> 3
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg1d_3.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg1d_3.inc
new file mode 100644
index 0000000000..e726ba9b20
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg1d_3.inc
@@ -0,0 +1,19 @@
+! 2 -> 3
+
+ end do
+ end if
+
+ block => block % next
+ end do
+
+ ! sum across processors and divide by total
+ call mpas_dmpar_sum_real(dminfo, out_array, flat_real)
+ out_array = flat_real
+ if (count_array > 0) then
+ if (regions % function_oned == ID_FUNC) then
+ out_array = out_array / count_array
+ else
+ out_array = out_array / weight_total
+ end if
+ end if
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg_1.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg_1.inc
new file mode 100644
index 0000000000..e8e3785511
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg_1.inc
@@ -0,0 +1,5 @@
+ ! no weights
+ if (regions % function_oned == ID_FUNC) then
+ do i = 1, solve
+
+! 1 -> 2
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg_2.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg_2.inc
new file mode 100644
index 0000000000..b9eb789bc1
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg_2.inc
@@ -0,0 +1,11 @@
+! 1 -> 2
+
+ end do
+ ! real weights
+ else
+ call mpas_pool_get_array(block % allFields, &
+ regions % weights_oned, weights, 1)
+
+ do i = 1, solve
+
+! 2 -> 3
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg_3.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg_3.inc
new file mode 100644
index 0000000000..28d0b83cf4
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_avg_3.inc
@@ -0,0 +1,27 @@
+! 2 -> 3
+
+ end do
+ end if
+
+ block => block % next
+ end do
+
+ allocate(flattened(size(out_array)))
+ allocate(reduced(size(out_array)))
+
+ ! sum across processors and divide by total
+ flattened = reshape(out_array, shape(flattened))
+ call mpas_dmpar_sum_real_array(dminfo, size(flattened), flattened, reduced)
+ out_array = reshape(reduced, shape(out_array))
+ if (count_array > 0) then
+ if (regions % function_oned == ID_FUNC) then
+ out_array = out_array / count_array
+ else
+ out_array = out_array / weight_total
+ end if
+ end if
+
+ deallocate(reduced)
+ deallocate(flattened)
+
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max.F b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max.F
new file mode 100644
index 0000000000..b243e6ffb5
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max.F
@@ -0,0 +1,20 @@
+ do i = 1, solve
+
+! 1 -> 2
+
+ end do
+
+ block => block % next
+ end do
+
+ allocate(flattened(size(out_array)))
+ allocate(reduced(size(out_array)))
+
+ ! max across processors
+ flattened = reshape(out_array, shape(flattened))
+ call mpas_dmpar_max_real_array(dminfo, size(flattened), flattened, reduced)
+ out_array = reshape(reduced, shape(out_array))
+
+ deallocate(reduced)
+ deallocate(flattened)
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max1d.F b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max1d.F
new file mode 100644
index 0000000000..a899523216
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max1d.F
@@ -0,0 +1,13 @@
+ do i = 1, solve
+
+! 1 -> 2
+
+ end do
+
+ block => block % next
+ end do
+
+ ! max across processors
+ call mpas_dmpar_max_real(dminfo, out_array, flat_real)
+ out_array = flat_real
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max1d_1.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max1d_1.inc
new file mode 100644
index 0000000000..081ef3539b
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max1d_1.inc
@@ -0,0 +1,3 @@
+ do i = 1, solve
+
+! 1 -> 2
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max1d_2.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max1d_2.inc
new file mode 100644
index 0000000000..6ca25029d6
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max1d_2.inc
@@ -0,0 +1,11 @@
+! 1 -> 2
+
+ end do
+
+ block => block % next
+ end do
+
+ ! max across processors
+ call mpas_dmpar_max_real(dminfo, out_array, flat_real)
+ out_array = flat_real
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max_1.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max_1.inc
new file mode 100644
index 0000000000..081ef3539b
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max_1.inc
@@ -0,0 +1,3 @@
+ do i = 1, solve
+
+! 1 -> 2
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max_2.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max_2.inc
new file mode 100644
index 0000000000..9d2f22400d
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_max_2.inc
@@ -0,0 +1,18 @@
+! 1 -> 2
+
+ end do
+
+ block => block % next
+ end do
+
+ allocate(flattened(size(out_array)))
+ allocate(reduced(size(out_array)))
+
+ ! max across processors
+ flattened = reshape(out_array, shape(flattened))
+ call mpas_dmpar_max_real_array(dminfo, size(flattened), flattened, reduced)
+ out_array = reshape(reduced, shape(out_array))
+
+ deallocate(reduced)
+ deallocate(flattened)
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min.F b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min.F
new file mode 100644
index 0000000000..e837e0c811
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min.F
@@ -0,0 +1,20 @@
+ do i = 1, solve
+
+! 1 -> 2
+
+ end do
+
+ block => block % next
+ end do
+
+ allocate(flattened(size(out_array)))
+ allocate(reduced(size(out_array)))
+
+ ! min across processors
+ flattened = reshape(out_array, shape(flattened))
+ call mpas_dmpar_min_real_array(dminfo, size(flattened), flattened, reduced)
+ out_array = reshape(reduced, shape(out_array))
+
+ deallocate(reduced)
+ deallocate(flattened)
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min1d.F b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min1d.F
new file mode 100644
index 0000000000..4d1cbf6e20
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min1d.F
@@ -0,0 +1,13 @@
+ do i = 1, solve
+
+! 1 -> 2
+
+ end do
+
+ block => block % next
+ end do
+
+ ! min across processors
+ call mpas_dmpar_min_real(dminfo, out_array, flat_real)
+ out_array = flat_real
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min1d_1.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min1d_1.inc
new file mode 100644
index 0000000000..081ef3539b
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min1d_1.inc
@@ -0,0 +1,3 @@
+ do i = 1, solve
+
+! 1 -> 2
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min1d_2.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min1d_2.inc
new file mode 100644
index 0000000000..328c0ab390
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min1d_2.inc
@@ -0,0 +1,11 @@
+! 1 -> 2
+
+ end do
+
+ block => block % next
+ end do
+
+ ! min across processors
+ call mpas_dmpar_min_real(dminfo, out_array, flat_real)
+ out_array = flat_real
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min_1.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min_1.inc
new file mode 100644
index 0000000000..081ef3539b
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min_1.inc
@@ -0,0 +1,3 @@
+ do i = 1, solve
+
+! 1 -> 2
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min_2.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min_2.inc
new file mode 100644
index 0000000000..ce65b5adf2
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_min_2.inc
@@ -0,0 +1,18 @@
+! 1 -> 2
+
+ end do
+
+ block => block % next
+ end do
+
+ allocate(flattened(size(out_array)))
+ allocate(reduced(size(out_array)))
+
+ ! min across processors
+ flattened = reshape(out_array, shape(flattened))
+ call mpas_dmpar_min_real_array(dminfo, size(flattened), flattened, reduced)
+ out_array = reshape(reduced, shape(out_array))
+
+ deallocate(reduced)
+ deallocate(flattened)
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_start.F b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_start.F
new file mode 100644
index 0000000000..b72dc14ed9
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_start.F
@@ -0,0 +1,56 @@
+ type (dm_info), pointer, intent(in) :: dminfo
+ type (block_type), pointer, intent(in) :: start_block
+ type (regional_type), intent(in) :: regions
+ type (regional_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), dimension(:), allocatable :: flattened, reduced
+ integer :: b, m, i, last
+ integer, pointer :: solve
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: amPool, maskPool
+ real (kind=RKIND), dimension(:), pointer :: weights
+ real (kind=RKIND), pointer :: weight_total
+ integer, dimension(:,:), pointer :: mask
+ integer :: flat_integer
+ real (kind=RKIND) :: flat_real
+ integer, pointer :: count_array
+
+! 1 -> 2
+
+ last = regions % num_regions_per(regions % group_index)
+ do b = 1, last
+ ! get the output array, which should be the first block
+ call mpas_pool_get_subpool(start_block % structs, &
+ REGIONAL_STATS_POOL, amPool)
+ call mpas_pool_get_array(amPool, variable % output_names(b), &
+ out_array, 1)
+
+ m = regions % groups(b, regions % group_index)
+
+ call mpas_pool_get_array(amPool, regions % count_zerod_names(b), &
+ count_array, 1)
+ if (regions % function_oned == MUL_FUNC) then
+ call mpas_pool_get_array(amPool, regions % weight_zerod_names(b), &
+ weight_total, 1)
+ end if
+
+! 2 -> 3
+
+ ! iterate over blocks
+ block => start_block
+ do while (associated(block))
+ ! get the dimensions for this block
+ if (regions % region_element == CELL_REGION) then
+ call mpas_pool_get_dimension(block % dimensions, CELL_SOLVE, solve)
+ else
+ call mpas_pool_get_dimension(block % dimensions, VERTEX_SOLVE, solve)
+ end if
+
+ ! get the subpools
+ call mpas_pool_get_subpool(block % structs, MASK_POOL_NAME, maskPool)
+
+ ! get the arrays
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+ call mpas_pool_get_array(maskPool, regions % masking_field, mask, 1)
+
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_start_1.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_start_1.inc
new file mode 100644
index 0000000000..e4de1433d4
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_start_1.inc
@@ -0,0 +1,18 @@
+ type (dm_info), pointer, intent(in) :: dminfo
+ type (block_type), pointer, intent(in) :: start_block
+ type (regional_type), intent(in) :: regions
+ type (regional_variable_type), intent(in) :: variable
+
+ real (kind=RKIND), dimension(:), allocatable :: flattened, reduced
+ integer :: b, m, i, last
+ integer, pointer :: solve
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: amPool, maskPool
+ real (kind=RKIND), dimension(:), pointer :: weights
+ real (kind=RKIND), pointer :: weight_total
+ integer, dimension(:,:), pointer :: mask
+ integer :: flat_integer
+ real (kind=RKIND) :: flat_real
+ integer, pointer :: count_array
+
+! 1 -> 2
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_start_2.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_start_2.inc
new file mode 100644
index 0000000000..d440025d31
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_start_2.inc
@@ -0,0 +1,20 @@
+! 1 -> 2
+
+ last = regions % num_regions_per(regions % group_index)
+ do b = 1, last
+ ! get the output array, which should be the first block
+ call mpas_pool_get_subpool(start_block % structs, &
+ REGIONAL_STATS_POOL, amPool)
+ call mpas_pool_get_array(amPool, variable % output_names(b), &
+ out_array, 1)
+
+ m = regions % groups(b, regions % group_index)
+
+ call mpas_pool_get_array(amPool, regions % count_zerod_names(b), &
+ count_array, 1)
+ if (regions % function_oned == MUL_FUNC) then
+ call mpas_pool_get_array(amPool, regions % weight_zerod_names(b), &
+ weight_total, 1)
+ end if
+
+! 2 -> 3
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_op_start_3.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_start_3.inc
new file mode 100644
index 0000000000..f830eb5f5f
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_op_start_3.inc
@@ -0,0 +1,20 @@
+! 2 -> 3
+
+ ! iterate over blocks
+ block => start_block
+ do while (associated(block))
+ ! get the dimensions for this block
+ if (regions % region_element == CELL_REGION) then
+ call mpas_pool_get_dimension(block % dimensions, CELL_SOLVE, solve)
+ else
+ call mpas_pool_get_dimension(block % dimensions, VERTEX_SOLVE, solve)
+ end if
+
+ ! get the subpools
+ call mpas_pool_get_subpool(block % structs, MASK_POOL_NAME, maskPool)
+
+ ! get the arrays
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+ call mpas_pool_get_array(maskPool, regions % masking_field, mask, 1)
+
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_avg.F b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_avg.F
new file mode 100644
index 0000000000..cc91f27894
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_avg.F
@@ -0,0 +1,40 @@
+ ! no weights
+ if (regions % function_twod == ID_FUNC) then
+ do i = 1, solve
+ do v = 1, levels
+
+! 1 -> 2
+
+ end do
+ end do
+ ! real weights
+ else
+ call mpas_pool_get_array(block % allFields, &
+ regions % weights_twod, weights, 1)
+
+ do i = 1, solve
+ do v = 1, levels
+
+! 2 -> 3
+
+ end do
+ end do
+ end if
+
+ block => block % next
+ end do
+
+ allocate(flattened(size(out_array)))
+ allocate(reduced(size(out_array)))
+
+ ! sum across processors (divide is outside)
+ flattened = reshape(out_array, shape(flattened))
+ call mpas_dmpar_sum_real_array(dminfo, size(flattened), flattened, reduced)
+ out_array = reshape(reduced, shape(out_array))
+
+ deallocate(reduced)
+ deallocate(flattened)
+
+! 3 -> 4
+
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_avg_1.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_avg_1.inc
new file mode 100644
index 0000000000..ad9dd707da
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_avg_1.inc
@@ -0,0 +1,6 @@
+ ! no weights
+ if (regions % function_twod == ID_FUNC) then
+ do i = 1, solve
+ do v = 1, levels
+
+! 1 -> 2
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_avg_2.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_avg_2.inc
new file mode 100644
index 0000000000..05562e3728
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_avg_2.inc
@@ -0,0 +1,13 @@
+! 1 -> 2
+
+ end do
+ end do
+ ! real weights
+ else
+ call mpas_pool_get_array(block % allFields, &
+ regions % weights_twod, weights, 1)
+
+ do i = 1, solve
+ do v = 1, levels
+
+! 2 -> 3
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_avg_3.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_avg_3.inc
new file mode 100644
index 0000000000..a93822f9ee
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_avg_3.inc
@@ -0,0 +1,21 @@
+! 2 -> 3
+
+ end do
+ end do
+ end if
+
+ block => block % next
+ end do
+
+ allocate(flattened(size(out_array)))
+ allocate(reduced(size(out_array)))
+
+ ! sum across processors (divide is outside)
+ flattened = reshape(out_array, shape(flattened))
+ call mpas_dmpar_sum_real_array(dminfo, size(flattened), flattened, reduced)
+ out_array = reshape(reduced, shape(out_array))
+
+ deallocate(reduced)
+ deallocate(flattened)
+
+! 3 -> 4
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_avg_4.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_avg_4.inc
new file mode 100644
index 0000000000..781e2cc2a5
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_avg_4.inc
@@ -0,0 +1,3 @@
+! 3 -> 4
+
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_max.F b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_max.F
new file mode 100644
index 0000000000..d226f8e2d8
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_max.F
@@ -0,0 +1,22 @@
+ ! no weights
+ do i = 1, solve
+ do v = 1, levels
+
+! 1 -> 2
+
+ end do
+ end do
+ block => block % next
+ end do
+
+ allocate(flattened(size(out_array)))
+ allocate(reduced(size(out_array)))
+
+ ! max across processors
+ flattened = reshape(out_array, shape(flattened))
+ call mpas_dmpar_max_real_array(dminfo, size(flattened), flattened, reduced)
+ out_array = reshape(reduced, shape(out_array))
+
+ deallocate(reduced)
+ deallocate(flattened)
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_max_1.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_max_1.inc
new file mode 100644
index 0000000000..eae825b535
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_max_1.inc
@@ -0,0 +1,5 @@
+ ! no weights
+ do i = 1, solve
+ do v = 1, levels
+
+! 1 -> 2
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_max_2.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_max_2.inc
new file mode 100644
index 0000000000..579d2393cc
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_max_2.inc
@@ -0,0 +1,18 @@
+! 1 -> 2
+
+ end do
+ end do
+ block => block % next
+ end do
+
+ allocate(flattened(size(out_array)))
+ allocate(reduced(size(out_array)))
+
+ ! max across processors
+ flattened = reshape(out_array, shape(flattened))
+ call mpas_dmpar_max_real_array(dminfo, size(flattened), flattened, reduced)
+ out_array = reshape(reduced, shape(out_array))
+
+ deallocate(reduced)
+ deallocate(flattened)
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_min.F b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_min.F
new file mode 100644
index 0000000000..debc48741f
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_min.F
@@ -0,0 +1,22 @@
+ ! no weights
+ do i = 1, solve
+ do v = 1, levels
+
+! 1 -> 2
+
+ end do
+ end do
+ block => block % next
+ end do
+
+ allocate(flattened(size(out_array)))
+ allocate(reduced(size(out_array)))
+
+ ! min across processors
+ flattened = reshape(out_array, shape(flattened))
+ call mpas_dmpar_min_real_array(dminfo, size(flattened), flattened, reduced)
+ out_array = reshape(reduced, shape(out_array))
+
+ deallocate(reduced)
+ deallocate(flattened)
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_min_1.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_min_1.inc
new file mode 100644
index 0000000000..eae825b535
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_min_1.inc
@@ -0,0 +1,5 @@
+ ! no weights
+ do i = 1, solve
+ do v = 1, levels
+
+! 1 -> 2
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_min_2.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_min_2.inc
new file mode 100644
index 0000000000..af56f2979a
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_min_2.inc
@@ -0,0 +1,18 @@
+! 1 -> 2
+
+ end do
+ end do
+ block => block % next
+ end do
+
+ allocate(flattened(size(out_array)))
+ allocate(reduced(size(out_array)))
+
+ ! min across processors
+ flattened = reshape(out_array, shape(flattened))
+ call mpas_dmpar_min_real_array(dminfo, size(flattened), flattened, reduced)
+ out_array = reshape(reduced, shape(out_array))
+
+ deallocate(reduced)
+ deallocate(flattened)
+ end do
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_start.F b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_start.F
new file mode 100644
index 0000000000..f914991c65
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_start.F
@@ -0,0 +1,57 @@
+ type (dm_info), pointer, intent(in) :: dminfo
+ type (block_type), pointer, intent(in) :: start_block
+ type (regional_type), intent(in) :: regions
+ type (regional_variable_type), intent(in) :: variable
+ integer, intent(in) :: levels
+
+ real (kind=RKIND), dimension(:), allocatable :: flattened, reduced
+ integer :: b, m, i, last, v
+ integer, pointer :: solve
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: amPool, maskPool
+ real (kind=RKIND), dimension(:,:), pointer :: weights
+ real (kind=RKIND), dimension(:), pointer :: weight_total
+ integer, dimension(:,:), pointer :: mask, vertical_mask
+ integer, dimension(:), pointer :: count_array
+ integer, dimension(:), allocatable :: copy_count
+
+! 1 -> 2
+
+ last = regions % num_regions_per(regions % group_index)
+ do b = 1, last
+ ! get the output array, which should be the first block
+ call mpas_pool_get_subpool(start_block % structs, &
+ REGIONAL_STATS_POOL, amPool)
+ call mpas_pool_get_array(amPool, variable % output_names(b), &
+ out_array, 1)
+
+ m = regions % groups(b, regions % group_index)
+
+ call mpas_pool_get_array(amPool, regions % count_oned_names(b), &
+ count_array, 1)
+ if (regions % function_twod == MUL_FUNC) then
+ call mpas_pool_get_array(amPool, regions % weight_oned_names(b), &
+ weight_total, 1)
+ end if
+
+! 2 -> 3
+
+ ! iterate over blocks
+ block => start_block
+ do while (associated(block))
+ ! get the dimensions for this block
+ if (regions % region_element == CELL_REGION) then
+ call mpas_pool_get_dimension(block % dimensions, CELL_SOLVE, solve)
+ else
+ call mpas_pool_get_dimension(block % dimensions, VERTEX_SOLVE, solve)
+ end if
+
+ ! get the subpools
+ call mpas_pool_get_subpool(block % structs, MASK_POOL_NAME, maskPool)
+
+ ! get the arrays
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+ call mpas_pool_get_array(maskPool, regions % masking_field, mask, 1)
+ call mpas_pool_get_array(block % allFields, regions % vertical_mask, &
+ vertical_mask, 1)
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_start_1.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_start_1.inc
new file mode 100644
index 0000000000..57ab24b50f
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_start_1.inc
@@ -0,0 +1,18 @@
+ type (dm_info), pointer, intent(in) :: dminfo
+ type (block_type), pointer, intent(in) :: start_block
+ type (regional_type), intent(in) :: regions
+ type (regional_variable_type), intent(in) :: variable
+ integer, intent(in) :: levels
+
+ real (kind=RKIND), dimension(:), allocatable :: flattened, reduced
+ integer :: b, m, i, last, v
+ integer, pointer :: solve
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: amPool, maskPool
+ real (kind=RKIND), dimension(:,:), pointer :: weights
+ real (kind=RKIND), dimension(:), pointer :: weight_total
+ integer, dimension(:,:), pointer :: mask, vertical_mask
+ integer, dimension(:), pointer :: count_array
+ integer, dimension(:), allocatable :: copy_count
+
+! 1 -> 2
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_start_2.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_start_2.inc
new file mode 100644
index 0000000000..c524a53b6b
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_start_2.inc
@@ -0,0 +1,20 @@
+! 1 -> 2
+
+ last = regions % num_regions_per(regions % group_index)
+ do b = 1, last
+ ! get the output array, which should be the first block
+ call mpas_pool_get_subpool(start_block % structs, &
+ REGIONAL_STATS_POOL, amPool)
+ call mpas_pool_get_array(amPool, variable % output_names(b), &
+ out_array, 1)
+
+ m = regions % groups(b, regions % group_index)
+
+ call mpas_pool_get_array(amPool, regions % count_oned_names(b), &
+ count_array, 1)
+ if (regions % function_twod == MUL_FUNC) then
+ call mpas_pool_get_array(amPool, regions % weight_oned_names(b), &
+ weight_total, 1)
+ end if
+
+! 2 -> 3
diff --git a/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_start_3.inc b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_start_3.inc
new file mode 100644
index 0000000000..995b5cff2f
--- /dev/null
+++ b/src/core_ocean/analysis_members/regional_stats_inc/regional_opvert_start_3.inc
@@ -0,0 +1,21 @@
+! 2 -> 3
+
+ ! iterate over blocks
+ block => start_block
+ do while (associated(block))
+ ! get the dimensions for this block
+ if (regions % region_element == CELL_REGION) then
+ call mpas_pool_get_dimension(block % dimensions, CELL_SOLVE, solve)
+ else
+ call mpas_pool_get_dimension(block % dimensions, VERTEX_SOLVE, solve)
+ end if
+
+ ! get the subpools
+ call mpas_pool_get_subpool(block % structs, MASK_POOL_NAME, maskPool)
+
+ ! get the arrays
+ call mpas_pool_get_array(block % allFields, &
+ variable % input_name, in_array, 1)
+ call mpas_pool_get_array(maskPool, regions % masking_field, mask, 1)
+ call mpas_pool_get_array(block % allFields, regions % vertical_mask, &
+ vertical_mask, 1)
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_0d.F b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_0d.F
new file mode 100644
index 0000000000..b3e61bc8bf
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_0d.F
@@ -0,0 +1,37 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field0DReal), pointer :: temp, temp_iter
+ type (field0DReal), pointer :: top_iter
+ type (field0DReal), pointer :: second_iter
+ real (kind=RKIND), pointer :: top
+ real (kind=RKIND), pointer :: second
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer) % d0, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d0
+ second_iter => stack(stack_pointer - 1) % d0
+
+ ! do operation
+ top => top_iter % scalar
+ second => second_iter % scalar
+ temp_iter % scalar = &
+
+! 1-2 break
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d0)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d0)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d0 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 0
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_0d_1.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_0d_1.inc
new file mode 100644
index 0000000000..c8a587743d
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_0d_1.inc
@@ -0,0 +1,22 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field0DReal), pointer :: temp, temp_iter
+ type (field0DReal), pointer :: top_iter
+ type (field0DReal), pointer :: second_iter
+ real (kind=RKIND), pointer :: top
+ real (kind=RKIND), pointer :: second
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer) % d0, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d0
+ second_iter => stack(stack_pointer - 1) % d0
+
+ ! do operation
+ top => top_iter % scalar
+ second => second_iter % scalar
+ temp_iter % scalar = &
+
+! 1-2 break
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_0d_2.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_0d_2.inc
new file mode 100644
index 0000000000..b476725f9d
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_0d_2.inc
@@ -0,0 +1,16 @@
+! 1-2 break
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d0)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d0)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d0 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 0
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_1d.F b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_1d.F
new file mode 100644
index 0000000000..44d8df415f
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_1d.F
@@ -0,0 +1,43 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field1DReal), pointer :: temp, temp_iter
+ type (field1DReal), pointer :: top_iter
+ type (field0DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:), pointer :: top
+ real (kind=RKIND), pointer :: second
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer) % d1, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d1
+ second_iter => stack(stack_pointer - 1) % d0
+
+ second => second_iter % scalar
+
+ do while (associated(temp_iter))
+ ! do operation
+ top => top_iter % array
+ temp_iter % array = &
+
+! 1-2 break
+
+ top_iter => top_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d1)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d0)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d1 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 1
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_1d_1.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_1d_1.inc
new file mode 100644
index 0000000000..c7e3cb4b99
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_1d_1.inc
@@ -0,0 +1,24 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field1DReal), pointer :: temp, temp_iter
+ type (field1DReal), pointer :: top_iter
+ type (field0DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:), pointer :: top
+ real (kind=RKIND), pointer :: second
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer) % d1, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d1
+ second_iter => stack(stack_pointer - 1) % d0
+
+ second => second_iter % scalar
+
+ do while (associated(temp_iter))
+ ! do operation
+ top => top_iter % array
+ temp_iter % array = &
+
+! 1-2 break
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_1d_2.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_1d_2.inc
new file mode 100644
index 0000000000..63835dcc17
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_1d_2.inc
@@ -0,0 +1,20 @@
+! 1-2 break
+
+ top_iter => top_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d1)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d0)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d1 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 1
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_2d.F b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_2d.F
new file mode 100644
index 0000000000..33b12c4132
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_2d.F
@@ -0,0 +1,43 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field2DReal), pointer :: temp, temp_iter
+ type (field2DReal), pointer :: top_iter
+ type (field0DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:,:), pointer :: top
+ real (kind=RKIND), pointer :: second
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer) % d2, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d2
+ second_iter => stack(stack_pointer - 1) % d0
+
+ second => second_iter % scalar
+
+ do while (associated(temp_iter))
+ ! do operation
+ top => top_iter % array
+ temp_iter % array = &
+
+! 1-2 break
+
+ top_iter => top_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d2)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d0)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d2 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 2
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_2d_1.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_2d_1.inc
new file mode 100644
index 0000000000..2d52175626
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_2d_1.inc
@@ -0,0 +1,24 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field2DReal), pointer :: temp, temp_iter
+ type (field2DReal), pointer :: top_iter
+ type (field0DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:,:), pointer :: top
+ real (kind=RKIND), pointer :: second
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer) % d2, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d2
+ second_iter => stack(stack_pointer - 1) % d0
+
+ second => second_iter % scalar
+
+ do while (associated(temp_iter))
+ ! do operation
+ top => top_iter % array
+ temp_iter % array = &
+
+! 1-2 break
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_2d_2.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_2d_2.inc
new file mode 100644
index 0000000000..9d9d8a0d51
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_0d_2d_2.inc
@@ -0,0 +1,20 @@
+! 1-2 break
+
+ top_iter => top_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d2)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d0)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d2 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 2
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_0d.F b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_0d.F
new file mode 100644
index 0000000000..02c6a95885
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_0d.F
@@ -0,0 +1,43 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field1DReal), pointer :: temp, temp_iter
+ type (field0DReal), pointer :: top_iter
+ type (field1DReal), pointer :: second_iter
+ real (kind=RKIND), pointer :: top
+ real (kind=RKIND), dimension(:), pointer :: second
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer - 1) % d1, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d0
+ second_iter => stack(stack_pointer - 1) % d1
+
+ top => top_iter % scalar
+
+ do while (associated(temp_iter))
+ ! do operation
+ second => second_iter % array
+ temp_iter % array = &
+
+! 1-2 break
+
+ second_iter => second_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d0)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d1)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d1 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 1
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_0d_1.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_0d_1.inc
new file mode 100644
index 0000000000..2d57b6dd28
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_0d_1.inc
@@ -0,0 +1,24 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field1DReal), pointer :: temp, temp_iter
+ type (field0DReal), pointer :: top_iter
+ type (field1DReal), pointer :: second_iter
+ real (kind=RKIND), pointer :: top
+ real (kind=RKIND), dimension(:), pointer :: second
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer - 1) % d1, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d0
+ second_iter => stack(stack_pointer - 1) % d1
+
+ top => top_iter % scalar
+
+ do while (associated(temp_iter))
+ ! do operation
+ second => second_iter % array
+ temp_iter % array = &
+
+! 1-2 break
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_0d_2.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_0d_2.inc
new file mode 100644
index 0000000000..52c7acae19
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_0d_2.inc
@@ -0,0 +1,20 @@
+! 1-2 break
+
+ second_iter => second_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d0)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d1)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d1 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 1
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_diff.F b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_diff.F
new file mode 100644
index 0000000000..078b626111
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_diff.F
@@ -0,0 +1,53 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field2DReal), pointer :: temp, temp_iter
+ type (field1DReal), pointer :: top_iter
+ type (field1DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:), pointer :: top
+ real (kind=RKIND), dimension(:), pointer :: second
+ integer :: i, j, iend, jend
+
+ ! allocate a temp for result
+ call create_2d_field_from_1ds( &
+ stack(stack_pointer - 1) % d1, stack(stack_pointer) % d1, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d1
+ second_iter => stack(stack_pointer - 1) % d1
+
+ second => second_iter % array
+ iend = size(second)
+
+ do while (associated(temp_iter))
+ ! do operation
+ top => top_iter % array
+ jend = size(top)
+
+ do j = 1, jend
+ do i = 1, iend
+ temp_iter % array(i,j) = &
+
+! 1-2 break
+
+ end do
+ end do
+
+ top_iter => top_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d1)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d1)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d2 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 2
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_diff_1.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_diff_1.inc
new file mode 100644
index 0000000000..eb0a6b6a78
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_diff_1.inc
@@ -0,0 +1,31 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field2DReal), pointer :: temp, temp_iter
+ type (field1DReal), pointer :: top_iter
+ type (field1DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:), pointer :: top
+ real (kind=RKIND), dimension(:), pointer :: second
+ integer :: i, j, iend, jend
+
+ ! allocate a temp for result
+ call create_2d_field_from_1ds( &
+ stack(stack_pointer - 1) % d1, stack(stack_pointer) % d1, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d1
+ second_iter => stack(stack_pointer - 1) % d1
+
+ second => second_iter % array
+ iend = size(second)
+
+ do while (associated(temp_iter))
+ ! do operation
+ top => top_iter % array
+ jend = size(top)
+
+ do j = 1, jend
+ do i = 1, iend
+ temp_iter % array(i,j) = &
+
+! 1-2 break
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_diff_2.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_diff_2.inc
new file mode 100644
index 0000000000..9d3941314e
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_diff_2.inc
@@ -0,0 +1,23 @@
+! 1-2 break
+
+ end do
+ end do
+
+ top_iter => top_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d1)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d1)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d2 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 2
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_same.F b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_same.F
new file mode 100644
index 0000000000..85821176ad
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_same.F
@@ -0,0 +1,43 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field1DReal), pointer :: temp, temp_iter
+ type (field1DReal), pointer :: top_iter
+ type (field1DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:), pointer :: top
+ real (kind=RKIND), dimension(:), pointer :: second
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer) % d1, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d1
+ second_iter => stack(stack_pointer - 1) % d1
+
+ do while (associated(temp_iter))
+ ! do operation
+ top => top_iter % array
+ second => second_iter % array
+ temp_iter % array = &
+
+! 1-2 break
+
+ top_iter => top_iter % next
+ second_iter => second_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d1)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d1)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d1 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 1
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_same_1.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_same_1.inc
new file mode 100644
index 0000000000..c69c217f96
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_same_1.inc
@@ -0,0 +1,23 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field1DReal), pointer :: temp, temp_iter
+ type (field1DReal), pointer :: top_iter
+ type (field1DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:), pointer :: top
+ real (kind=RKIND), dimension(:), pointer :: second
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer) % d1, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d1
+ second_iter => stack(stack_pointer - 1) % d1
+
+ do while (associated(temp_iter))
+ ! do operation
+ top => top_iter % array
+ second => second_iter % array
+ temp_iter % array = &
+
+! 1-2 break
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_same_2.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_same_2.inc
new file mode 100644
index 0000000000..03bd75e609
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_1d_same_2.inc
@@ -0,0 +1,21 @@
+! 1-2 break
+
+ top_iter => top_iter % next
+ second_iter => second_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d1)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d1)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d1 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 1
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_first.F b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_first.F
new file mode 100644
index 0000000000..a7a235733f
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_first.F
@@ -0,0 +1,49 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field2DReal), pointer :: temp, temp_iter
+ type (field2DReal), pointer :: top_iter
+ type (field1DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:,:), pointer :: top
+ real (kind=RKIND), dimension(:), pointer :: second
+ integer :: j, jend
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer) % d2, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d2
+ second_iter => stack(stack_pointer - 1) % d1
+
+ second => second_iter % array
+
+ do while (associated(temp_iter))
+ ! do operation
+ top => top_iter % array
+ jend = size(top, 2)
+
+ do j = 1, jend
+ temp_iter % array(:,j) = &
+
+! 1-2 break
+
+ end do
+
+ top_iter => top_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d2)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d1)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d2 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 2
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_first_1.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_first_1.inc
new file mode 100644
index 0000000000..0eecac5114
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_first_1.inc
@@ -0,0 +1,28 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field2DReal), pointer :: temp, temp_iter
+ type (field2DReal), pointer :: top_iter
+ type (field1DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:,:), pointer :: top
+ real (kind=RKIND), dimension(:), pointer :: second
+ integer :: j, jend
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer) % d2, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d2
+ second_iter => stack(stack_pointer - 1) % d1
+
+ second => second_iter % array
+
+ do while (associated(temp_iter))
+ ! do operation
+ top => top_iter % array
+ jend = size(top, 2)
+
+ do j = 1, jend
+ temp_iter % array(:,j) = &
+
+! 1-2 break
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_first_2.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_first_2.inc
new file mode 100644
index 0000000000..4700c0bac3
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_first_2.inc
@@ -0,0 +1,22 @@
+! 1-2 break
+
+ end do
+
+ top_iter => top_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d2)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d1)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d2 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 2
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_second.F b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_second.F
new file mode 100644
index 0000000000..dd6dfb2ff9
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_second.F
@@ -0,0 +1,50 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field2DReal), pointer :: temp, temp_iter
+ type (field2DReal), pointer :: top_iter
+ type (field1DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:,:), pointer :: top
+ real (kind=RKIND), dimension(:), pointer :: second
+ integer :: i, iend
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer) % d2, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d2
+ second_iter => stack(stack_pointer - 1) % d1
+
+ do while (associated(temp_iter))
+ ! do operation
+ top => top_iter % array
+ second => second_iter % array
+
+ iend = size(top, 1)
+
+ do i = 1, iend
+ temp_iter % array(i,:) = &
+
+! 1-2 break
+
+ end do
+
+ top_iter => top_iter % next
+ second_iter => second_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d2)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d1)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d2 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 2
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_second_1.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_second_1.inc
new file mode 100644
index 0000000000..15b5a3fa21
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_second_1.inc
@@ -0,0 +1,28 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field2DReal), pointer :: temp, temp_iter
+ type (field2DReal), pointer :: top_iter
+ type (field1DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:,:), pointer :: top
+ real (kind=RKIND), dimension(:), pointer :: second
+ integer :: i, iend
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer) % d2, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d2
+ second_iter => stack(stack_pointer - 1) % d1
+
+ do while (associated(temp_iter))
+ ! do operation
+ top => top_iter % array
+ second => second_iter % array
+
+ iend = size(top, 1)
+
+ do i = 1, iend
+ temp_iter % array(i,:) = &
+
+! 1-2 break
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_second_2.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_second_2.inc
new file mode 100644
index 0000000000..f016609cb5
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_1d_2d_second_2.inc
@@ -0,0 +1,23 @@
+! 1-2 break
+
+ end do
+
+ top_iter => top_iter % next
+ second_iter => second_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d2)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d1)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d2 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 2
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_0d.F b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_0d.F
new file mode 100644
index 0000000000..5874874888
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_0d.F
@@ -0,0 +1,44 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field2DReal), pointer :: temp, temp_iter
+ type (field0DReal), pointer :: top_iter
+ type (field2DReal), pointer :: second_iter
+ real (kind=RKIND), pointer :: top
+ real (kind=RKIND), dimension(:,:), pointer :: second
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer - 1) % d2, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d0
+ second_iter => stack(stack_pointer - 1) % d2
+
+ top => top_iter % scalar
+
+ do while (associated(temp_iter))
+ second => second_iter % array
+
+ ! do operation
+ temp_iter % array = &
+
+! 1-2 break
+
+ second_iter => second_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d0)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d2)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d2 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 2
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_0d_1.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_0d_1.inc
new file mode 100644
index 0000000000..c6b7a48e53
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_0d_1.inc
@@ -0,0 +1,25 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field2DReal), pointer :: temp, temp_iter
+ type (field0DReal), pointer :: top_iter
+ type (field2DReal), pointer :: second_iter
+ real (kind=RKIND), pointer :: top
+ real (kind=RKIND), dimension(:,:), pointer :: second
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer - 1) % d2, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d0
+ second_iter => stack(stack_pointer - 1) % d2
+
+ top => top_iter % scalar
+
+ do while (associated(temp_iter))
+ second => second_iter % array
+
+ ! do operation
+ temp_iter % array = &
+
+! 1-2 break
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_0d_2.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_0d_2.inc
new file mode 100644
index 0000000000..92114feb06
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_0d_2.inc
@@ -0,0 +1,20 @@
+! 1-2 break
+
+ second_iter => second_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d0)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d2)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d2 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 2
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_first.F b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_first.F
new file mode 100644
index 0000000000..8b0a999f63
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_first.F
@@ -0,0 +1,49 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field2DReal), pointer :: temp, temp_iter
+ type (field1DReal), pointer :: top_iter
+ type (field2DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:), pointer :: top
+ real (kind=RKIND), dimension(:,:), pointer :: second
+ integer :: j, jend
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer - 1) % d2, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d1
+ second_iter => stack(stack_pointer - 1) % d2
+
+ top => top_iter % array
+
+ do while (associated(temp_iter))
+ ! do operation
+ second => second_iter % array
+ jend = size(second, 2)
+
+ do j = 1, jend
+ temp_iter % array(:,j) = &
+
+! 1-2 break
+
+ end do
+
+ second_iter => second_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d1)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d2)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d2 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 2
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_first_1.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_first_1.inc
new file mode 100644
index 0000000000..2e9f1a1872
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_first_1.inc
@@ -0,0 +1,28 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field2DReal), pointer :: temp, temp_iter
+ type (field1DReal), pointer :: top_iter
+ type (field2DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:), pointer :: top
+ real (kind=RKIND), dimension(:,:), pointer :: second
+ integer :: j, jend
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer - 1) % d2, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d1
+ second_iter => stack(stack_pointer - 1) % d2
+
+ top => top_iter % array
+
+ do while (associated(temp_iter))
+ ! do operation
+ second => second_iter % array
+ jend = size(second, 2)
+
+ do j = 1, jend
+ temp_iter % array(:,j) = &
+
+! 1-2 break
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_first_2.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_first_2.inc
new file mode 100644
index 0000000000..f331e24ea7
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_first_2.inc
@@ -0,0 +1,22 @@
+! 1-2 break
+
+ end do
+
+ second_iter => second_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d1)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d2)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d2 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 2
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_second.F b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_second.F
new file mode 100644
index 0000000000..7bbdaf8b3f
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_second.F
@@ -0,0 +1,50 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field2DReal), pointer :: temp, temp_iter
+ type (field1DReal), pointer :: top_iter
+ type (field2DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:), pointer :: top
+ real (kind=RKIND), dimension(:,:), pointer :: second
+ integer :: i, iend
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer - 1) % d2, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d1
+ second_iter => stack(stack_pointer - 1) % d2
+
+ do while (associated(temp_iter))
+ ! do operation
+ top => top_iter % array
+ second => second_iter % array
+
+ iend = size(second, 1)
+
+ do i = 1, iend
+ temp_iter % array(i,:) = &
+
+! 1-2 break
+
+ end do
+
+ top_iter => top_iter % next
+ second_iter => second_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d1)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d2)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d2 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 2
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_second_1.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_second_1.inc
new file mode 100644
index 0000000000..ffb441ed7f
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_second_1.inc
@@ -0,0 +1,28 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field2DReal), pointer :: temp, temp_iter
+ type (field1DReal), pointer :: top_iter
+ type (field2DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:), pointer :: top
+ real (kind=RKIND), dimension(:,:), pointer :: second
+ integer :: i, iend
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer - 1) % d2, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d1
+ second_iter => stack(stack_pointer - 1) % d2
+
+ do while (associated(temp_iter))
+ ! do operation
+ top => top_iter % array
+ second => second_iter % array
+
+ iend = size(second, 1)
+
+ do i = 1, iend
+ temp_iter % array(i,:) = &
+
+! 1-2 break
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_second_2.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_second_2.inc
new file mode 100644
index 0000000000..7821855c44
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_1d_second_2.inc
@@ -0,0 +1,23 @@
+! 1-2 break
+
+ end do
+
+ top_iter => top_iter % next
+ second_iter => second_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d1)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d2)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d2 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 2
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_2d.F b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_2d.F
new file mode 100644
index 0000000000..48553ceeb1
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_2d.F
@@ -0,0 +1,43 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field2DReal), pointer :: temp, temp_iter
+ type (field2DReal), pointer :: top_iter
+ type (field2DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:,:), pointer :: top
+ real (kind=RKIND), dimension(:,:), pointer :: second
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer) % d2, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d2
+ second_iter => stack(stack_pointer - 1) % d2
+
+ do while (associated(temp_iter))
+ ! do operation
+ top => top_iter % array
+ second => second_iter % array
+ temp_iter % array = &
+
+! 1-2 break
+
+ top_iter => top_iter % next
+ second_iter => second_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d2)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d2)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d2 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 2
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_2d_1.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_2d_1.inc
new file mode 100644
index 0000000000..ed2f5d755f
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_2d_1.inc
@@ -0,0 +1,23 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field2DReal), pointer :: temp, temp_iter
+ type (field2DReal), pointer :: top_iter
+ type (field2DReal), pointer :: second_iter
+ real (kind=RKIND), dimension(:,:), pointer :: top
+ real (kind=RKIND), dimension(:,:), pointer :: second
+
+ ! allocate a temp for result
+ call mpas_duplicate_field(stack(stack_pointer) % d2, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d2
+ second_iter => stack(stack_pointer - 1) % d2
+
+ do while (associated(temp_iter))
+ ! do operation
+ top => top_iter % array
+ second => second_iter % array
+ temp_iter % array = &
+
+! 1-2 break
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_2d_2.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_2d_2.inc
new file mode 100644
index 0000000000..a3254d1d7e
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_2d_2d_2.inc
@@ -0,0 +1,21 @@
+! 1-2 break
+
+ top_iter => top_iter % next
+ second_iter => second_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d2)
+ end if
+
+ if (stack(stack_pointer - 1) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer - 1) % d2)
+ end if
+
+ ! set stack
+ stack_pointer = stack_pointer - 1
+ stack(stack_pointer) % d2 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 2
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch.F b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch.F
new file mode 100644
index 0000000000..04b8562b19
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch.F
@@ -0,0 +1,130 @@
+ integer, intent(in) :: exp_number
+ logical, intent(in) :: type_checking
+
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+
+ integer :: a_nd, b_nd
+ character (len=StrKIND) :: op_name
+
+! 0d 0d
+
+ if (type_checking) then
+ ! check size of stack
+ if (stack_pointer < 2) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'expression #' // trim(expression_names(exp_number)) // &
+ ' tried to ' // trim(op_name) // ' when there ' // &
+ 'were less than two operands on the stack, in the RPN calculator AM')
+ end if
+ end if
+
+ a_nd = stack(stack_pointer - 1) % number_of_dims
+ b_nd = stack(stack_pointer) % number_of_dims
+
+ ! call the right one
+ if (a_nd == 0) then
+ if (b_nd == 0) then
+
+! 0d 1d
+
+ else if (b_nd == 1) then
+
+! 0d 2d
+
+ else
+
+! 1d 0d
+
+ end if
+ else if (a_nd == 1) then
+ if (b_nd == 0) then
+
+! 1d 1d same
+
+ else if (b_nd == 1) then
+ if (trim(stack(stack_pointer - 1) % d1 % dimNames(1)) == &
+ trim(stack(stack_pointer) % d1 % dimNames(1))) then
+
+! 1d 1d diff
+
+ else
+ if (type_checking) then
+ if (stack(stack_pointer - 1) % d1 % isDecomposed) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ trim(op_name) // ' in expression #' // &
+ trim(expression_names(exp_number)) // ' tried to operate ' // &
+ 'on two 1d arrays, with different dimensions, where the first ' // &
+ 'operand (1d array) is decomposed -- only the ' // &
+ 'second operand (the top of the stack) can be decomposed')
+ end if
+ end if
+
+! 1d 2d first
+
+ end if
+ else
+ if (trim(stack(stack_pointer - 1) % d1 % dimNames(1)) == &
+ trim(stack(stack_pointer) % d2 % dimNames(1))) then
+
+! 1d 2d second
+
+ else
+ if (type_checking) then
+ if (trim(stack(stack_pointer - 1) % d1 % dimNames(1)) /= &
+ trim(stack(stack_pointer) % d2 % dimNames(2))) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ trim(op_name) // ' in expression #' // &
+ trim(expression_names(exp_number)) // ' tried to operate ' // &
+ 'with a 1d array on a 2d array when none of the dimensions ' // &
+ 'match between the two arrays')
+ end if
+ end if
+
+! 2d 0d
+
+ end if
+ end if
+ else
+ if (b_nd == 0) then
+
+! 2d 1d first
+
+ else if (b_nd == 1) then
+ if (trim(stack(stack_pointer - 1) % d2 % dimNames(1)) == &
+ trim(stack(stack_pointer) % d1 % dimNames(1))) then
+
+! 2d 1d second
+
+ else
+ if (type_checking) then
+ if (trim(stack(stack_pointer - 1) % d2 % dimNames(2)) /= &
+ trim(stack(stack_pointer) % d1 % dimNames(1))) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ trim(op_name) // ' in expression #' // &
+ trim(expression_names(exp_number)) // ' tried to operate ' // &
+ 'with a 1d array on a 2d array when none of the dimensions ' // &
+ 'match between the two arrays')
+ end if
+ end if
+
+! 2d 2d
+
+ end if
+ else
+ if (type_checking) then
+ if ((trim(stack(stack_pointer - 1) % d2 % dimNames(1)) /= &
+ trim(stack(stack_pointer) % d2 % dimNames(1))) .or. &
+ (trim(stack(stack_pointer - 1) % d2 % dimNames(2)) /= &
+ trim(stack(stack_pointer) % d2 % dimNames(2)))) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ trim(op_name) // ' in expression #' // &
+ trim(expression_names(exp_number)) // ' tried to operate ' // &
+ 'on two 2d arrays when their dimension names do not match')
+ end if
+ end if
+
+! end
+
+ end if
+ end if
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_0d_0d.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_0d_0d.inc
new file mode 100644
index 0000000000..d7f71d6afd
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_0d_0d.inc
@@ -0,0 +1,20 @@
+! 0d 0d
+
+ if (type_checking) then
+ ! check size of stack
+ if (stack_pointer < 2) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'expression #' // trim(expression_names(exp_number)) // &
+ ' tried to ' // trim(op_name) // ' when there ' // &
+ 'were less than two operands on the stack, in the RPN calculator AM')
+ end if
+ end if
+
+ a_nd = stack(stack_pointer - 1) % number_of_dims
+ b_nd = stack(stack_pointer) % number_of_dims
+
+ ! call the right one
+ if (a_nd == 0) then
+ if (b_nd == 0) then
+
+! 0d 1d
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_0d_1d.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_0d_1d.inc
new file mode 100644
index 0000000000..ec959cd54c
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_0d_1d.inc
@@ -0,0 +1,5 @@
+! 0d 1d
+
+ else if (b_nd == 1) then
+
+! 0d 2d
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_0d_2d.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_0d_2d.inc
new file mode 100644
index 0000000000..b101960309
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_0d_2d.inc
@@ -0,0 +1,5 @@
+! 0d 2d
+
+ else
+
+! 1d 0d
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_1d_0d.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_1d_0d.inc
new file mode 100644
index 0000000000..03c620cbfc
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_1d_0d.inc
@@ -0,0 +1,7 @@
+! 1d 0d
+
+ end if
+ else if (a_nd == 1) then
+ if (b_nd == 0) then
+
+! 1d 1d same
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_1d_1d_diff.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_1d_1d_diff.inc
new file mode 100644
index 0000000000..b3d043dee5
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_1d_1d_diff.inc
@@ -0,0 +1,15 @@
+! 1d 1d diff
+
+ else
+ if (type_checking) then
+ if (stack(stack_pointer - 1) % d1 % isDecomposed) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ trim(op_name) // ' in expression #' // &
+ trim(expression_names(exp_number)) // ' tried to operate ' // &
+ 'on two 1d arrays, with different dimensions, where the first ' // &
+ 'operand (1d array) is decomposed -- only the ' // &
+ 'second operand (the top of the stack) can be decomposed')
+ end if
+ end if
+
+! 1d 2d first
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_1d_1d_same.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_1d_1d_same.inc
new file mode 100644
index 0000000000..07ef6e6044
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_1d_1d_same.inc
@@ -0,0 +1,7 @@
+! 1d 1d same
+
+ else if (b_nd == 1) then
+ if (trim(stack(stack_pointer - 1) % d1 % dimNames(1)) == &
+ trim(stack(stack_pointer) % d1 % dimNames(1))) then
+
+! 1d 1d diff
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_1d_2d_first.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_1d_2d_first.inc
new file mode 100644
index 0000000000..92340f8cb8
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_1d_2d_first.inc
@@ -0,0 +1,8 @@
+! 1d 2d first
+
+ end if
+ else
+ if (trim(stack(stack_pointer - 1) % d1 % dimNames(1)) == &
+ trim(stack(stack_pointer) % d2 % dimNames(1))) then
+
+! 1d 2d second
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_1d_2d_second.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_1d_2d_second.inc
new file mode 100644
index 0000000000..eaa6f1c2a2
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_1d_2d_second.inc
@@ -0,0 +1,15 @@
+! 1d 2d second
+
+ else
+ if (type_checking) then
+ if (trim(stack(stack_pointer - 1) % d1 % dimNames(1)) /= &
+ trim(stack(stack_pointer) % d2 % dimNames(2))) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ trim(op_name) // ' in expression #' // &
+ trim(expression_names(exp_number)) // ' tried to operate ' // &
+ 'with a 1d array on a 2d array when none of the dimensions ' // &
+ 'match between the two arrays')
+ end if
+ end if
+
+! 2d 0d
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_2d_0d.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_2d_0d.inc
new file mode 100644
index 0000000000..17137b57b6
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_2d_0d.inc
@@ -0,0 +1,8 @@
+! 2d 0d
+
+ end if
+ end if
+ else
+ if (b_nd == 0) then
+
+! 2d 1d first
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_2d_1d_first.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_2d_1d_first.inc
new file mode 100644
index 0000000000..43740e3247
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_2d_1d_first.inc
@@ -0,0 +1,7 @@
+! 2d 1d first
+
+ else if (b_nd == 1) then
+ if (trim(stack(stack_pointer - 1) % d2 % dimNames(1)) == &
+ trim(stack(stack_pointer) % d1 % dimNames(1))) then
+
+! 2d 1d second
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_2d_1d_second.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_2d_1d_second.inc
new file mode 100644
index 0000000000..68f7fa264c
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_2d_1d_second.inc
@@ -0,0 +1,15 @@
+! 2d 1d second
+
+ else
+ if (type_checking) then
+ if (trim(stack(stack_pointer - 1) % d2 % dimNames(2)) /= &
+ trim(stack(stack_pointer) % d1 % dimNames(1))) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ trim(op_name) // ' in expression #' // &
+ trim(expression_names(exp_number)) // ' tried to operate ' // &
+ 'with a 1d array on a 2d array when none of the dimensions ' // &
+ 'match between the two arrays')
+ end if
+ end if
+
+! 2d 2d
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_2d_2d.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_2d_2d.inc
new file mode 100644
index 0000000000..ddb0b4b810
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_2d_2d.inc
@@ -0,0 +1,17 @@
+! 2d 2d
+
+ end if
+ else
+ if (type_checking) then
+ if ((trim(stack(stack_pointer - 1) % d2 % dimNames(1)) /= &
+ trim(stack(stack_pointer) % d2 % dimNames(1))) .or. &
+ (trim(stack(stack_pointer - 1) % d2 % dimNames(2)) /= &
+ trim(stack(stack_pointer) % d2 % dimNames(2)))) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ trim(op_name) // ' in expression #' // &
+ trim(expression_names(exp_number)) // ' tried to operate ' // &
+ 'on two 2d arrays when their dimension names do not match')
+ end if
+ end if
+
+! end
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_end.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_end.inc
new file mode 100644
index 0000000000..b829249a1b
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_end.inc
@@ -0,0 +1,4 @@
+! end
+
+ end if
+ end if
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_start.inc b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_start.inc
new file mode 100644
index 0000000000..aaeffe5d98
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/binary_op_dispatch_start.inc
@@ -0,0 +1,10 @@
+ integer, intent(in) :: exp_number
+ logical, intent(in) :: type_checking
+
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+
+ integer :: a_nd, b_nd
+ character (len=StrKIND) :: op_name
+
+! 0d 0d
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/field_0d_from_1d.F b/src/core_ocean/analysis_members/rpn_calc_inc/field_0d_from_1d.F
new file mode 100644
index 0000000000..5c5db26316
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/field_0d_from_1d.F
@@ -0,0 +1,26 @@
+ type (field0DReal), pointer, intent(out) :: dst
+ type (field1DReal), pointer, intent(inout) :: top
+
+ if (mpas_threading_get_thread_num() == 0 ) then
+ ! allocate the linked list for the field blocks
+ allocate(dst)
+ nullify(dst % prev)
+ nullify(dst % next)
+
+ ! copy field info
+ dst % fieldName = '_' // trim(top % fieldName)
+ dst % isDecomposed = .false.
+
+ dst % block => top % block
+ dst % isVarArray = .false.
+ dst % defaultValue = top % defaultValue
+ dst % isActive = top % isActive
+ dst % hasTimeDimension = top % hasTimeDimension
+ dst % sendList => top % sendList
+ dst % recvList => top % recvList
+ dst % copyList => top % copyList
+
+ allocate(dst % attLists(1))
+
+ nullify(dst % constituentNames)
+ end if
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/field_0d_from_1d.inc b/src/core_ocean/analysis_members/rpn_calc_inc/field_0d_from_1d.inc
new file mode 100644
index 0000000000..5c5db26316
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/field_0d_from_1d.inc
@@ -0,0 +1,26 @@
+ type (field0DReal), pointer, intent(out) :: dst
+ type (field1DReal), pointer, intent(inout) :: top
+
+ if (mpas_threading_get_thread_num() == 0 ) then
+ ! allocate the linked list for the field blocks
+ allocate(dst)
+ nullify(dst % prev)
+ nullify(dst % next)
+
+ ! copy field info
+ dst % fieldName = '_' // trim(top % fieldName)
+ dst % isDecomposed = .false.
+
+ dst % block => top % block
+ dst % isVarArray = .false.
+ dst % defaultValue = top % defaultValue
+ dst % isActive = top % isActive
+ dst % hasTimeDimension = top % hasTimeDimension
+ dst % sendList => top % sendList
+ dst % recvList => top % recvList
+ dst % copyList => top % copyList
+
+ allocate(dst % attLists(1))
+
+ nullify(dst % constituentNames)
+ end if
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/field_1d_from_2d.F b/src/core_ocean/analysis_members/rpn_calc_inc/field_1d_from_2d.F
new file mode 100644
index 0000000000..971347840b
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/field_1d_from_2d.F
@@ -0,0 +1,59 @@
+ type (field2DReal), pointer, intent(in) :: top_head
+ type (field1DReal), pointer, intent(out) :: head
+
+ type (field1DReal), pointer :: dst, prev
+ type (field2DReal), pointer :: top
+
+ if (mpas_threading_get_thread_num() == 0 ) then
+ nullify(head)
+ nullify(prev)
+
+ top => top_head
+ do while (associated(top))
+
+ ! allocate the linked list for the field blocks
+ allocate(dst)
+ if (.not. associated(head)) then
+ head => dst
+ end if
+
+ if (.not. associated(prev)) then
+ nullify(dst % prev)
+ else
+ prev % next => dst
+ dst % prev => prev
+ end if
+ nullify(dst % next)
+
+ ! copy field info
+ dst % fieldName = '_' // trim(top % fieldName)
+ dst % isDecomposed = top % isDecomposed
+
+ dst % block => top % block
+ dst % isVarArray = .false.
+ dst % defaultValue = top % defaultValue
+ dst % isActive = top % isActive
+ dst % hasTimeDimension = top % hasTimeDimension
+ dst % sendList => top % sendList
+ dst % recvList => top % recvList
+ dst % copyList => top % copyList
+ dst % isPersistent = top % isPersistent
+
+ allocate(dst % attLists(1))
+
+ nullify(dst % constituentNames)
+
+ dst % dimNames(1) = top % dimNames(2)
+ dst % dimSizes(1) = top % dimSizes(2)
+
+ ! allocate memory
+ if (top % isActive) then
+ allocate(dst % array(size(top % array, 2)))
+ else
+ nullify(dst % array)
+ end if
+
+ top => top % next
+ prev => dst
+ end do
+ end if
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/field_1d_from_2d.inc b/src/core_ocean/analysis_members/rpn_calc_inc/field_1d_from_2d.inc
new file mode 100644
index 0000000000..971347840b
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/field_1d_from_2d.inc
@@ -0,0 +1,59 @@
+ type (field2DReal), pointer, intent(in) :: top_head
+ type (field1DReal), pointer, intent(out) :: head
+
+ type (field1DReal), pointer :: dst, prev
+ type (field2DReal), pointer :: top
+
+ if (mpas_threading_get_thread_num() == 0 ) then
+ nullify(head)
+ nullify(prev)
+
+ top => top_head
+ do while (associated(top))
+
+ ! allocate the linked list for the field blocks
+ allocate(dst)
+ if (.not. associated(head)) then
+ head => dst
+ end if
+
+ if (.not. associated(prev)) then
+ nullify(dst % prev)
+ else
+ prev % next => dst
+ dst % prev => prev
+ end if
+ nullify(dst % next)
+
+ ! copy field info
+ dst % fieldName = '_' // trim(top % fieldName)
+ dst % isDecomposed = top % isDecomposed
+
+ dst % block => top % block
+ dst % isVarArray = .false.
+ dst % defaultValue = top % defaultValue
+ dst % isActive = top % isActive
+ dst % hasTimeDimension = top % hasTimeDimension
+ dst % sendList => top % sendList
+ dst % recvList => top % recvList
+ dst % copyList => top % copyList
+ dst % isPersistent = top % isPersistent
+
+ allocate(dst % attLists(1))
+
+ nullify(dst % constituentNames)
+
+ dst % dimNames(1) = top % dimNames(2)
+ dst % dimSizes(1) = top % dimSizes(2)
+
+ ! allocate memory
+ if (top % isActive) then
+ allocate(dst % array(size(top % array, 2)))
+ else
+ nullify(dst % array)
+ end if
+
+ top => top % next
+ prev => dst
+ end do
+ end if
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/field_2d_from_1ds.F b/src/core_ocean/analysis_members/rpn_calc_inc/field_2d_from_1ds.F
new file mode 100644
index 0000000000..ee545d328f
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/field_2d_from_1ds.F
@@ -0,0 +1,70 @@
+ type (field1DReal), pointer, intent(in) :: second, top_head
+ type (field2DReal), pointer, intent(out) :: head
+
+ type (field2DReal), pointer :: dst, prev
+ type (field1DReal), pointer :: top
+
+ if (mpas_threading_get_thread_num() == 0 ) then
+ nullify(head)
+ nullify(prev)
+
+ top => top_head
+ do while (associated(top))
+
+ ! allocate the linked list for the field blocks
+ allocate(dst)
+ if (.not. associated(head)) then
+ head => dst
+ end if
+
+ if (.not. associated(prev)) then
+ nullify(dst % prev)
+ else
+ prev % next => dst
+ dst % prev => prev
+ end if
+ nullify(dst % next)
+
+ ! copy field info
+ dst % fieldName = trim(second % fieldName) // '_' // trim(top % fieldName)
+ dst % isDecomposed = top % isDecomposed
+
+ dst % block => top % block
+ dst % isVarArray = second % isVarArray
+ dst % defaultValue = second % defaultValue
+ dst % isActive = top % isActive .and. second % isActive
+ dst % hasTimeDimension = &
+ top % hasTimeDimension .or. second % hasTimeDimension
+ dst % sendList => top % sendList
+ dst % recvList => top % recvList
+ dst % copyList => top % copyList
+ dst % isPersistent = top % isPersistent .or. second % isPersistent
+
+
+ ! copy constitutent names if second has them
+ if (associated(second % constituentNames)) then
+ allocate(dst % constituentNames(size(second % constituentNames, dim=1)))
+ allocate(dst % attLists(size(second % constituentNames, dim=1)))
+
+ dst % constituentNames(:) = second % constituentNames(:)
+ else
+ nullify(dst % constituentNames)
+ allocate(dst % attLists(1))
+ end if
+
+ dst % dimNames(1) = second % dimNames(1)
+ dst % dimNames(2) = top % dimNames(1)
+ dst % dimSizes(1) = second % dimSizes(1)
+ dst % dimSizes(2) = top % dimSizes(1)
+
+ ! allocate memory
+ if (top % isActive .and. second % isActive) then
+ allocate(dst % array(size(second % array), size(top % array)))
+ else
+ nullify(dst % array)
+ end if
+
+ top => top % next
+ prev => dst
+ end do
+ end if
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/field_2d_from_1ds.inc b/src/core_ocean/analysis_members/rpn_calc_inc/field_2d_from_1ds.inc
new file mode 100644
index 0000000000..ee545d328f
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/field_2d_from_1ds.inc
@@ -0,0 +1,70 @@
+ type (field1DReal), pointer, intent(in) :: second, top_head
+ type (field2DReal), pointer, intent(out) :: head
+
+ type (field2DReal), pointer :: dst, prev
+ type (field1DReal), pointer :: top
+
+ if (mpas_threading_get_thread_num() == 0 ) then
+ nullify(head)
+ nullify(prev)
+
+ top => top_head
+ do while (associated(top))
+
+ ! allocate the linked list for the field blocks
+ allocate(dst)
+ if (.not. associated(head)) then
+ head => dst
+ end if
+
+ if (.not. associated(prev)) then
+ nullify(dst % prev)
+ else
+ prev % next => dst
+ dst % prev => prev
+ end if
+ nullify(dst % next)
+
+ ! copy field info
+ dst % fieldName = trim(second % fieldName) // '_' // trim(top % fieldName)
+ dst % isDecomposed = top % isDecomposed
+
+ dst % block => top % block
+ dst % isVarArray = second % isVarArray
+ dst % defaultValue = second % defaultValue
+ dst % isActive = top % isActive .and. second % isActive
+ dst % hasTimeDimension = &
+ top % hasTimeDimension .or. second % hasTimeDimension
+ dst % sendList => top % sendList
+ dst % recvList => top % recvList
+ dst % copyList => top % copyList
+ dst % isPersistent = top % isPersistent .or. second % isPersistent
+
+
+ ! copy constitutent names if second has them
+ if (associated(second % constituentNames)) then
+ allocate(dst % constituentNames(size(second % constituentNames, dim=1)))
+ allocate(dst % attLists(size(second % constituentNames, dim=1)))
+
+ dst % constituentNames(:) = second % constituentNames(:)
+ else
+ nullify(dst % constituentNames)
+ allocate(dst % attLists(1))
+ end if
+
+ dst % dimNames(1) = second % dimNames(1)
+ dst % dimNames(2) = top % dimNames(1)
+ dst % dimSizes(1) = second % dimSizes(1)
+ dst % dimSizes(2) = top % dimSizes(1)
+
+ ! allocate memory
+ if (top % isActive .and. second % isActive) then
+ allocate(dst % array(size(second % array), size(top % array)))
+ else
+ nullify(dst % array)
+ end if
+
+ top => top % next
+ prev => dst
+ end do
+ end if
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_1d.F b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_1d.F
new file mode 100644
index 0000000000..3d48c2d103
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_1d.F
@@ -0,0 +1,39 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field0DReal), pointer :: temp
+ type (field1DReal), pointer :: top_iter
+ real (kind=RKIND), dimension(:), pointer :: top
+ real (kind=RKIND), pointer :: reduced
+
+ ! allocate a temp for result
+ call create_0d_field_from_1d(stack(stack_pointer) % d1, temp)
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d1
+
+ ! initial value
+ reduced => temp % scalar
+ temp % scalar = &
+
+! 1-2 break
+
+ do while (associated(top_iter))
+ ! do operation
+ top => top_iter % array
+
+ temp % scalar = &
+
+! 2-3 break
+
+ top_iter => top_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d1)
+ end if
+
+ ! set stack
+ stack(stack_pointer) % d0 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 0
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_1d_1.inc b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_1d_1.inc
new file mode 100644
index 0000000000..65d50106fc
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_1d_1.inc
@@ -0,0 +1,18 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field0DReal), pointer :: temp
+ type (field1DReal), pointer :: top_iter
+ real (kind=RKIND), dimension(:), pointer :: top
+ real (kind=RKIND), pointer :: reduced
+
+ ! allocate a temp for result
+ call create_0d_field_from_1d(stack(stack_pointer) % d1, temp)
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d1
+
+ ! initial value
+ reduced => temp % scalar
+ temp % scalar = &
+
+! 1-2 break
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_1d_2.inc b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_1d_2.inc
new file mode 100644
index 0000000000..04276ea80f
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_1d_2.inc
@@ -0,0 +1,9 @@
+! 1-2 break
+
+ do while (associated(top_iter))
+ ! do operation
+ top => top_iter % array
+
+ temp % scalar = &
+
+! 2-3 break
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_1d_3.inc b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_1d_3.inc
new file mode 100644
index 0000000000..70f6657048
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_1d_3.inc
@@ -0,0 +1,14 @@
+! 2-3 break
+
+ top_iter => top_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d1)
+ end if
+
+ ! set stack
+ stack(stack_pointer) % d0 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 0
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_2d.F b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_2d.F
new file mode 100644
index 0000000000..a0d1e0b03f
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_2d.F
@@ -0,0 +1,48 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field1DReal), pointer :: temp, temp_iter
+ type (field2DReal), pointer :: top_iter
+ real (kind=RKIND), dimension(:,:), pointer :: top
+ real (kind=RKIND), dimension(:), pointer :: reduced
+ integer :: j, jend
+
+ ! allocate a temp for result
+ call create_1d_field_from_2d(stack(stack_pointer) % d2, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d2
+
+ ! initial value
+ reduced => temp_iter % array
+ temp_iter % array = &
+
+! 1-2 break
+
+ do while (associated(top_iter))
+ ! do operation
+ top => top_iter % array
+ reduced => temp_iter % array
+
+ jend = size(top, 2)
+
+ do j = 1, jend
+ temp_iter % array(j) = &
+
+! 2-3 break
+
+ end do
+
+ top_iter => top_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d2)
+ end if
+
+ ! set stack
+ stack(stack_pointer) % d1 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 1
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_2d_1.inc b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_2d_1.inc
new file mode 100644
index 0000000000..027758d9e8
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_2d_1.inc
@@ -0,0 +1,20 @@
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+ type (field1DReal), pointer :: temp, temp_iter
+ type (field2DReal), pointer :: top_iter
+ real (kind=RKIND), dimension(:,:), pointer :: top
+ real (kind=RKIND), dimension(:), pointer :: reduced
+ integer :: j, jend
+
+ ! allocate a temp for result
+ call create_1d_field_from_2d(stack(stack_pointer) % d2, temp)
+ temp_iter => temp
+
+ ! get pointers for computation
+ top_iter => stack(stack_pointer) % d2
+
+ ! initial value
+ reduced => temp_iter % array
+ temp_iter % array = &
+
+! 1-2 break
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_2d_2.inc b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_2d_2.inc
new file mode 100644
index 0000000000..c5341bf85f
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_2d_2.inc
@@ -0,0 +1,13 @@
+! 1-2 break
+
+ do while (associated(top_iter))
+ ! do operation
+ top => top_iter % array
+ reduced => temp_iter % array
+
+ jend = size(top, 2)
+
+ do j = 1, jend
+ temp_iter % array(j) = &
+
+! 2-3 break
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_2d_3.inc b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_2d_3.inc
new file mode 100644
index 0000000000..d776eda7e4
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_2d_3.inc
@@ -0,0 +1,17 @@
+! 2-3 break
+
+ end do
+
+ top_iter => top_iter % next
+ temp_iter => temp_iter % next
+ end do
+
+ ! clean up old
+ if (stack(stack_pointer) % symbol_type == IS_TEMPORARY) then
+ call mpas_deallocate_field(stack(stack_pointer) % d2)
+ end if
+
+ ! set stack
+ stack(stack_pointer) % d1 => temp
+ stack(stack_pointer) % symbol_type = IS_TEMPORARY
+ stack(stack_pointer) % number_of_dims = 1
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_dispatch.F b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_dispatch.F
new file mode 100644
index 0000000000..33a77816c0
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_dispatch.F
@@ -0,0 +1,42 @@
+ integer, intent(in) :: exp_number
+ logical, intent(in) :: type_checking
+
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+
+ integer :: a_nd
+ character (len=StrKIND) :: op_name
+
+! start -> 1d
+
+ if (type_checking) then
+ ! check size of stack
+ if (stack_pointer < 1) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'expression #' // trim(expression_names(exp_number)) // &
+ ' tried to ' // trim(op_name) // ' when there ' // &
+ 'were no operands on the stack, in the RPN calculator AM')
+ end if
+ end if
+
+ a_nd = stack(stack_pointer) % number_of_dims
+
+ if (type_checking) then
+ if (a_nd < 1) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'expression #' // trim(expression_names(exp_number)) // &
+ ' tried to ' // trim(op_name) // ' when the ' // &
+ 'operand on the stack is 0d, in the RPN calculator AM')
+ end if
+ end if
+
+ ! call the right one
+ if (a_nd == 1) then
+
+! 1d -> 2d
+
+ else
+
+! 2d -> end
+
+ end if
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_dispatch_1d.inc b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_dispatch_1d.inc
new file mode 100644
index 0000000000..8f7f9aa4a4
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_dispatch_1d.inc
@@ -0,0 +1,27 @@
+! start -> 1d
+
+ if (type_checking) then
+ ! check size of stack
+ if (stack_pointer < 1) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'expression #' // trim(expression_names(exp_number)) // &
+ ' tried to ' // trim(op_name) // ' when there ' // &
+ 'were no operands on the stack, in the RPN calculator AM')
+ end if
+ end if
+
+ a_nd = stack(stack_pointer) % number_of_dims
+
+ if (type_checking) then
+ if (a_nd < 1) then
+ call mpas_dmpar_global_abort(trim(MPAS_CORE_NAME) // ' ERROR: ' // &
+ 'expression #' // trim(expression_names(exp_number)) // &
+ ' tried to ' // trim(op_name) // ' when the ' // &
+ 'operand on the stack is 0d, in the RPN calculator AM')
+ end if
+ end if
+
+ ! call the right one
+ if (a_nd == 1) then
+
+! 1d -> 2d
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_dispatch_2d.inc b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_dispatch_2d.inc
new file mode 100644
index 0000000000..8627dc85b9
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_dispatch_2d.inc
@@ -0,0 +1,5 @@
+! 1d -> 2d
+
+ else
+
+! 2d -> end
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_dispatch_end.inc b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_dispatch_end.inc
new file mode 100644
index 0000000000..880e8f5b4a
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_dispatch_end.inc
@@ -0,0 +1,3 @@
+! 2d -> end
+
+ end if
diff --git a/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_dispatch_start.inc b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_dispatch_start.inc
new file mode 100644
index 0000000000..6634eda3d5
--- /dev/null
+++ b/src/core_ocean/analysis_members/rpn_calc_inc/reduce_op_dispatch_start.inc
@@ -0,0 +1,10 @@
+ integer, intent(in) :: exp_number
+ logical, intent(in) :: type_checking
+
+ type (rpn_stack_value_type), dimension(MAX_STACK_SIZE), intent(inout) :: stack
+ integer, intent(inout) :: stack_pointer
+
+ integer :: a_nd
+ character (len=StrKIND) :: op_name
+
+! start -> 1d
diff --git a/src/core_ocean/build_options.mk b/src/core_ocean/build_options.mk
index 8c6c25a7c7..fd70ba46d8 100644
--- a/src/core_ocean/build_options.mk
+++ b/src/core_ocean/build_options.mk
@@ -3,7 +3,11 @@ ifeq "$(ROOT_DIR)" ""
endif
EXE_NAME=ocean_model
NAMELIST_SUFFIX=ocean
-FCINCLUDES += -I$(ROOT_DIR)/core_ocean/driver -I$(ROOT_DIR)/core_ocean/mode_forward -I$(ROOT_DIR)/core_ocean/mode_analysis -I$(ROOT_DIR)/core_ocean/shared -I$(ROOT_DIR)/core_ocean/analysis_members -I$(ROOT_DIR)/core_ocean/cvmix
+FCINCLUDES += -I$(ROOT_DIR)/core_ocean/driver
+FCINCLUDES += -I$(ROOT_DIR)/core_ocean/mode_forward -I$(ROOT_DIR)/core_ocean/mode_analysis -I$(ROOT_DIR)/core_ocean/mode_init
+FCINCLUDES += -I$(ROOT_DIR)/core_ocean/shared -I$(ROOT_DIR)/core_ocean/analysis_members
+FCINCLUDES += -I$(ROOT_DIR)/core_ocean/cvmix
+FCINCLUDES += -I$(ROOT_DIR)/core_ocean/BGC
override CPPFLAGS += -DCORE_OCEAN
report_builds:
diff --git a/src/core_ocean/driver/mpas_ocn_core.F b/src/core_ocean/driver/mpas_ocn_core.F
index eedc9734c5..25c20bf1b2 100644
--- a/src/core_ocean/driver/mpas_ocn_core.F
+++ b/src/core_ocean/driver/mpas_ocn_core.F
@@ -28,9 +28,11 @@ module ocn_core
use mpas_dmpar
use mpas_timer
use mpas_io_units
+ use mpas_threading
use ocn_forward_mode
use ocn_analysis_mode
+ use ocn_init_mode
implicit none
private
@@ -59,15 +61,26 @@ function ocn_core_init(domain, startTimeStamp) result(ierr)!{{{
integer :: ierr
character (len=StrKIND), pointer :: config_ocean_run_mode
+ integer :: numThreads
ierr = 0
call mpas_pool_get_config(domain % configs, 'config_ocean_run_mode', config_ocean_run_mode)
+ numThreads = mpas_threading_get_max_threads()
+
+ write(stderrUnit, *) ''
+ write(stderrUnit, *) ' *****************************************************************************'
+ write(stderrUnit, *) ' MPI Task ', domain % dminfo % my_proc_id, ' has access to ', numThreads, ' threads'
+ write(stderrUnit, *) ' *****************************************************************************'
+ write(stderrUnit, *) ''
+
if ( trim(config_ocean_run_mode) == 'forward' ) then
ierr = ocn_forward_mode_init(domain, startTimeStamp)
else if ( trim(config_ocean_run_mode) == 'analysis' ) then
ierr = ocn_analysis_mode_init(domain, startTimeStamp)
+ else if ( trim(config_ocean_run_mode) == 'init' ) then
+ ierr = ocn_init_mode_init(domain, startTimeStamp)
end if
end function ocn_core_init!}}}
@@ -101,6 +114,8 @@ function ocn_core_run(domain) result(iErr)!{{{
ierr = ocn_forward_mode_run(domain)
else if ( trim(config_ocean_run_mode) == 'analysis' ) then
ierr = ocn_analysis_mode_run(domain)
+ else if ( trim(config_ocean_run_mode) == 'init' ) then
+ ierr = ocn_init_mode_run(domain)
end if
end function ocn_core_run!}}}
@@ -132,6 +147,8 @@ function ocn_core_finalize(domain) result(ierr)!{{{
ierr = ocn_forward_mode_finalize(domain)
else if (trim(config_ocean_run_mode) == 'analysis' ) then
ierr = ocn_analysis_mode_finalize(domain)
+ else if (trim(config_ocean_run_mode) == 'init' ) then
+ ierr = ocn_init_mode_finalize(domain)
end if
end function ocn_core_finalize!}}}
diff --git a/src/core_ocean/driver/mpas_ocn_core_interface.F b/src/core_ocean/driver/mpas_ocn_core_interface.F
index 04e01260bb..4fcffaeb87 100644
--- a/src/core_ocean/driver/mpas_ocn_core_interface.F
+++ b/src/core_ocean/driver/mpas_ocn_core_interface.F
@@ -17,6 +17,7 @@ module ocn_core_interface
use ocn_forward_mode
use ocn_analysis_mode
+ use ocn_init_mode
private
@@ -30,7 +31,7 @@ module ocn_core_interface
!> \brief Ocean core setup routine
!> \author Doug Jacobsen
!> \date 03/18/2015
- !> \details
+ !> \details
!> This routine is intended to setup the necessary variables within a core_type
!> for the ocean core.
!
@@ -66,7 +67,7 @@ end subroutine ocn_setup_core!}}}
!> \brief Ocean domain setup routine
!> \author Doug Jacobsen
!> \date 03/18/2015
- !> \details
+ !> \details
!> This routine is intended to setup the necessary variables within a domain_type
!> for the ocean core.
!
@@ -86,7 +87,7 @@ end subroutine ocn_setup_domain!}}}
!> \brief Pacakge setup routine
!> \author Doug Jacobsen
!> \date 03/12/2015
- !> \details
+ !> \details
!> This function is intended to correctly configure the packages for this MPAS
!> core. It can use any Fortran logic to properly configure packages, and it
!> can also make use of any namelist options. All variables in the model are
@@ -105,73 +106,280 @@ function ocn_setup_packages(configPool, packagePool, iocontext) result(ierr)!{{{
integer :: err_tmp
- logical, pointer :: forwardModeActive, analysisModeActive
+ logical, pointer :: forwardModeActive
+ logical, pointer :: analysisModeActive
+ logical, pointer :: initModeActive
logical, pointer :: thicknessFilterActive
logical, pointer :: splitTimeIntegratorActive
- logical, pointer :: surfaceRestoringActive
- logical, pointer :: bulkForcingActive
+ logical, pointer :: windStressBulkPKGActive
+ logical, pointer :: landIceFluxesPKGActive
+ logical, pointer :: landIceCouplingPKGActive
+ logical, pointer :: thicknessBulkPKGActive
logical, pointer :: frazilIceActive
logical, pointer :: inSituEOSActive
+ logical, pointer :: restartForcingFieldsActive
+ logical, pointer :: variableShortwaveActive
+
+ type (mpas_pool_iterator_type) :: pkgItr
+ logical, pointer :: packageActive
+
+ logical, pointer :: tracerGroupPKGActive
+ logical, pointer :: tracerGroupBulkRestoringPKGActive
+ logical, pointer :: tracerGroupSurfaceRestoringPKGActive
+ logical, pointer :: tracerGroupInteriorRestoringPKGActive
+ logical, pointer :: tracerGroupExponentialDecayPKGActive
+ logical, pointer :: tracerGroupIdealAgePKGActive
+ logical, pointer :: tracerGroupTTDPKGActive
+
+ logical, pointer :: config_use_tracerGroup
+ logical, pointer :: config_use_tracerGroup_surface_bulk_forcing
+ logical, pointer :: config_use_tracerGroup_surface_restoring
+ logical, pointer :: config_use_tracerGroup_interior_restoring
+ logical, pointer :: config_use_tracerGroup_exponential_decay
+ logical, pointer :: config_use_tracerGroup_idealAge_forcing
+ logical, pointer :: config_use_tracerGroup_ttd_forcing
+
+ logical, pointer :: config_restart_forcing_fields
logical, pointer :: config_use_freq_filtered_thickness
- logical, pointer :: config_frazil_ice_formation
- character (len=StrKIND), pointer :: config_time_integrator, config_forcing_type
- character (len=StrKIND), pointer :: config_ocean_run_mode, config_pressure_gradient_type
+ logical, pointer :: config_use_frazil_ice_formation
+ character (len=StrKIND), pointer :: config_time_integrator
+ character (len=StrKIND), pointer :: config_ocean_run_mode
+ character (len=StrKIND), pointer :: config_pressure_gradient_type
+ character (len=StrKIND), pointer :: config_sw_absorption_type
- ! Get Packages
- call mpas_pool_get_package(packagePool, 'forwardModeActive', forwardModeActive)
- call mpas_pool_get_package(packagePool, 'analysisModeActive', analysisModeActive)
- call mpas_pool_get_package(packagePool, 'thicknessFilterActive', thicknessFilterActive)
- call mpas_pool_get_package(packagePool, 'splitTimeIntegratorActive', splitTimeIntegratorActive)
- call mpas_pool_get_package(packagePool, 'surfaceRestoringActive', surfaceRestoringActive)
- call mpas_pool_get_package(packagePool, 'bulkForcingActive', bulkForcingActive)
- call mpas_pool_get_package(packagePool, 'frazilIceActive', frazilIceActive)
- call mpas_pool_get_package(packagePool, 'inSituEOSActive', inSituEOSActive)
+ logical, pointer :: config_use_bulk_wind_stress
+ logical, pointer :: config_use_bulk_thickness_flux
+ character (len=StrKIND), pointer :: config_land_ice_flux_mode
- call mpas_pool_get_config(configPool, 'config_ocean_run_mode', config_ocean_run_mode)
+ type (mpas_pool_iterator_type) :: groupItr
+ character (len=StrKIND) :: tracerGroupName, configName, packageName
+ integer :: startIndex, strLen
ierr = 0
+ !
+ ! determine the mode being used
+ !
+ call mpas_pool_get_package(packagePool, 'forwardModeActive', forwardModeActive)
+ call mpas_pool_get_package(packagePool, 'analysisModeActive', analysisModeActive)
+ call mpas_pool_get_package(packagePool, 'initModeActive', initModeActive)
+ call mpas_pool_get_config(configPool, 'config_ocean_run_mode', config_ocean_run_mode)
+
if ( trim(config_ocean_run_mode) == 'forward' ) then
forwardModeActive = .true.
+ endif
+ if ( trim(config_ocean_run_mode) == 'analysis') then
+ analysisModeActive = .true.
+ endif
+ if ( trim(config_ocean_run_mode) == 'init') then
+ initModeActive = .true.
+ endif
+
+ !
+ ! test for integration scheme
+ ! (TDR: this makes no sense, if split or unsplit then splitTimeIntegratorActive = .true.)
+ !
+ call mpas_pool_get_package(packagePool, 'splitTimeIntegratorActive', splitTimeIntegratorActive)
+ call mpas_pool_get_config(configPool, 'config_time_integrator', config_time_integrator)
+ if ( forwardModeActive ) then
+ if ( config_time_integrator == trim('split_explicit') &
+ .or. config_time_integrator == trim('unsplit_explicit') ) then
+ splitTimeIntegratorActive = .true.
+ end if
+ endif
- call mpas_pool_get_config(configPool, 'config_use_freq_filtered_thickness', config_use_freq_filtered_thickness)
- call mpas_pool_get_config(configPool, 'config_time_integrator', config_time_integrator)
- call mpas_pool_get_config(configPool, 'config_forcing_type', config_forcing_type)
- call mpas_pool_get_config(configPool, 'config_frazil_ice_formation', config_frazil_ice_formation)
- call mpas_pool_get_config(configPool, 'config_pressure_gradient_type', config_pressure_gradient_type)
-
+ !
+ ! test for time filtering scheme
+ !
+ call mpas_pool_get_package(packagePool, 'thicknessFilterActive', thicknessFilterActive)
+ call mpas_pool_get_config(configPool, 'config_use_freq_filtered_thickness', config_use_freq_filtered_thickness)
+ if ( forwardModeActive ) then
if (config_use_freq_filtered_thickness) then
thicknessFilterActive = .true.
end if
+ endif
+
+ !
+ ! test for bulk forcing of layer thickness, thicknessBulkPKG
+ !
+ call mpas_pool_get_package(packagePool, 'thicknessBulkPKGActive', thicknessBulkPKGActive)
+ call mpas_pool_get_config(configPool, 'config_use_bulk_thickness_flux', config_use_bulk_thickness_flux)
+ if ( config_use_bulk_thickness_flux ) then
+ thicknessBulkPKGActive = .true.
+ end if
- if (config_time_integrator == trim('split_explicit') &
- .or. config_time_integrator == trim('unsplit_explicit') ) then
+ !
+ ! test for bulk forcing of momentum by wind stress, windStressBulkPKG
+ !
+ call mpas_pool_get_package(packagePool, 'windStressBulkPKGActive', windStressBulkPKGActive)
+ call mpas_pool_get_config(configPool, 'config_use_bulk_wind_stress', config_use_bulk_wind_stress)
+ if ( config_use_bulk_wind_stress ) then
+ windStressBulkPKGActive = .true.
+ end if
- splitTimeIntegratorActive = .true.
- end if
+ !
+ ! Test if chlorophyll, solar zenith angle, and clear sky radiation should
+ ! be used
+ !
- if (config_forcing_type == trim('restoring')) then
- surfaceRestoringActive = .true.
- else if (config_forcing_type == trim('bulk')) then
- bulkForcingActive = .true.
- end if
+ call mpas_pool_get_package(packagePool,'variableShortwaveActive',variableShortwaveActive)
+ call mpas_pool_get_config(configPool,'config_sw_absorption_type',config_sw_absorption_type)
+ if (trim (config_sw_absorption_type) == 'ohlmann00') then
+ variableShortwaveActive = .true.
+ end if
- if (config_frazil_ice_formation) then
- frazilIceActive = .true.
- end if
+ !
+ ! test for land ice fluxes, landIceFluxesPKG
+ ! test for land ice coupling, landIceCouplingPKG
+ !
+ call mpas_pool_get_package(packagePool, 'landIceFluxesPKGActive', landIceFluxesPKGActive)
+ call mpas_pool_get_package(packagePool, 'landIceCouplingPKGActive', landIceCouplingPKGActive)
+ call mpas_pool_get_config(configPool, 'config_land_ice_flux_mode', config_land_ice_flux_mode)
+ if ( trim(config_land_ice_flux_mode) == 'standalone' ) then
+ landIceFluxesPKGActive = .true.
+ else if ( trim(config_land_ice_flux_mode) == 'coupled' ) then
+ landIceFluxesPKGActive = .true.
+ landIceCouplingPKGActive = .true.
+ end if
- if (config_pressure_gradient_type.eq.'Jacobian_from_TS') then
- inSituEOSActive = .true.
- end if
+ !
+ ! test for use of frazil ice formation, frazilIceActive
+ !
+ call mpas_pool_get_package(packagePool, 'frazilIceActive', frazilIceActive)
+ call mpas_pool_get_config(configPool, 'config_use_frazil_ice_formation', config_use_frazil_ice_formation)
+ if (config_use_frazil_ice_formation) then
+ frazilIceActive = .true.
+ end if
- call ocn_analysis_setup_packages(configPool, packagePool, err_tmp)
- ierr = ior(ierr, err_tmp)
- else if (trim(config_ocean_run_mode) == 'analysis' ) then
- analysisModeActive = .true.
- call ocn_analysis_setup_packages(configPool, packagePool, ierr)
+ !
+ ! test for form of pressure gradient computation
+ !
+ ! TDR: need to add PKG
+ call mpas_pool_get_package(packagePool, 'inSituEOSActive', inSituEOSActive)
+ call mpas_pool_get_config(configPool, 'config_pressure_gradient_type', config_pressure_gradient_type)
+ if (config_pressure_gradient_type.eq.'Jacobian_from_TS') then
+ inSituEOSActive = .true.
end if
+ !
+ ! test for restart of forcing fields
+ !
+ call mpas_pool_get_package(packagePool, 'restartForcingFieldsActive', restartForcingFieldsActive)
+ call mpas_pool_get_config(configPool, 'config_restart_forcing_fields', config_restart_forcing_fields)
+ if ( config_restart_forcing_fields ) then
+ restartForcingFieldsActive = .true.
+ end if
+
+ !
+ ! call into analysis member driver to set analysis member packages
+ !
+ call ocn_analysis_setup_packages(configPool, packagePool, iocontext, err_tmp)
+ ierr = ior(ierr, err_tmp)
+
+
+ !
+ ! if in init mode, validate configuration
+ !
+ if ( initModeActive ) then
+ call ocn_init_mode_validate_configuration(configPool, packagePool, iocontext, ierr)
+ endif
+
+ !
+ ! iterate over tracer groups
+ ! each tracer group is toggleed on/off using packages
+ ! test each package
+ !
+ call mpas_pool_begin_iteration(packagePool)
+ do while ( mpas_pool_get_next_member(packagePool, groupItr) )
+ startIndex = index(groupItr % memberName, 'TracersPKG')
+ if ( startIndex .ne. 0 ) then
+ strLen = len_trim(groupItr % memberName)
+ tracerGroupName = groupItr % memberName(1:strLen-9)
+
+ configName = 'config_use_' // trim(tracerGroupName)
+ call mpas_pool_get_config(configPool, configName, config_use_tracerGroup)
+ if ( config_use_tracerGroup ) then
+ packageName = trim(tracerGroupName) // 'PKGActive'
+ call mpas_pool_get_package(packagePool, packageName, tracerGroupPKGActive)
+ tracerGroupPKGActive = .true.
+
+ configName = 'config_use_' // trim(tracerGroupName) // '_surface_bulk_forcing'
+ call mpas_pool_get_config(configPool, configName, config_use_tracerGroup_surface_bulk_forcing)
+
+ if ( config_use_tracerGroup_surface_bulk_forcing ) then
+ packageName = trim(tracerGroupName) // 'BulkRestoringPKGActive'
+ call mpas_pool_get_package(packagePool, packageName, tracerGroupBulkRestoringPKGActive)
+ tracerGroupBulkRestoringPKGActive = .true.
+ end if
+
+ configName = 'config_use_' // trim(tracerGroupName) // '_surface_restoring'
+ call mpas_pool_get_config(configPool, configName, config_use_tracerGroup_surface_restoring)
+
+ if ( config_use_tracerGroup_surface_restoring ) then
+ packageName = trim(tracerGroupName) // 'SurfaceRestoringPKGActive'
+ call mpas_pool_get_package(packagePool, packageName, tracerGroupSurfaceRestoringPKGActive)
+ tracerGroupSurfaceRestoringPKGActive = .true.
+ end if
+
+ configName = 'config_use_' // trim(tracerGroupName) // '_interior_restoring'
+ call mpas_pool_get_config(configPool, configName, config_use_tracerGroup_interior_restoring)
+ if ( config_use_tracerGroup_interior_restoring ) then
+ packageName = trim(tracerGroupName) // 'InteriorRestoringPKGActive'
+ call mpas_pool_get_package(packagePool, packageName, tracerGroupInteriorRestoringPKGActive)
+ tracerGroupInteriorRestoringPKGActive = .true.
+ end if
+
+ configName = 'config_use_' // trim(tracerGroupName) // '_exponential_decay'
+ call mpas_pool_get_config(configPool, configName, config_use_tracerGroup_exponential_decay)
+ if ( config_use_tracerGroup_exponential_decay ) then
+ packageName = trim(tracerGroupName) // 'ExponentialDecayPKGActive'
+ call mpas_pool_get_package(packagePool, packageName, tracerGroupExponentialDecayPKGActive)
+ tracerGroupExponentialDecayPKGActive = .true.
+ end if
+
+ configName = 'config_use_' // trim(tracerGroupName) // '_idealAge_forcing'
+ call mpas_pool_get_config(configPool, configName, config_use_tracerGroup_idealAge_forcing)
+ if ( config_use_tracerGroup_idealAge_forcing ) then
+ packageName = trim(tracerGroupName) // 'IdealAgePKGActive'
+ call mpas_pool_get_package(packagePool, packageName, tracerGroupIdealAgePKGActive)
+ tracerGroupIdealAgePKGActive = .true.
+ end if
+
+ configName = 'config_use_' // trim(tracerGroupName) // '_ttd_forcing'
+ call mpas_pool_get_config(configPool, configName, config_use_tracerGroup_ttd_forcing)
+ if ( config_use_tracerGroup_ttd_forcing ) then
+ packageName = trim(tracerGroupName) // 'TTDPKGActive'
+ call mpas_pool_get_package(packagePool, packageName, tracerGroupTTDPKGActive)
+ tracerGroupTTDPKGActive = .true.
+ end if
+ end if
+ end if
+ end do
+
+ !
+ ! test for conflicts, i.e. package settings that are inconsistent in combination
+ !
+
+
+
+ write(stderrUnit, *) ''
+ write(stderrUnit, *) ' **** Summary of ocean packages ****'
+ call mpas_pool_begin_iteration(packagePool)
+ do while ( mpas_pool_get_next_member(packagePool, pkgItr) )
+
+ if ( pkgItr % memberType == MPAS_POOL_PACKAGE ) then
+ call mpas_pool_get_package(packagePool, pkgItr % memberName, packageActive)
+ if ( packageActive ) then
+ write(stderrUnit, *) ' ' // trim(pkgItr % memberName) // ' = ON'
+ else
+ write(stderrUnit, *) ' ' // trim(pkgItr % memberName) // ' = OFF'
+ end if
+ end if
+ end do
+ write(stderrUnit, *) ' ***********************************'
+ write(stderrUnit, *) ''
+
end function ocn_setup_packages!}}}
@@ -182,7 +390,7 @@ end function ocn_setup_packages!}}}
!> \brief Decomposition setup routine
!> \author Doug Jacobsen
!> \date 04/08/2015
- !> \details
+ !> \details
!> This routine is intended to create the decomposition list within a
!> domain type, and register any decompositons the core wants within it.
!
@@ -221,12 +429,12 @@ end function ocn_setup_decompositions!}}}
!> \brief Pacakge setup routine
!> \author Michael Duda
!> \date 6 August 2014
- !> \details
+ !> \details
!> The purpose of this function is to allow the core to set up a simulation
!> clock that will be used by the I/O subsystem for timing reads and writes
!> of I/O streams.
- !> This function is called from the superstructure after the framework
- !> has been initialized but before any fields have been allocated and
+ !> This function is called from the superstructure after the framework
+ !> has been initialized but before any fields have been allocated and
!> initial fields have been read from input files. However, all namelist
!> options are available.
!
@@ -249,6 +457,8 @@ function ocn_setup_clock(core_clock, configs) result(ierr)!{{{
ierr = ocn_forward_mode_setup_clock(core_clock, configs)
else if ( trim(config_ocean_run_mode) == 'analysis' ) then
ierr = ocn_analysis_mode_setup_clock(core_clock, configs)
+ else if ( trim(config_ocean_run_mode) == 'init' ) then
+ ierr = ocn_init_mode_setup_clock(core_clock, configs)
end if
@@ -262,10 +472,10 @@ end function ocn_setup_clock!}}}
!> \brief Returns the name of the stream containing mesh information
!> \author Michael Duda
!> \date 8 August 2014
- !> \details
+ !> \details
!> This function returns the name of the I/O stream containing dimensions,
- !> attributes, and mesh fields needed by the framework bootstrapping
- !> routine. At the time this routine is called, only namelist options
+ !> attributes, and mesh fields needed by the framework bootstrapping
+ !> routine. At the time this routine is called, only namelist options
!> are available.
!
!-----------------------------------------------------------------------
@@ -289,6 +499,8 @@ function ocn_get_mesh_stream(configs, stream) result(ierr)!{{{
if ( trim(config_ocean_run_mode) == 'forward' .or. trim(config_ocean_run_mode) == 'analysis' ) then
write(stream,'(a)') 'mesh'
+ else if ( trim(config_ocean_run_mode) == 'init' ) then
+ write(stream,'(a)') 'input_init'
end if
end function ocn_get_mesh_stream!}}}
@@ -301,7 +513,7 @@ end function ocn_get_mesh_stream!}}}
!> \brief Ocean block setup function
!> \author Doug Jacobsen
!> \date 03/18/2015
- !> \details
+ !> \details
!> This function is a wrapper function to properly setup a block to be a
!> ocean core block.
!
diff --git a/src/core_ocean/get_BGC.sh b/src/core_ocean/get_BGC.sh
new file mode 100755
index 0000000000..26b0c05c42
--- /dev/null
+++ b/src/core_ocean/get_BGC.sh
@@ -0,0 +1,103 @@
+#!/bin/bash
+
+## BGC Tag for build
+BGC_TAG=8c0f6c5
+
+## Subdirectory in BGC repo to use
+BGC_SUBDIR=.
+
+## Available protocols for acquiring BGC source code
+BGC_GIT_HTTP_ADDRESS=https://github.com/ACME-Climate/Ocean-BGC.git
+BGC_GIT_SSH_ADDRESS=git@github.com:ACME-Climate/Ocean-BGC.git
+BGC_SVN_ADDRESS=https://github.com/ACME-Climate/Ocean-BGC-src/tags
+BGC_WEB_ADDRESS=https://github.com/ACME-Climate/Ocean-BGC-src/archive
+
+GIT=`which git`
+SVN=`which svn`
+PROTOCOL=""
+
+# BGC exists. Need to make sure it's updated if it is git.
+# Otherwise, flush the directory to ensure it's updated.
+if [ -d BGC ]; then
+ unlink BGC
+
+ if [ -d .BGC_all/.git ]; then
+ cd .BGC_all
+ git fetch origin &> /dev/null
+ git checkout ${BGC_TAG} &> /dev/null
+ cd ../
+ ln -sf .BGC_all/${BGC_SUBDIR} BGC
+ else
+ rm -rf .BGC_all
+ fi
+fi
+
+# BGC Doesn't exist, need to acquire souce code
+# If might have been flushed from the above if, in the case where it was svn or wget that acquired the source.
+if [ ! -d BGC ]; then
+ if [ -d .BGC_all ]; then
+ rm -rf .BGC_all
+ fi
+
+ if [ "${GIT}" != "" ]; then
+ echo " ** Using git to acquire BGC source. ** "
+ PROTOCOL="git ssh"
+ git clone ${BGC_GIT_SSH_ADDRESS} .BGC_all &> /dev/null
+ if [ -d .BGC_all ]; then
+ cd .BGC_all
+ git checkout ${BGC_TAG} &> /dev/null
+ cd ../
+ ln -sf .BGC_all/${BGC_SUBDIR} BGC
+ else
+ git clone ${BGC_GIT_HTTP_ADDRESS} .BGC_all &> /dev/null
+ PROTOCOL="git http"
+ if [ -d .BGC_all ]; then
+ cd .BGC_all
+ git checkout ${BGC_TAG} &> /dev/null
+ cd ../
+ ln -sf .BGC_all/${BGC_SUBDIR} BGC
+ fi
+ fi
+ elif [ "${SVN}" != "" ]; then
+ echo " ** Using svn to acquire BGC source. ** "
+ PROTOCOL="svn"
+ svn co ${BGC_SVN_ADDRESS}/${BGC_TAG} .BGC_all &> /dev/null
+ ln -sf .BGC_all/${BGC_SUBDIR} BGC
+ else
+ echo " ** Using wget to acquire BGC source. ** "
+ PROTOCOL="svn"
+ BGC_ZIP_DIR=`echo ${BGC_TAG} | sed 's/v//g'`
+ BGC_ZIP_DIR="BGC-src-${BGC_ZIP_DIR}"
+ if [ ! -e .${BGC_TAG}.zip ]; then
+ wget ${BGC_WEB_ADDRESS}/${BGC_TAG}.zip &> /dev/null
+ fi
+ unzip ${BGC_TAG}.zip &> /dev/null
+ mv ${BGC_TAG}.zip .${BGC_TAG}.zip
+ mv ${BGC_ZIP_DIR} .BGC_all
+ ln -sf .BGC_all/${BGC_SUBDIR} BGC
+ fi
+fi
+
+if [ ! -d BGC ]; then
+ echo " ****************************************************** "
+ echo " ERROR: Build failed to acquire BGC source."
+ echo ""
+ echo " Please ensure your proxy information is setup properly for"
+ echo " the protocol you use to acquire BGC."
+ echo ""
+ echo " The automated script attempted to use: ${PROTOCOL}"
+ echo ""
+ if [ "${PROTOCOL}" == "git http" ]; then
+ echo " This protocol requires setting up the http.proxy git config option."
+ elif [ "${PROTOCOL}" == "git ssh" ]; then
+ echo " This protocol requires having ssh-keys setup, and ssh access to git@github.com."
+ echo " Please use 'ssh -vT git@github.com' to debug issues with ssh keys."
+ elif [ "${PROTOCOL}" == "svn" ]; then
+ echo " This protocol requires having svn proxys setup properly in ~/.subversion/servers."
+ elif [ "${PROTOCOL}" == "wget" ]; then
+ echo " This protocol requires having the http_proxy and https_proxy environment variables"
+ echo " setup properly for your shell."
+ fi
+ echo ""
+ echo " ****************************************************** "
+fi
diff --git a/src/core_ocean/get_cvmix.sh b/src/core_ocean/get_cvmix.sh
index 736a43623c..f2807c738c 100755
--- a/src/core_ocean/get_cvmix.sh
+++ b/src/core_ocean/get_cvmix.sh
@@ -41,16 +41,16 @@ if [ ! -d cvmix ]; then
if [ "${GIT}" != "" ]; then
echo " ** Using git to acquire cvmix source. ** "
- PROTOCOL="git https"
- git clone ${CVMIX_GIT_HTTP_ADDRESS} .cvmix_all &> /dev/null
+ PROTOCOL="git ssh"
+ git clone ${CVMIX_GIT_SSH_ADDRESS} .cvmix_all &> /dev/null
if [ -d .cvmix_all ]; then
cd .cvmix_all
git checkout ${CVMIX_TAG} &> /dev/null
cd ../
ln -sf .cvmix_all/${CVMIX_SUBDIR} cvmix
else
- git clone ${CVMIX_GIT_SSH_ADDRESS} .cvmix_all &> /dev/null
- PROTOCOL="git ssh"
+ git clone ${CVMIX_GIT_HTTP_ADDRESS} .cvmix_all &> /dev/null
+ PROTOCOL="git http"
if [ -d .cvmix_all ]; then
cd .cvmix_all
git checkout ${CVMIX_TAG} &> /dev/null
diff --git a/src/core_ocean/mode_analysis/mpas_ocn_analysis_mode.F b/src/core_ocean/mode_analysis/mpas_ocn_analysis_mode.F
index 9508f4d802..1070d58abe 100644
--- a/src/core_ocean/mode_analysis/mpas_ocn_analysis_mode.F
+++ b/src/core_ocean/mode_analysis/mpas_ocn_analysis_mode.F
@@ -36,7 +36,6 @@ module ocn_analysis_mode
use ocn_diagnostics
use ocn_equation_of_state
use ocn_constants
- use ocn_time_average
private
@@ -73,7 +72,9 @@ function ocn_analysis_mode_init(domain, startTimeStamp) result(ierr)!{{{
! remove dt later
real (kind=RKIND) :: dt
- character (len=StrKIND), pointer :: xtime
+ character (len=StrKIND), pointer :: xtime, simulationStartTime
+ real (kind=RKIND), pointer :: daysSinceStartOfSim
+ type (MPAS_Time_type) :: xtime_timeType, simulationStartTime_timeType
type (MPAS_Time_Type) :: startTime
ierr = 0
@@ -120,10 +121,24 @@ function ocn_analysis_mode_init(domain, startTimeStamp) result(ierr)!{{{
call ocn_init_routines_block(block, dt, ierr)
if(ierr.eq.1) then
- call mpas_dmpar_global_abort('ERROR: An error was encountered in ocn_init_routines_block')
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: An error was encountered in ocn_init_routines_block')
endif
xtime = startTimeStamp
+
+ ! Set simulationStartTime only if that variable is not read from the restart file.
+ call mpas_pool_get_array(diagnosticsPool, 'simulationStartTime', simulationStartTime)
+ if (trim(simulationStartTime)=="no_date_available") then
+ simulationStartTime = startTimeStamp
+ end if
+
+ ! compute time since start of simulation, in days
+ call mpas_pool_get_array(diagnosticsPool, 'daysSinceStartOfSim',daysSinceStartOfSim)
+ call mpas_set_time(xtime_timeType, dateTimeString=xtime)
+ call mpas_set_time(simulationStartTime_timeType, dateTimeString=simulationStartTime)
+ call mpas_get_timeInterval(xtime_timeType - simulationStartTime_timeType,dt=daysSinceStartOfSim)
+ daysSinceStartOfSim = daysSinceStartOfSim*days_per_second
+
block => block % next
end do
@@ -205,6 +220,7 @@ function ocn_analysis_mode_run(domain) result(ierr)!{{{
integer :: err, ierr
type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: tracersPool
type (mpas_pool_type), pointer :: forcingPool
type (mpas_pool_type), pointer :: meshPool
type (mpas_pool_type), pointer :: diagnosticsPool
@@ -231,18 +247,19 @@ function ocn_analysis_mode_run(domain) result(ierr)!{{{
block_ptr => domain % blocklist
do while(associated(block_ptr))
call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool)
call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
- call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, 1)
+ call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, tracersPool, 1)
block_ptr => block_ptr % next
end do
call mpas_timer_stop("diagnostic solve")
if (config_write_output_on_startup) then
- call ocn_analysis_compute_startup(domain, err)
+ call ocn_analysis_compute_startup(domain, err)
call mpas_timer_start('io_write', .false.)
call mpas_stream_mgr_write(domain % streamManager, ierr=ierr)
call mpas_timer_stop('io_write')
diff --git a/src/core_ocean/mode_forward/mpas_ocn_forward_mode.F b/src/core_ocean/mode_forward/mpas_ocn_forward_mode.F
index 68ec3b430d..01a7d6111e 100644
--- a/src/core_ocean/mode_forward/mpas_ocn_forward_mode.F
+++ b/src/core_ocean/mode_forward/mpas_ocn_forward_mode.F
@@ -49,12 +49,20 @@ module ocn_forward_mode
use ocn_vel_hmix
use ocn_vel_forcing
use ocn_vel_coriolis
+ use ocn_vel_forcing_surface_stress
+ use ocn_surface_bulk_forcing
+ use ocn_surface_land_ice_fluxes
+ use ocn_frazil_forcing
use ocn_tracer_hmix
- use ocn_tracer_surface_flux
+ use ocn_tracer_surface_flux_to_tend
use ocn_tracer_short_wave_absorption
+ use ocn_tracer_short_wave_absorption_variable
use ocn_tracer_nonlocalflux
use ocn_tracer_advection
+ use ocn_tracer_ecosys
+ use ocn_tracer_DMS
+ use ocn_tracer_MacroMolecules
use ocn_gm
use ocn_high_freq_thickness_hmix_del2
@@ -63,8 +71,6 @@ module ocn_forward_mode
use ocn_vmix
- use ocn_time_average
-
use ocn_forcing
use ocn_sea_ice
@@ -107,11 +113,13 @@ function ocn_forward_mode_init(domain, startTimeStamp) result(ierr)!{{{
type (mpas_pool_type), pointer :: meshPool
type (mpas_pool_type), pointer :: diagnosticsPool
- character (len=StrKIND), pointer :: xtime
+ character (len=StrKIND), pointer :: xtime, simulationStartTime
+ real (kind=RKIND), pointer :: daysSinceStartOfSim
+ type (MPAS_Time_type) :: xtime_timeType, simulationStartTime_timeType
type (MPAS_Time_Type) :: startTime
type (MPAS_TimeInterval_type) :: timeStep
- logical, pointer :: config_do_restart, config_filter_btr_mode, config_conduct_tests
+ logical, pointer :: config_do_restart, config_read_nearest_restart, config_filter_btr_mode, config_conduct_tests
character (len=StrKIND), pointer :: config_vert_coord_movement, config_pressure_gradient_type
real (kind=RKIND), pointer :: config_maxMeshDensity
@@ -128,6 +136,7 @@ function ocn_forward_mode_init(domain, startTimeStamp) result(ierr)!{{{
call ocn_constants_init(domain % configs, domain % packages)
call mpas_pool_get_config(domain % configs, 'config_do_restart', config_do_restart)
+ call mpas_pool_get_config(domain % configs, 'config_read_nearest_restart', config_read_nearest_restart)
call mpas_pool_get_config(domain % configs, 'config_vert_coord_movement', config_vert_coord_movement)
call mpas_pool_get_config(domain % configs, 'config_pressure_gradient_type', config_pressure_gradient_type)
call mpas_pool_get_config(domain % configs, 'config_filter_btr_mode', config_filter_btr_mode)
@@ -139,11 +148,19 @@ function ocn_forward_mode_init(domain, startTimeStamp) result(ierr)!{{{
!
call mpas_timer_start('io_read')
call MPAS_stream_mgr_read(domain % streamManager, streamID='mesh', whence=MPAS_STREAM_NEAREST, ierr=err_tmp)
+
if ( config_do_restart ) then
- call MPAS_stream_mgr_read(domain % streamManager, streamID='restart', ierr=err_tmp)
+ if ( config_read_nearest_restart ) then
+ call MPAS_stream_mgr_read(domain % streamManager, streamID='restart', whence=MPAS_STREAM_NEAREST, ierr=err_tmp)
+ else
+ call MPAS_stream_mgr_read(domain % streamManager, streamID='restart', ierr=err_tmp)
+ end if
else
call MPAS_stream_mgr_read(domain % streamManager, streamID='input', ierr=err_tmp)
end if
+
+ call ocn_analysis_bootstrap(domain, err=err_tmp)
+
call mpas_timer_stop('io_read')
call mpas_timer_start('reset_io_alarms')
call mpas_stream_mgr_reset_alarms(domain % streamManager, streamID='input', ierr=err_tmp)
@@ -151,6 +168,16 @@ function ocn_forward_mode_init(domain, startTimeStamp) result(ierr)!{{{
call mpas_stream_mgr_reset_alarms(domain % streamManager, direction=MPAS_STREAM_OUTPUT, ierr=err_tmp)
call mpas_timer_stop('reset_io_alarms')
+ ! Read the remaining input streams
+ call mpas_timer_start('io_read', .false.)
+ call mpas_stream_mgr_read(domain % streamManager, ierr=err_tmp)
+ ierr = ior(ierr, err_tmp)
+ call mpas_timer_stop('io_read')
+ call mpas_timer_start('reset_io_alarms', .false.)
+ call mpas_stream_mgr_reset_alarms(domain % streamManager, direction=MPAS_STREAM_INPUT, ierr=err_tmp)
+ ierr = ior(ierr, err_tmp)
+ call mpas_timer_stop('reset_io_alarms')
+
! Initialize submodules before initializing blocks.
call ocn_timestep_init(ierr)
@@ -173,6 +200,14 @@ function ocn_forward_mode_init(domain, startTimeStamp) result(ierr)!{{{
ierr = ior(ierr, err_tmp)
call ocn_vel_forcing_init(err_tmp)
ierr = ior(ierr, err_tmp)
+ call ocn_vel_forcing_surface_stress_init(err_tmp)
+ ierr = ior(ierr, err_tmp)
+ call ocn_surface_bulk_forcing_init(err_tmp)
+ ierr = ior(ierr, err_tmp)
+ call ocn_surface_land_ice_fluxes_init(err_tmp)
+ ierr = ior(ierr, err_tmp)
+ call ocn_frazil_forcing_init(err_tmp)
+ ierr = ior(ierr, err_tmp)
call ocn_tracer_hmix_init(err_tmp)
ierr = ior(ierr, err_tmp)
@@ -180,12 +215,18 @@ function ocn_forward_mode_init(domain, startTimeStamp) result(ierr)!{{{
ierr = ior(ierr, err_tmp)
call ocn_tracer_advection_init(err_tmp)
ierr = ior(ierr,err_tmp)
- call ocn_tracer_short_wave_absorption_init(err_tmp)
+ call ocn_tracer_short_wave_absorption_init(domain,err_tmp)
ierr = ior(ierr,err_tmp)
call ocn_gm_init(err_tmp)
ierr = ior(ierr,err_tmp)
call ocn_tracer_nonlocalflux_init(err_tmp)
ierr = ior(ierr,err_tmp)
+ call ocn_tracer_ecosys_init(domain, err_tmp)
+ ierr = ior(ierr,err_tmp)
+ call ocn_tracer_DMS_init(domain, err_tmp)
+ ierr = ior(ierr,err_tmp)
+ call ocn_tracer_MacroMolecules_init(domain, err_tmp)
+ ierr = ior(ierr,err_tmp)
call ocn_vmix_init(domain, err_tmp)
ierr = ior(ierr, err_tmp)
@@ -208,11 +249,9 @@ function ocn_forward_mode_init(domain, startTimeStamp) result(ierr)!{{{
call ocn_sea_ice_init(nVertLevels, err_tmp)
ierr = ior(ierr, err_tmp)
- call ocn_analysis_init(domain, err_tmp)
- ierr = ior(ierr, err_tmp)
-
if(ierr.eq.1) then
- call mpas_dmpar_global_abort('ERROR: An error was encountered while initializing the MPAS-Ocean forward mode')
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: An error was encountered while initializing '// &
+ 'the MPAS-Ocean forward mode')
endif
call ocn_init_routines_vert_coord(domain)
@@ -228,23 +267,26 @@ function ocn_forward_mode_init(domain, startTimeStamp) result(ierr)!{{{
config_vert_coord_movement.ne.'impermeable_interfaces'.and. &
config_vert_coord_movement.ne.'user_specified') then
write (stderrUnit,*) ' Incorrect choice of config_vert_coord_movement.'
- call mpas_dmpar_global_abort('ERROR: Incorrect choice of config_vert_coord_movement.')
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: Incorrect choice of config_vert_coord_movement.')
endif
- if(config_vert_coord_movement .ne. 'impermeable_interfaces' .and. config_pressure_gradient_type .eq. 'MontgomeryPotential') then
+ if(config_vert_coord_movement .ne. 'impermeable_interfaces' .and. config_pressure_gradient_type &
+ .eq. 'MontgomeryPotential') then
write (stderrUnit,*) ' Incorrect combination of config_vert_coord_movement and config_pressure_gradient_type'
- call mpas_dmpar_global_abort('ERROR: Incorrect combination of config_vert_coord_movement and config_pressure_gradient_type')
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: Incorrect combination of config_vert_coord_movement and ' &
+ // 'config_pressure_gradient_type')
end if
if (config_filter_btr_mode.and. &
config_vert_coord_movement.ne.'fixed')then
write (stderrUnit,*) 'filter_btr_mode has only been tested with'// &
' config_vert_coord_movement=fixed.'
- call mpas_dmpar_global_abort('ERROR: filter_btr_mode has only been tested with config_vert_coord_movement=fixed.')
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: filter_btr_mode has only been tested '// &
+ 'with config_vert_coord_movement=fixed.')
endif
! find the maximum value of the meshDensity
- if (config_maxMeshDensity < 0.0) then
+ if (config_maxMeshDensity < 0.0_RKIND) then
maxDensity=-1
block => domain % blocklist
do while (associated(block))
@@ -266,13 +308,28 @@ function ocn_forward_mode_init(domain, startTimeStamp) result(ierr)!{{{
block => domain % blocklist
do while (associated(block))
call ocn_init_routines_block(block, dt, ierr)
+
if(ierr.eq.1) then
- call mpas_dmpar_global_abort('ERROR: An error was encountered in ocn_init_routines_block')
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: An error was encountered in ocn_init_routines_block')
endif
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_array(diagnosticsPool, 'xtime', xtime)
xtime = startTimeStamp
+
+ ! Set simulationStartTime only if that variable is not read from the restart file.
+ call mpas_pool_get_array(diagnosticsPool, 'simulationStartTime', simulationStartTime)
+ if (trim(simulationStartTime)=="no_date_available") then
+ simulationStartTime = startTimeStamp
+ end if
+
+ ! compute time since start of simulation, in days
+ call mpas_pool_get_array(diagnosticsPool, 'daysSinceStartOfSim',daysSinceStartOfSim)
+ call mpas_set_time(xtime_timeType, dateTimeString=xtime)
+ call mpas_set_time(simulationStartTime_timeType, dateTimeString=simulationStartTime)
+ call mpas_get_timeInterval(xtime_timeType - simulationStartTime_timeType,dt=daysSinceStartOfSim)
+ daysSinceStartOfSim = daysSinceStartOfSim*days_per_second
+
block => block % next
end do
@@ -282,6 +339,14 @@ function ocn_forward_mode_init(domain, startTimeStamp) result(ierr)!{{{
call mpas_timer_stop("test suite")
endif
+ call ocn_analysis_init(domain, err_tmp)
+ ierr = ior(ierr, err_tmp)
+
+ if(ierr.eq.1) then
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: An error was encountered while initializing ' &
+ // 'the analysis members in the MPAS-Ocean forward mode')
+ endif
+
end function ocn_forward_mode_init!}}}
!***********************************************************************
@@ -378,15 +443,20 @@ function ocn_forward_mode_run(domain) result(ierr)!{{{
type (mpas_pool_type), pointer :: meshPool
type (mpas_pool_type), pointer :: statePool
type (mpas_pool_type), pointer :: forcingPool
+ type (mpas_pool_type), pointer :: diagnosticsPool
+ type (mpas_pool_type), pointer :: scratchPool
+
type (MPAS_timeInterval_type) :: timeStep
- character(len=StrKIND), pointer :: config_restart_timestamp_name
+ character(len=StrKIND), pointer :: config_restart_timestamp_name, config_sw_absorption_type
+
logical, pointer :: config_write_output_on_startup
ierr = 0
call mpas_pool_get_config(domain % configs, 'config_write_output_on_startup', config_write_output_on_startup)
call mpas_pool_get_config(domain % configs, 'config_restart_timestamp_name', config_restart_timestamp_name)
+ call mpas_pool_get_config(domain % configs, 'config_sw_absorption_type', config_sw_absorption_type)
! Eventually, dt should be domain specific
timeStep = mpas_get_clock_timestep(domain % clock, ierr=ierr)
@@ -404,16 +474,16 @@ function ocn_forward_mode_run(domain) result(ierr)!{{{
call mpas_timer_stop('io_write')
endif
- block_ptr => domain % blocklist
- do while(associated(block_ptr))
- call mpas_pool_get_subpool(block_ptr % structs, 'average', averagePool)
- call ocn_time_average_init(averagePool)
- block_ptr => block_ptr % next
- end do
+ ! read initial data required for variable shortwave
+ call mpas_timer_start('io_shortwave',.false.)
+ call ocn_get_shortWaveData(domain % streamManager, domain, domain % clock, .true.)
+ call mpas_timer_stop('io_shortwave')
+
! During integration, time level 1 stores the model state at the beginning of the
! time step, and time level 2 stores the state advanced dt in time by timestep(...)
itimestep = 0
+
do while (.not. mpas_is_clock_stop_time(domain % clock))
call mpas_timer_start('io_read')
call mpas_stream_mgr_read(domain % streamManager, ierr=ierr)
@@ -434,24 +504,35 @@ function ocn_forward_mode_run(domain) result(ierr)!{{{
call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool)
- call ocn_forcing_build_arrays(meshPool, statePool, forcingPool, ierr, 1)
- call ocn_forcing_build_fraction_absorbed_array(meshPool, statePool, forcingpool, ierr, 1)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+ call ocn_forcing_build_fraction_absorbed_array(meshPool, statePool, diagnosticsPool, forcingPool, ierr, 1)
+ call mpas_timer_start("land_ice_build_arrays", .false.)
+ call ocn_surface_land_ice_fluxes_build_arrays(meshPool, diagnosticsPool, &
+ forcingPool, scratchPool, err)
+ call mpas_timer_stop("land_ice_build_arrays")
+
+ call ocn_frazil_forcing_build_arrays(domain, meshPool, forcingPool, diagnosticsPool, statePool, err)
+
block_ptr => block_ptr % next
end do
- call mpas_timer_start("time integration")
+ call mpas_timer_start("time integration", .false.)
+
+ !$omp parallel default(firstprivate) shared(domain, dt, timeStamp)
+
call ocn_timestep(domain, dt, timeStamp)
+
+ !$omp end parallel
+
call mpas_timer_stop("time integration")
! Move time level 2 fields back into time level 1 for next time step
- block_ptr => domain % blocklist
- do while(associated(block_ptr))
- call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
- call mpas_pool_shift_time_levels(statePool)
- block_ptr => block_ptr % next
- end do
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'state', statePool)
+ call mpas_pool_shift_time_levels(statePool)
- call ocn_analysis_compute(domain, err)
+ call ocn_analysis_compute(domain, err)
+ call ocn_analysis_restart(domain, err)
call ocn_analysis_write(domain, err)
call mpas_timer_start('io_write')
@@ -465,10 +546,15 @@ 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')
- if ( mpas_stream_mgr_ringing_alarms(domain % streamManager, streamID='restart', direction=MPAS_STREAM_OUTPUT, ierr=ierr) ) then
- open(22, file=config_restart_timestamp_name, form='formatted', status='replace')
- write(22, *) trim(timeStamp)
- close(22)
+ if ( mpas_stream_mgr_ringing_alarms(domain % streamManager, streamID='restart', direction=MPAS_STREAM_OUTPUT, &
+ ierr=ierr) ) then
+ if ( domain % dminfo % my_proc_id == 0 ) then
+ open(22, file=config_restart_timestamp_name, form='formatted', status='replace')
+ write(22, *) trim(timeStamp)
+ close(22)
+ end if
+
+ if(trim(config_sw_absorption_type)=='ohlmann00') call ocn_shortwave_forcing_write_restart(domain)
end if
call mpas_timer_start('reset_io_alarms')
@@ -481,7 +567,14 @@ function ocn_forward_mode_run(domain) result(ierr)!{{{
call mpas_timer_start('reset_io_alarms')
call mpas_stream_mgr_reset_alarms(domain % streamManager, direction=MPAS_STREAM_OUTPUT, ierr=ierr)
call mpas_timer_stop('reset_io_alarms')
+
+ ! read next time level data required for variable shortwave
+ call mpas_timer_start('io_shortwave',.false.)
+ call ocn_get_shortWaveData(domain % streamManager, domain, domain % clock, .false.)
+ call mpas_timer_stop('io_shortwave')
+
end do
+
end function ocn_forward_mode_run!}}}
!***********************************************************************
diff --git a/src/core_ocean/mode_forward/mpas_ocn_time_integration.F b/src/core_ocean/mode_forward/mpas_ocn_time_integration.F
index e4d280cde8..a2ca5ad122 100644
--- a/src/core_ocean/mode_forward/mpas_ocn_time_integration.F
+++ b/src/core_ocean/mode_forward/mpas_ocn_time_integration.F
@@ -23,6 +23,7 @@ module ocn_time_integration
use mpas_derived_types
use mpas_pool_routines
use mpas_constants
+ use mpas_timekeeping
use mpas_dmpar
use mpas_vector_reconstruction
use mpas_spline_interpolation
@@ -80,9 +81,9 @@ subroutine ocn_timestep(domain, dt, timeStamp)!{{{
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Advance model state forward in time by the specified time step
!
- ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:))
+ ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:))
! plus mesh meta-data
- ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains
+ ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains
! model state advanced forward in time by dt seconds
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -92,15 +93,17 @@ subroutine ocn_timestep(domain, dt, timeStamp)!{{{
real (kind=RKIND), intent(in) :: dt
character(len=*), intent(in) :: timeStamp
- real (kind=RKIND) :: nanCheck
-
type (dm_info) :: dminfo
type (block_type), pointer :: block
- type (mpas_pool_type), pointer :: diagnosticsPool, statePool
+ type (mpas_pool_type), pointer :: diagnosticsPool, statePool, meshPool
character (len=StrKIND), pointer :: xtime
- real (kind=RKIND), dimension(:,:), pointer :: normalVelocity
+ real (kind=RKIND), pointer :: daysSinceStartOfSim
+ character (len=StrKIND), pointer :: simulationStartTime
+ type (MPAS_Time_type) :: xtime_timeType, simulationStartTime_timeType
+ real (kind=RKIND) :: nanCheck
+ real (kind=RKIND), dimension(:, :), pointer :: normalVelocity
if (rk4On) then
@@ -113,17 +116,27 @@ subroutine ocn_timestep(domain, dt, timeStamp)!{{{
do while (associated(block))
call mpas_pool_get_subpool(block % structs, 'state', statePool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
- call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, 2)
call mpas_pool_get_array(diagnosticsPool, 'xtime', xtime)
xtime = timeStamp
- nanCheck = sum(normalVelocity)
+ ! compute time since start of simulation, in days
+ call mpas_pool_get_array(diagnosticsPool, 'simulationStartTime', simulationStartTime)
+ call mpas_pool_get_array(diagnosticsPool, 'daysSinceStartOfSim',daysSinceStartOfSim)
+ call mpas_set_time(xtime_timeType, dateTimeString=xtime)
+ call mpas_set_time(simulationStartTime_timeType, dateTimeString=simulationStartTime)
+ call mpas_get_timeInterval(xtime_timeType - simulationStartTime_timeType,dt=daysSinceStartOfSim)
+ daysSinceStartOfSim = daysSinceStartOfSim*days_per_second
+ !now test for NaNs in the ocean velocity field and abort if true
+ call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, 2)
+ call mpas_pool_get_array(diagnosticsPool, 'xtime', xtime)
+ nanCheck = sum(normalVelocity)
if (nanCheck /= nanCheck) then
- write(stderrUnit,*) 'Abort: NaN detected'
- call mpas_dmpar_abort(dminfo)
+ write(stderrUnit,*) 'Ocean Abort: NaN detected'
+ call mpas_dmpar_global_abort('MPAS-ocean: time_integration: NaN detected')
endif
block => block % next
diff --git a/src/core_ocean/mode_forward/mpas_ocn_time_integration_rk4.F b/src/core_ocean/mode_forward/mpas_ocn_time_integration_rk4.F
index 100d323b0a..f8a3f315c3 100644
--- a/src/core_ocean/mode_forward/mpas_ocn_time_integration_rk4.F
+++ b/src/core_ocean/mode_forward/mpas_ocn_time_integration_rk4.F
@@ -23,6 +23,7 @@ module ocn_time_integration_rk4
use mpas_pool_routines
use mpas_constants
use mpas_dmpar
+ use mpas_threading
use mpas_vector_reconstruction
use mpas_spline_interpolation
use mpas_timer
@@ -34,9 +35,9 @@ module ocn_time_integration_rk4
use ocn_equation_of_state
use ocn_vmix
- use ocn_time_average
use ocn_time_average_coupled
- use ocn_sea_ice
+
+ use ocn_effective_density_in_land_ice
implicit none
private
@@ -72,12 +73,12 @@ module ocn_time_integration_rk4
subroutine ocn_time_integrator_rk4(domain, dt)!{{{
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Advance model state forward in time by the specified time step using
+ ! Advance model state forward in time by the specified time step using
! 4th order Runge-Kutta
!
- ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:))
+ ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:))
! plus mesh meta-data
- ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains
+ ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains
! model state advanced forward in time by dt seconds
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -86,18 +87,21 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
type (domain_type), intent(inout) :: domain !< Input/Output: domain information
real (kind=RKIND), intent(in) :: dt !< Input: timestep
- integer :: iCell, k, i, err
+ integer :: iCell, iEdge, k, i, err
type (block_type), pointer :: block
type (mpas_pool_type), pointer :: tendPool
+ type (mpas_pool_type), pointer :: tracersTendPool
type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: tracersPool
type (mpas_pool_type), pointer :: meshPool
type (mpas_pool_type), pointer :: provisStatePool
+ type (mpas_pool_type), pointer :: provisTracersPool
type (mpas_pool_type), pointer :: diagnosticsPool
type (mpas_pool_type), pointer :: verticalMeshPool
type (mpas_pool_type), pointer :: forcingPool
type (mpas_pool_type), pointer :: scratchPool
- type (mpas_pool_type), pointer :: averagePool
+ type (mpas_pool_type), pointer :: swForcingPool
integer :: rk_step
@@ -119,7 +123,9 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
logical, pointer :: config_filter_btr_mode, config_use_freq_filtered_thickness
logical, pointer :: config_use_standardGM
logical, pointer :: config_use_cvmix_kpp
+ logical, pointer :: config_use_tracerGroup
real (kind=RKIND), pointer :: config_mom_del4
+ character (len=StrKIND), pointer :: config_land_ice_flux_mode
! State indices
integer, pointer :: indexTemperature
@@ -136,11 +142,12 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
real (kind=RKIND), dimension(:,:), pointer :: normalVelocityProvis, layerThicknessProvis
real (kind=RKIND), dimension(:,:), pointer :: highFreqThicknessProvis
real (kind=RKIND), dimension(:,:), pointer :: lowFreqDivergenceProvis
- real (kind=RKIND), dimension(:,:,:), pointer :: tracersProvis
+ real (kind=RKIND), dimension(:,:,:), pointer :: tracersGroupProvis
! Tend Array Pointers
- real (kind=RKIND), dimension(:,:), pointer :: highFreqThicknessTend, lowFreqDivergenceTend, normalVelocityTend, layerThicknessTend
- real (kind=RKIND), dimension(:,:,:), pointer :: tracersTend
+ real (kind=RKIND), dimension(:,:), pointer :: highFreqThicknessTend, lowFreqDivergenceTend, normalVelocityTend, &
+ layerThicknessTend
+ real (kind=RKIND), dimension(:,:,:), pointer :: tracersGroupTend
! Diagnostics Array Pointers
real (kind=RKIND), dimension(:,:), pointer :: layerThicknessEdge
@@ -148,9 +155,9 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
real (kind=RKIND), dimension(:,:), pointer :: normalTransportVelocity, normalGMBolusVelocity
real (kind=RKIND), dimension(:,:), pointer :: velocityX, velocityY, velocityZ
real (kind=RKIND), dimension(:,:), pointer :: velocityZonal, velocityMeridional
- real (kind=RKIND), dimension(:,:), pointer :: gradSSH
- real (kind=RKIND), dimension(:,:), pointer :: gradSSHX, gradSSHY, gradSSHZ
- real (kind=RKIND), dimension(:,:), pointer :: gradSSHZonal, gradSSHMeridional
+ real (kind=RKIND), dimension(:), pointer :: gradSSH
+ real (kind=RKIND), dimension(:), pointer :: gradSSHX, gradSSHY, gradSSHZ
+ real (kind=RKIND), dimension(:), pointer :: gradSSHZonal, gradSSHMeridional
real (kind=RKIND), dimension(:,:), pointer :: surfaceVelocity, sshGradient
! State Array Pointers
@@ -160,14 +167,20 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
real (kind=RKIND), dimension(:,:), pointer :: lowFreqDivergenceCur, lowFreqDivergenceNew
real (kind=RKIND), dimension(:), pointer :: sshCur, sshNew
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers, tracersCur, tracersNew
+ real (kind=RKIND), dimension(:,:,:), pointer :: tracerGroup, tracersCur, tracersNew
- ! Forcing Array pointers
- real (kind=RKIND), dimension(:), pointer :: seaIceEnergy
+ ! Diagnostics Field Pointers
+ type (field1DReal), pointer :: boundaryLayerDepthField, effectiveDensityField
+ type (field2DReal), pointer :: normalizedRelativeVorticityEdgeField, divergenceField, relativeVorticityField
! State/Tend Field Pointers
type (field2DReal), pointer :: normalVelocityField, layerThicknessField
- type (field3DReal), pointer :: tracersField
+ type (field3DReal), pointer :: tracersGroupField
+
+ ! Tracer Group Iteartion
+ type (mpas_pool_iterator_type) :: groupItr
+ character (len=StrKIND) :: modifiedGroupName
+ character (len=StrKIND) :: configName
! Get config options
call mpas_pool_get_config(domain % configs, 'config_mom_del4', config_mom_del4)
@@ -177,6 +190,7 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
call mpas_pool_get_config(domain % configs, 'config_use_freq_filtered_thickness', config_use_freq_filtered_thickness)
call mpas_pool_get_config(domain % configs, 'config_use_standardGM', config_use_standardGM)
call mpas_pool_get_config(domain % configs, 'config_use_cvmix_kpp', config_use_cvmix_kpp)
+ call mpas_pool_get_config(domain % configs, 'config_land_ice_flux_mode', config_land_ice_flux_mode)
!
! Initialize time_levs(2) with state at current time
@@ -187,44 +201,81 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
-
- allocate(provisStatePool)
+
call mpas_pool_create_pool(provisStatePool)
call mpas_pool_clone_pool(statePool, provisStatePool, 1)
call mpas_pool_add_subpool(block % structs, 'provis_state', provisStatePool)
+ call mpas_threading_barrier()
call mpas_pool_get_dimension(block % dimensions, 'nCells', nCells)
+ call mpas_pool_get_dimension(block % dimensions, 'nEdges', nEdges)
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocityCur, 1)
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocityNew, 2)
call mpas_pool_get_array(statePool, 'layerThickness', layerThicknessCur, 1)
call mpas_pool_get_array(statePool, 'layerThickness', layerThicknessNew, 2)
- call mpas_pool_get_array(statePool, 'tracers', tracersCur, 1)
- call mpas_pool_get_array(statePool, 'tracers', tracersNew, 2)
+
call mpas_pool_get_array(statePool, 'highFreqThickness', highFreqThicknessCur, 1)
call mpas_pool_get_array(statePool, 'highFreqThickness', highFreqThicknessNew, 2)
call mpas_pool_get_array(statePool, 'lowFreqDivergence', lowFreqDivergenceCur, 1)
call mpas_pool_get_array(statePool, 'lowFreqDivergence', lowFreqDivergenceNew, 2)
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'maxLevelEdgeTop', maxLevelEdgeTop)
- normalVelocityNew(:,:) = normalVelocityCur(:,:)
- layerThicknessNew(:,:) = layerThicknessCur(:,:)
+ !$omp do schedule(runtime) private(k)
+ do iEdge = 1, nEdges
+ do k = 1, maxLevelEdgeTop(iEdge)
+ normalVelocityNew(k, iEdge) = normalVelocityCur(k, iEdge)
+ end do
+ end do
+ !$omp end do
- do iCell = 1, nCells ! couple tracers to thickness
+ !$omp do schedule(runtime) private(k)
+ do iCell = 1, nCells
do k = 1, maxLevelCell(iCell)
- tracersNew(:,k,iCell) = tracersCur(:,k,iCell) * layerThicknessCur(k,iCell)
+ layerThicknessNew(k, iCell) = layerThicknessCur(k, iCell)
end do
end do
+ !$omp end do
+
+ call mpas_pool_begin_iteration(tracersPool)
+ do while ( mpas_pool_get_next_member(tracersPool, groupItr) )
+
+ if ( groupItr % memberType == MPAS_POOL_FIELD ) then
+
+ call mpas_pool_get_array(tracersPool, trim(groupItr % memberName), tracersCur, 1)
+ call mpas_pool_get_array(tracersPool, trim(groupItr % memberName), tracersNew, 2)
+
+ if ( associated(tracersCur) .and. associated(tracersNew) ) then
+ !$omp do schedule(runtime) private(k)
+ do iCell = 1, nCells ! couple tracers to thickness
+ do k = 1, maxLevelCell(iCell)
+ tracersNew(:, k, iCell) = tracersCur(:, k, iCell) * layerThicknessCur(k, iCell)
+ end do
+ end do
+ !$omp end do
+ end if
+ end if
+ end do
if (associated(highFreqThicknessCur)) then
- highFreqThicknessNew(:,:) = highFreqThicknessCur(:,:)
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ highFreqThicknessNew(:, iCell) = highFreqThicknessCur(:, iCell)
+ end do
+ !$omp end do
end if
if (associated(lowFreqDivergenceCur)) then
- lowFreqDivergenceNew(:,:) = lowFreqDivergenceCur(:,:)
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ lowFreqDivergenceNew(:, iCell) = lowFreqDivergenceCur(:, iCell)
+ end do
+ !$omp end do
end if
block => block % next
@@ -261,18 +312,20 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
block => block % next
end do
+ call mpas_threading_barrier()
+
! Fourth-order Runge-Kutta, solving dy/dt = f(t,y) is typically written as follows
- ! where h = delta t is the large time step. Here f(t,y) is the right hand side,
+ ! where h = delta t is the large time step. Here f(t,y) is the right hand side,
! called the tendencies in the code below.
! k_1 = h f(t_n , y_n)
! k_2 = h f(t_n + 1/2 h, y_n + 1/2 k_1)
! k_3 = h f(t_n + 1/2 h, y_n + 1/2 k_2)
! k_4 = h f(t_n + h, y_n + k_3)
- ! y_{n+1} = y_n + 1/6 k_1 + 1/3 k_2 + 1/3 k_3 + 1/6 k_4
+ ! y_{n+1} = y_n + 1/6 k_1 + 1/3 k_2 + 1/3 k_3 + 1/6 k_4
! in index notation:
! k_{j+1} = h f(t_n + a_j h, y_n + a_j k_j)
- ! y_{n+1} = y_n + sum ( b_j k_j )
+ ! y_{n+1} = y_n + sum ( b_j k_j )
! The coefficients of k_j are b_j = (1/6, 1/3, 1/3, 1/6) and are
! initialized here as delta t * b_j:
@@ -295,8 +348,9 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
rk_substep_weights(4) = dt ! a_4 only used for ALE step, otherwise it is skipped.
call mpas_timer_start("RK4-main loop")
+
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! BEGIN RK loop
+ ! BEGIN RK loop
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
do rk_step = 1, 4
call mpas_pool_get_subpool(domain % blocklist % structs, 'diagnostics', diagnosticsPool)
@@ -308,17 +362,21 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
end if
call mpas_timer_stop("RK4-boundary layer depth halo update")
+
call mpas_timer_start("RK4-diagnostic halo update")
+
call mpas_dmpar_field_halo_exch(domain, 'normalizedRelativeVorticityEdge')
if (config_mom_del4 > 0.0) then
call mpas_dmpar_field_halo_exch(domain, 'divergence')
call mpas_dmpar_field_halo_exch(domain, 'relativeVorticity')
end if
call mpas_timer_stop("RK4-diagnostic halo update")
+ call mpas_threading_barrier()
+
! Compute tendencies for high frequency thickness
- ! In RK4 notation, we are computing the right hand side f(t,y),
+ ! In RK4 notation, we are computing the right hand side f(t,y),
! which is the same as k_j / h.
if (config_use_freq_filtered_thickness) then
@@ -329,17 +387,23 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'provis_state', provisStatePool)
call ocn_tend_freq_filtered_thickness(tendPool, provisStatePool, diagnosticsPool, meshPool, 1)
+ call mpas_threading_barrier()
block => block % next
end do
call mpas_timer_stop("RK4-tendency computations")
call mpas_timer_start("RK4-prognostic halo update")
+
call mpas_dmpar_field_halo_exch(domain, 'tendHighFreqThickness')
call mpas_dmpar_field_halo_exch(domain, 'tendLowFreqDivergence')
+
call mpas_timer_stop("RK4-prognostic halo update")
+ call mpas_threading_barrier()
+
! Compute next substep state for high frequency thickness.
! In RK4 notation, we are computing y_n + a_j k_j.
@@ -347,6 +411,7 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'tend', tendPool)
call mpas_pool_get_subpool(block % structs, 'provis_state', provisStatePool)
@@ -354,26 +419,37 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
call mpas_pool_get_array(provisStatePool, 'highFreqThickness', highFreqThicknessProvis, 1)
call mpas_pool_get_array(tendPool, 'highFreqThickness', highFreqThicknessTend)
- highFreqThicknessProvis(:,:) = highFreqThicknessCur(:,:) + rk_substep_weights(rk_step) * highFreqThicknessTend(:,:)
+ call mpas_pool_get_dimension(block % dimensions, 'nCells', nCells)
+
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ highFreqThicknessProvis(:, iCell) = highFreqThicknessCur(:, iCell) + rk_substep_weights(rk_step) * highFreqThicknessTend(:, iCell)
+ end do
+ !$omp end do
+ call mpas_threading_barrier()
block => block % next
end do
endif
+
! Compute tendencies for velocity, thickness, and tracers.
- ! In RK4 notation, we are computing the right hand side f(t,y),
+ ! In RK4 notation, we are computing the right hand side f(t,y),
! which is the same as k_j / h.
call mpas_timer_start("RK4-tendency computations")
+
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'verticalMesh', verticalMeshPool)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool)
call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
call mpas_pool_get_subpool(block % structs, 'tend', tendPool)
call mpas_pool_get_subpool(block % structs, 'provis_state', provisStatePool)
+ call mpas_pool_get_subpool(block % structs, 'shortwave', swForcingPool)
call mpas_pool_get_array(statePool, 'layerThickness', layerThicknessCur, 1)
call mpas_pool_get_array(statePool, 'ssh', sshCur, 1)
@@ -388,126 +464,214 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
! advection of u uses u, while advection of layerThickness and tracers use normalTransportVelocity.
if (associated(highFreqThicknessProvis)) then
- call ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, &
+ call ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, scratchPool, &
layerThicknessCur,layerThicknessEdge, normalVelocityProvis, &
sshCur, rk_substep_weights(rk_step), &
vertAleTransportTop, err, highFreqThicknessProvis)
else
- call ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, &
+ call ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, scratchPool, &
layerThicknessCur,layerThicknessEdge, normalVelocityProvis, &
sshCur, rk_substep_weights(rk_step), &
vertAleTransportTop, err)
endif
+ call mpas_threading_barrier()
call ocn_tend_vel(tendPool, provisStatePool, forcingPool, diagnosticsPool, meshPool, scratchPool, 1)
+ call mpas_threading_barrier()
if (associated(highFreqThicknessProvis)) then
- call ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, &
+ call ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, scratchPool, &
layerThicknessCur, layerThicknessEdge, normalTransportVelocity, &
sshCur, rk_substep_weights(rk_step), &
vertAleTransportTop, err, highFreqThicknessProvis)
else
- call ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, &
+ call ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, scratchPool, &
layerThicknessCur, layerThicknessEdge, normalTransportVelocity, &
sshCur, rk_substep_weights(rk_step), &
vertAleTransportTop, err)
endif
+ call mpas_threading_barrier()
call ocn_tend_thick(tendPool, forcingPool, diagnosticsPool, meshPool)
if (config_filter_btr_mode) then
call ocn_filter_btr_mode_tend_vel(tendPool, provisStatePool, diagnosticsPool, meshPool, 1)
endif
+ call mpas_threading_barrier()
- call ocn_tend_tracer(tendPool, provisStatePool, forcingPool, diagnosticsPool, meshPool, scratchPool, dt, 1)
+ call ocn_tend_tracer(tendPool, provisStatePool, forcingPool, diagnosticsPool, meshPool, swForcingPool, &
+ scratchPool, dt, 1)
+ call mpas_threading_barrier()
block => block % next
end do
+
call mpas_timer_stop("RK4-tendency computations")
+
! Update halos for prognostic variables.
call mpas_timer_start("RK4-prognostic halo update")
+
call mpas_dmpar_field_halo_exch(domain, 'tendNormalVelocity')
call mpas_dmpar_field_halo_exch(domain, 'tendLayerThickness')
- call mpas_dmpar_field_halo_exch(domain, 'tendTracers')
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'tend', tendPool)
+ call mpas_pool_get_subpool(tendPool, 'tracersTend', tracersTendPool)
+
+ call mpas_pool_begin_iteration(tracersTendPool)
+ do while ( mpas_pool_get_next_member(tracersTendPool, groupItr) )
+ if ( groupItr % memberType == MPAS_POOL_FIELD ) then
+ call mpas_dmpar_field_halo_exch(domain, trim(groupItr % memberName))
+ end if
+ end do
+
call mpas_timer_stop("RK4-prognostic halo update")
+ call mpas_threading_barrier()
! Compute next substep state for velocity, thickness, and tracers.
! In RK4 notation, we are computing y_n + a_j k_j.
call mpas_timer_start("RK4-update diagnostic variables")
+
if (rk_step < 4) then
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_dimension(block % dimensions, 'nCells', nCells)
+ call mpas_pool_get_dimension(block % dimensions, 'nEdges', nEdges)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'tend', tendPool)
+ call mpas_pool_get_subpool(tendPool, 'tracersTend', tracersTendPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'provis_state', provisStatePool)
call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool)
+ call mpas_pool_get_subpool(provisStatePool, 'tracers', provisTracersPool)
+
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocityCur, 1)
call mpas_pool_get_array(statePool, 'layerThickness', layerThicknessCur, 1)
- call mpas_pool_get_array(statePool, 'tracers', tracersCur, 1)
call mpas_pool_get_array(statePool, 'lowFreqDivergence', lowFreqDivergenceCur, 1)
call mpas_pool_get_array(provisStatePool, 'normalVelocity', normalVelocityProvis, 1)
call mpas_pool_get_array(provisStatePool, 'layerThickness', layerThicknessProvis, 1)
- call mpas_pool_get_array(provisStatePool, 'tracers', tracersProvis, 1)
call mpas_pool_get_array(provisStatePool, 'lowFreqDivergence', lowFreqDivergenceProvis, 1)
call mpas_pool_get_array(tendPool, 'normalVelocity', normalVelocityTend)
call mpas_pool_get_array(tendPool, 'layerThickness', layerThicknessTend)
- call mpas_pool_get_array(tendPool, 'tracers', tracersTend)
+
call mpas_pool_get_array(tendPool, 'lowFreqDivergence', lowFreqDivergenceTend)
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'maxLevelEdgeTop', maxLevelEdgeTop)
call mpas_pool_get_array(diagnosticsPool, 'normalTransportVelocity', normalTransportVelocity)
call mpas_pool_get_array(diagnosticsPool, 'normalGMBolusVelocity', normalGMBolusVelocity)
- normalVelocityProvis(:,:) = normalVelocityCur(:,:) + rk_substep_weights(rk_step) * normalVelocityTend(:,:)
+ call mpas_threading_barrier()
+
+ !$omp do schedule(runtime) private(k)
+ do iEdge = 1, nEdges
+ do k = 1, maxLevelEdgeTop(iEdge)
+ normalVelocityProvis(k, iEdge) = normalVelocityCur(k, iEdge) + rk_substep_weights(rk_step) &
+ * normalVelocityTend(k, iEdge)
+ end do
+ end do
+ !$omp end do
+
- layerThicknessProvis(:,:) = layerThicknessCur(:,:) + rk_substep_weights(rk_step) * layerThicknessTend(:,:)
+ !$omp do schedule(runtime) private(k)
do iCell = 1, nCells
do k = 1, maxLevelCell(iCell)
- tracersProvis(:,k,iCell) = ( layerThicknessCur(k,iCell) * tracersCur(:,k,iCell) &
- + rk_substep_weights(rk_step) * tracersTend(:,k,iCell) &
- ) / layerThicknessProvis(k,iCell)
+ layerThicknessProvis(k, iCell) = layerThicknessCur(k, iCell) + rk_substep_weights(rk_step) &
+ * layerThicknessTend(k, iCell)
end do
-
+ end do
+ !$omp end do
+
+ call mpas_pool_begin_iteration(tracersPool)
+ do while ( mpas_pool_get_next_member(tracersPool, groupItr) )
+ if ( groupItr % memberType == MPAS_POOL_FIELD ) then
+ configName = 'config_use_' // trim(groupItr % memberName)
+ call mpas_pool_get_config(domain % configs, configName, config_use_tracerGroup)
+
+ if ( config_use_tracerGroup ) then
+ call mpas_pool_get_array(tracersPool, groupItr % memberName, tracersCur, 1)
+ call mpas_pool_get_array(provisTracersPool, groupItr % memberName, tracersGroupProvis, 1)
+
+ modifiedGroupName = trim(groupItr % memberName) // 'Tend'
+ call mpas_pool_get_array(tracersTendPool, modifiedGroupName, tracersGroupTend)
+ if ( associated(tracersGroupProvis) .and. associated(tracersCur) .and. associated(tracersGroupTend) ) then
+ !$omp do schedule(runtime) private(k)
+ do iCell = 1, nCells
+ do k = 1, maxLevelCell(iCell)
+ tracersGroupProvis(:, k, iCell) = ( layerThicknessCur(k, iCell) * tracersCur(:, k, iCell) &
+ + rk_substep_weights(rk_step) * tracersGroupTend(:, k, iCell) &
+ ) / layerThicknessProvis(k, iCell)
+ end do
+
+ end do
+ !$omp end do
+ end if
+ end if
+ end if
end do
if (associated(lowFreqDivergenceCur)) then
- lowFreqDivergenceProvis(:,:) = lowFreqDivergenceCur(:,:) + rk_substep_weights(rk_step) * lowFreqDivergenceTend(:,:)
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ lowFreqDivergenceProvis(:, iCell) = lowFreqDivergenceCur(:, iCell) + rk_substep_weights(rk_step) &
+ * lowFreqDivergenceTend(:, iCell)
+ end do
+ !$omp end do
end if
if (config_prescribe_velocity) then
- normalVelocityProvis(:,:) = normalVelocityCur(:,:)
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ normalVelocityProvis(:, iEdge) = normalVelocityCur(:, iEdge)
+ end do
+ !$omp end do
end if
if (config_prescribe_thickness) then
- layerThicknessProvis(:,:) = layerThicknessCur(:,:)
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ layerThicknessProvis(:, iCell) = layerThicknessCur(:, iCell)
+ end do
+ !$omp end do
end if
+ call mpas_threading_barrier()
- call ocn_diagnostic_solve(dt, provisStatePool, forcingPool, meshPool, diagnosticsPool, scratchPool, 1)
+ call ocn_diagnostic_solve(dt, provisStatePool, forcingPool, meshPool, diagnosticsPool, scratchPool, tracersPool, 1)
+ call mpas_threading_barrier()
! ------------------------------------------------------------------
! Accumulating various parametrizations of the transport velocity
! ------------------------------------------------------------------
- normalTransportVelocity(:,:) = normalVelocityProvis(:,:)
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ normalTransportVelocity(:, iEdge) = normalVelocityProvis(:, iEdge)
+ end do
+ !$omp end do
+ call mpas_threading_barrier()
! Compute normalGMBolusVelocity, relativeSlope and RediDiffVertCoef if respective flags are turned on
if (config_use_standardGM) then
call ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
end if
+ call mpas_threading_barrier()
if (config_use_standardGM) then
- normalTransportVelocity(:,:) = normalTransportVelocity(:,:) + normalGMBolusVelocity(:,:)
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ normalTransportVelocity(:, iEdge) = normalTransportVelocity(:, iEdge) + normalGMBolusVelocity(:,iEdge)
+ end do
+ !$omp end do
end if
+ call mpas_threading_barrier()
! ------------------------------------------------------------------
! End: Accumulating various parametrizations of the transport velocity
! ------------------------------------------------------------------
@@ -515,69 +679,114 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
block => block % next
end do
end if
+
call mpas_timer_stop("RK4-update diagnostic variables")
+ call mpas_threading_barrier()
! Accumulate update.
! In RK4 notation, we are computing b_j k_j and adding it to an accumulating sum so that we have
- ! y_{n+1} = y_n + sum ( b_j k_j )
+ ! y_{n+1} = y_n + sum ( b_j k_j )
! after the fourth iteration.
call mpas_timer_start("RK4-RK4 accumulate update")
+
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_dimension(block % dimensions, 'nCells', nCells)
+ call mpas_pool_get_dimension(block % dimensions, 'nEdges', nEdges)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'tend', tendPool)
+ call mpas_pool_get_subpool(tendPool, 'tracersTend', tracersTendPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocityCur, 1)
call mpas_pool_get_array(statePool, 'layerThickness', layerThicknessCur, 1)
- call mpas_pool_get_array(statePool, 'tracers', tracersCur, 1)
call mpas_pool_get_array(statePool, 'highFreqThickness', highFreqThicknessCur, 1)
call mpas_pool_get_array(statePool, 'lowFreqDivergence', lowFreqDivergenceCur, 1)
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocityNew, 2)
call mpas_pool_get_array(statePool, 'layerThickness', layerThicknessNew, 2)
- call mpas_pool_get_array(statePool, 'tracers', tracersNew, 2)
call mpas_pool_get_array(statePool, 'highFreqThickness', highFreqThicknessNew, 2)
call mpas_pool_get_array(statePool, 'lowFreqDivergence', lowFreqDivergenceNew, 2)
call mpas_pool_get_array(tendPool, 'normalVelocity', normalVelocityTend)
call mpas_pool_get_array(tendPool, 'layerThickness', layerThicknessTend)
- call mpas_pool_get_array(tendPool, 'tracers', tracersTend)
+
call mpas_pool_get_array(tendPool, 'highFreqThickness', highFreqThicknessTend)
call mpas_pool_get_array(tendPool, 'lowFreqDivergence', lowFreqDivergenceTend)
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
- normalVelocityNew(:,:) = normalVelocityNew(:,:) + rk_weights(rk_step) * normalVelocityTend(:,:)
-
- layerThicknessNew(:,:) = layerThicknessNew(:,:) + rk_weights(rk_step) * layerThicknessTend(:,:)
-
+ !$omp do schedule(runtime) private(k)
do iCell = 1, nCells
do k = 1, maxLevelCell(iCell)
- tracersNew(:,k,iCell) = tracersNew(:,k,iCell) + rk_weights(rk_step) * tracersTend(:,k,iCell)
+ layerThicknessNew(k, iCell) = layerThicknessNew(k, iCell) + rk_weights(rk_step) * layerThicknessTend(k, iCell)
end do
end do
+ !$omp end do
+
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ normalVelocityNew(:, iEdge) = normalVelocityNew(:, iEdge) + rk_weights(rk_step) * normalVelocityTend(:, iEdge)
+ end do
+ !$omp end do
+
+ call mpas_pool_begin_iteration(tracersPool)
+ do while ( mpas_pool_get_next_member(tracersPool, groupItr) )
+ if ( groupItr % memberType == MPAS_POOL_FIELD ) then
+ configName = 'config_use_' // trim(groupItr % memberName)
+ call mpas_pool_get_config(domain % configs, configName, config_use_tracerGroup)
+
+ if ( config_use_tracerGroup ) then
+ call mpas_pool_get_array(tracersPool, groupItr % memberName, tracersNew, 2)
+
+ modifiedGroupName = trim(groupItr % memberName) // 'Tend'
+ call mpas_pool_get_array(tracersTendPool, modifiedGroupName, tracersGroupTend)
+ if ( associated(tracersNew) .and. associated(tracersGroupTend) ) then
+ !$omp do schedule(runtime) private(k)
+ do iCell = 1, nCells
+ do k = 1, maxLevelCell(iCell)
+ tracersNew(:, k, iCell) = tracersNew(:, k, iCell) + rk_weights(rk_step) &
+ * tracersGroupTend(:, k, iCell)
+ end do
+ end do
+ !$omp end do
+ end if
+ end if
+ end if
+ end do
if (associated(highFreqThicknessNew)) then
- highFreqThicknessNew(:,:) = highFreqThicknessNew(:,:) + rk_weights(rk_step) * highFreqThicknessTend(:,:)
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ highFreqThicknessNew(:, iCell) = highFreqThicknessNew(:, iCell) + rk_weights(rk_step) * highFreqThicknessTend(:, iCell)
+ end do
+ !$omp end do
end if
if (associated(lowFreqDivergenceNew)) then
- lowFreqDivergenceNew(:,:) = lowFreqDivergenceNew(:,:) + rk_weights(rk_step) * lowFreqDivergenceTend(:,:)
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ lowFreqDivergenceNew(:, iCell) = lowFreqDivergenceNew(:, iCell) + rk_weights(rk_step) * lowFreqDivergenceTend(:, iCell)
+ end do
+ !$omp end do
end if
block => block % next
end do
+
call mpas_timer_stop("RK4-RK4 accumulate update")
+ call mpas_threading_barrier()
end do
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! END RK loop
+ ! END RK loop
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
call mpas_timer_stop("RK4-main loop")
+ call mpas_threading_barrier()
!
! A little clean up at the end: rescale tracer fields and compute diagnostics for new state
@@ -590,36 +799,46 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
call mpas_pool_get_dimension(block % dimensions, 'nCells', nCells)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
- call mpas_pool_get_array(statePool, 'tracers', tracersNew, 2)
call mpas_pool_get_array(statePool, 'layerThickness', layerThicknessNew, 2)
- call mpas_pool_get_dimension(statePool, 'index_temperature', indexTemperature)
- call mpas_pool_get_dimension(statePool, 'index_salinity', indexSalinity)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', indexTemperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', indexSalinity)
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
- call mpas_pool_get_array(forcingPool, 'seaIceEnergy', seaIceEnergy)
-
- do iCell = 1, nCells
- do k = 1, maxLevelCell(iCell)
- tracersNew(:, k, iCell) = tracersNew(:, k, iCell) / layerThicknessNew(k, iCell)
- end do
+ call mpas_pool_begin_iteration(tracersPool)
+ do while ( mpas_pool_get_next_member(tracersPool, groupItr) )
+ if ( groupItr % memberType == MPAS_POOL_FIELD ) then
+ call mpas_pool_get_array(tracersPool, groupItr % memberName, tracersNew, 2)
+ if ( associated(tracersNew) ) then
+ !$omp do schedule(runtime) private(k)
+ do iCell = 1, nCells
+ do k = 1, maxLevelCell(iCell)
+ tracersNew(:, k, iCell) = tracersNew(:, k, iCell) / layerThicknessNew(k, iCell)
+ end do
+ end do
+ !$omp end do
+ end if
+ end if
end do
- call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, 2)
- call ocn_sea_ice_formation(meshPool, indexTemperature, indexSalinity, layerThicknessNew, tracersNew, seaIceEnergy, err)
+ call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, tracersPool, 2)
+
block => block % next
end do
call mpas_timer_start("RK4-implicit vert mix")
+
block => domain % blocklist
do while(associated(block))
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
@@ -628,29 +847,43 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocityNew, 2)
call mpas_pool_get_array(diagnosticsPool, 'normalTransportVelocity', normalTransportVelocity)
- ! Call ocean diagnostic solve in preparation for vertical mixing. Note
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+
+ ! Call ocean diagnostic solve in preparation for vertical mixing. Note
! it is called again after vertical mixing, because u and tracers change.
- ! For Richardson vertical mixing, only density, layerThicknessEdge, and kineticEnergyCell need to
+ ! For Richardson vertical mixing, only density, layerThicknessEdge, and kineticEnergyCell need to
! be computed. For kpp, more variables may be needed. Either way, this
! could be made more efficient by only computing what is needed for the
- ! implicit vmix routine that follows.
- call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, 2)
+ ! implicit vmix routine that follows.
+ call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, tracersPool, 2)
+ call mpas_threading_barrier()
- call ocn_vmix_implicit(dt, meshPool, diagnosticsPool, statePool, err, 2)
+ call ocn_vmix_implicit(dt, meshPool, diagnosticsPool, statePool, forcingPool, scratchPool, err, 2)
+ call mpas_threading_barrier()
! ------------------------------------------------------------------
! Accumulating various parametrizations of the transport velocity
! ------------------------------------------------------------------
- normalTransportVelocity(:,:) = normalVelocityNew(:,:)
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ normalTransportVelocity(:, iEdge) = normalVelocityNew(:, iEdge)
+ end do
+ !$omp end do
! Compute normalGMBolusVelocity, slopeRelative and RediDiffVertCoef if respective flags are turned on
- ! QC Note: this routine is called here to get updated k33. normalTransportVelocity probably does not need to be updated at all here.
+ ! QC Note: this routine is called here to get updated k33. normalTransportVelocity probably does not need to be
+ ! updated at all here.
if (config_use_standardGM) then
call ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
end if
+ call mpas_threading_barrier()
if (config_use_standardGM) then
- normalTransportVelocity(:,:) = normalTransportVelocity(:,:) + normalGMBolusVelocity(:,:)
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ normalTransportVelocity(:, iEdge) = normalTransportVelocity(:, iEdge) + normalGMBolusVelocity(:, iEdge)
+ end do
+ !$omp end do
end if
! ------------------------------------------------------------------
! End: Accumulating various parametrizations of the transport velocity
@@ -659,25 +892,40 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
block => block % next
end do
- ! Update halo on u and tracers, which were just updated for implicit vertical mixing. If not done,
+ ! Update halo on u and tracers, which were just updated for implicit vertical mixing. If not done,
! this leads to lack of volume conservation. It is required because halo updates in RK4 are only
- ! conducted on tendencies, not on the velocity and tracer fields. So this update is required to
+ ! conducted on tendencies, not on the velocity and tracer fields. So this update is required to
! communicate the change due to implicit vertical mixing across the boundary.
call mpas_timer_start("RK4-implicit vert mix halos")
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
call mpas_dmpar_field_halo_exch(domain, 'normalVelocity', timeLevel=2)
- call mpas_dmpar_field_halo_exch(domain, 'tracers', timeLevel=2)
+
+ call mpas_pool_begin_iteration(tracersPool)
+ do while ( mpas_pool_get_next_member(tracersPool, groupItr) )
+ if ( groupItr % memberType == MPAS_POOL_FIELD ) then
+ call mpas_dmpar_field_halo_exch(domain, groupItr % memberName, timeLevel=2)
+ end if
+ end do
+
call mpas_timer_stop("RK4-implicit vert mix halos")
call mpas_timer_stop("RK4-implicit vert mix")
+ call mpas_threading_barrier()
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
- call mpas_pool_get_subpool(block % structs, 'average', averagePool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocityCur, 1)
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocityNew, 2)
@@ -705,60 +953,101 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
call mpas_pool_get_array(diagnosticsPool, 'surfaceVelocity', surfaceVelocity)
call mpas_pool_get_array(diagnosticsPool, 'SSHGradient', SSHGradient)
+
if (config_prescribe_velocity) then
- normalVelocityNew(:,:) = normalVelocityCur(:,:)
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ normalVelocityNew(:, iEdge) = normalVelocityCur(:, iEdge)
+ end do
+ !$omp end do
end if
if (config_prescribe_thickness) then
- layerThicknessNew(:,:) = layerThicknessCur(:,:)
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ layerThicknessNew(:, iCell) = layerThicknessCur(:, iCell)
+ end do
+ !$omp end do
end if
- call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, 2)
+ call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, tracersPool, 2)
+ call mpas_threading_barrier()
+
+ ! Update the effective desnity in land ice if we're coupling to land ice
+ call ocn_effective_density_in_land_ice_update(meshPool, forcingPool, statePool, scratchPool, err)
! ------------------------------------------------------------------
! Accumulating various parameterizations of the transport velocity
! ------------------------------------------------------------------
- normalTransportVelocity(:,:) = normalVelocityNew(:,:)
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ normalTransportVelocity(:, iEdge) = normalVelocityNew(:, iEdge)
+ end do
+ !$omp end do
+ call mpas_threading_barrier()
! Compute normalGMBolusVelocity and the tracer transport velocity
if (config_use_standardGM) then
call ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
end if
+ call mpas_threading_barrier()
if (config_use_standardGM) then
- normalTransportVelocity(:,:) = normalTransportVelocity(:,:) + normalGMBolusVelocity(:,:)
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ normalTransportVelocity(:, iEdge) = normalTransportVelocity(:, iEdge) + normalGMBolusVelocity(:, iEdge)
+ end do
+ !$omp end do
end if
! ------------------------------------------------------------------
! End: Accumulating various parameterizations of the transport velocity
! ------------------------------------------------------------------
- call mpas_reconstruct(meshPool, normalVelocityNew, &
- velocityX, velocityY, velocityZ, &
- velocityZonal, velocityMeridional &
- )
-
- call mpas_reconstruct(meshPool, gradSSH, &
- gradSSHX, gradSSHY, gradSSHZ, &
- gradSSHZonal, gradSSHMeridional &
- )
-
- surfaceVelocity(indexSurfaceVelocityZonal, :) = velocityZonal(1, :)
- surfaceVelocity(indexSurfaceVelocityMeridional, :) = velocityMeridional(1, :)
-
- SSHGradient(indexSSHGradientZonal, :) = gradSSHZonal(1, :)
- SSHGradient(indexSSHGradientMeridional, :) = gradSSHMeridional(1, :)
+ !$omp master
+ call mpas_reconstruct(meshPool, normalVelocityNew, &
+ velocityX, velocityY, velocityZ, &
+ velocityZonal, velocityMeridional, &
+ includeHalos = .true.)
+
+ call mpas_reconstruct(meshPool, gradSSH, &
+ gradSSHX, gradSSHY, gradSSHZ, &
+ gradSSHZonal, gradSSHMeridional, &
+ includeHalos = .true.)
+ !$omp end master
+ call mpas_threading_barrier()
+
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ surfaceVelocity(indexSurfaceVelocityZonal, iCell) = velocityZonal(1, iCell)
+ surfaceVelocity(indexSurfaceVelocityMeridional, iCell) = velocityMeridional(1, iCell)
+
+ SSHGradient(indexSSHGradientZonal, iCell) = gradSSHZonal(iCell)
+ SSHGradient(indexSSHGradientMeridional, iCell) = gradSSHMeridional(iCell)
+ end do
+ !$omp end do
- call ocn_time_average_accumulate(averagePool, statePool, diagnosticsPool, 2)
- call ocn_time_average_coupled_accumulate(diagnosticsPool, forcingPool)
+ call ocn_time_average_coupled_accumulate(diagnosticsPool, statePool, forcingPool, 2)
if (config_use_standardGM) then
call ocn_reconstruct_gm_vectors(diagnosticsPool, meshPool)
end if
+ call mpas_threading_barrier()
block => block % next
end do
+
+ if (trim(config_land_ice_flux_mode) == 'coupled') then
+ call mpas_timer_start("RK4-effective density halo")
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'state', statePool)
+ call mpas_pool_get_field(statePool, 'effectiveDensityInLandIce', effectiveDensityField, 2)
+ call mpas_dmpar_exch_halo_field(effectiveDensityField)
+ call mpas_timer_stop("RK4-effective density halo")
+ end if
+
call mpas_timer_stop("RK4-cleaup phase")
+ call mpas_threading_barrier()
+
block => domain % blocklist
do while(associated(block))
call mpas_pool_get_subpool(block % structs, 'provis_state', provisStatePool)
@@ -768,6 +1057,7 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
call mpas_pool_remove_subpool(block % structs, 'provis_state')
block => block % next
end do
+ call mpas_threading_barrier()
end subroutine ocn_time_integrator_rk4!}}}
diff --git a/src/core_ocean/mode_forward/mpas_ocn_time_integration_split.F b/src/core_ocean/mode_forward/mpas_ocn_time_integration_split.F
index f52a987b96..1ad7579912 100644
--- a/src/core_ocean/mode_forward/mpas_ocn_time_integration_split.F
+++ b/src/core_ocean/mode_forward/mpas_ocn_time_integration_split.F
@@ -28,6 +28,7 @@ module ocn_time_integration_split
use mpas_vector_reconstruction
use mpas_spline_interpolation
use mpas_timer
+ use mpas_threading
use ocn_tendency
use ocn_diagnostics
@@ -35,10 +36,9 @@ module ocn_time_integration_split
use ocn_equation_of_state
use ocn_vmix
- use ocn_time_average
use ocn_time_average_coupled
- use ocn_sea_ice
+ use ocn_effective_density_in_land_ice
implicit none
private
@@ -68,19 +68,19 @@ module ocn_time_integration_split
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date September 2011
!> \details
-!> This routine integrates a single time step (dt) using a
+!> This routine integrates a master time step (dt) using a
!> split explicit time integrator.
!
!-----------------------------------------------------------------------
subroutine ocn_time_integrator_split(domain, dt)!{{{
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Advance model state forward in time by the specified time step using
+ ! Advance model state forward in time by the specified time step using
! Split_Explicit timestepping scheme
!
- ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:))
+ ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:))
! plus mesh meta-data
- ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains
+ ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains
! model state advanced forward in time by dt seconds
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -90,13 +90,15 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
real (kind=RKIND), intent(in) :: dt
type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: tracersPool
type (mpas_pool_type), pointer :: meshPool
type (mpas_pool_type), pointer :: verticalMeshPool
type (mpas_pool_type), pointer :: diagnosticsPool
type (mpas_pool_type), pointer :: tendPool
+ type (mpas_pool_type), pointer :: tracersTendPool
type (mpas_pool_type), pointer :: forcingPool
- type (mpas_pool_type), pointer :: averagePool
type (mpas_pool_type), pointer :: scratchPool
+ type (mpas_pool_type), pointer :: swForcingPool
type (dm_info) :: dminfo
integer :: iCell, i,k,j, iEdge, cell1, cell2, split_explicit_step, split, &
@@ -109,8 +111,10 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
integer :: useVelocityCorrection, err
real (kind=RKIND), dimension(:,:), pointer :: &
vertViscTopOfEdge, vertDiffTopOfCell
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+ real (kind=RKIND), dimension(:,:,:), pointer :: tracersGroup
real (kind=RKIND), dimension(:), allocatable:: uTemp
+ real (kind=RKIND), dimension(:), pointer :: btrvel_temp
+ type (field1DReal), pointer :: btrvel_tempField
real (kind=RKIND), dimension(:,:), allocatable:: tracersTemp
integer :: tsIter
@@ -125,12 +129,14 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
logical, pointer :: config_use_freq_filtered_thickness, config_btr_solve_SSH2, config_filter_btr_mode
logical, pointer :: config_vel_correction, config_prescribe_velocity, config_prescribe_thickness
logical, pointer :: config_use_cvmix_kpp
+ logical, pointer :: config_use_tracerGroup
+ character (len=StrKIND), pointer :: config_land_ice_flux_mode
real (kind=RKIND), pointer :: config_mom_del4, config_btr_gam1_velWt1, config_btr_gam2_SSHWt1
real (kind=RKIND), pointer :: config_btr_gam3_velWt2
! Dimensions
- integer, pointer :: nCells, nEdges, nVertLevels, num_tracers, startIndex, endIndex
+ integer, pointer :: nCells, nEdges, nVertLevels, num_tracersGroup, startIndex, endIndex
integer, pointer :: indexTemperature, indexSalinity
integer, pointer :: indexSurfaceVelocityZonal, indexSurfaceVelocityMeridional
integer, pointer :: indexSSHGradientZonal, indexSSHGradientMeridional
@@ -154,14 +160,14 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
real (kind=RKIND), dimension(:,:), pointer :: layerThicknessCur, layerThicknessNew
real (kind=RKIND), dimension(:,:), pointer :: highFreqThicknessCur, highFreqThicknessNew
real (kind=RKIND), dimension(:,:), pointer :: lowFreqDivergenceCur, lowFreqDivergenceNew
- real (kind=RKIND), dimension(:,:,:), pointer :: tracersCur, tracersNew
+ real (kind=RKIND), dimension(:,:,:), pointer :: tracersGroupCur, tracersGroupNew
! Tend Array Pointers
real (kind=RKIND), dimension(:), pointer :: sshTend
real (kind=RKIND), dimension(:,:), pointer :: highFreqThicknessTend
real (kind=RKIND), dimension(:,:), pointer :: lowFreqDivergenceTend
real (kind=RKIND), dimension(:,:), pointer :: normalVelocityTend, layerThicknessTend
- real (kind=RKIND), dimension(:,:,:), pointer :: tracersTend
+ real (kind=RKIND), dimension(:,:,:), pointer :: tracersGroupTend, activeTracersTend
! Diagnostics Array Pointers
real (kind=RKIND), dimension(:), pointer :: barotropicForcing, barotropicThicknessFlux
@@ -169,13 +175,27 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
real (kind=RKIND), dimension(:,:), pointer :: vertAleTransportTop
real (kind=RKIND), dimension(:,:), pointer :: velocityX, velocityY, velocityZ
real (kind=RKIND), dimension(:,:), pointer :: velocityZonal, velocityMeridional
- real (kind=RKIND), dimension(:,:), pointer :: gradSSH
- real (kind=RKIND), dimension(:,:), pointer :: gradSSHX, gradSSHY, gradSSHZ
- real (kind=RKIND), dimension(:,:), pointer :: gradSSHZonal, gradSSHMeridional
+ real (kind=RKIND), dimension(:), pointer :: gradSSH
+ real (kind=RKIND), dimension(:), pointer :: gradSSHX, gradSSHY, gradSSHZ
+ real (kind=RKIND), dimension(:), pointer :: gradSSHZonal, gradSSHMeridional
real (kind=RKIND), dimension(:,:), pointer :: surfaceVelocity, SSHGradient
- ! Forcing Array Pointer
- real (kind=RKIND), dimension(:), pointer :: seaIceEnergy
+ ! Diagnostics Field Pointers
+ type (field2DReal), pointer :: normalizedRelativeVorticityEdgeField, divergenceField, relativeVorticityField
+ type (field1DReal), pointer :: barotropicThicknessFluxField, boundaryLayerDepthField, effectiveDensityField
+
+ ! State/Tend Field Pointers
+ type (field1DReal), pointer :: normalBarotropicVelocitySubcycleField, sshSubcycleField
+ type (field2DReal), pointer :: highFreqThicknessField, lowFreqDivergenceField
+ type (field2DReal), pointer :: normalBaroclinicVelocityField, layerThicknessField
+ type (field2DReal), pointer :: normalVelocityField
+ type (field3DReal), pointer :: tracersGroupField
+
+ ! tracer iterators
+ type (mpas_pool_iterator_type) :: groupItr
+ character (len=StrKIND) :: modifiedGroupName
+ character (len=StrKIND) :: configName
+ integer :: threadNum
call mpas_timer_start("se timestep")
@@ -205,6 +225,7 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_config(domain % configs, 'config_use_standardGM', config_use_standardGM)
call mpas_pool_get_config(domain % configs, 'config_use_cvmix_kpp', config_use_cvmix_kpp)
+ call mpas_pool_get_config(domain % configs, 'config_land_ice_flux_mode', config_land_ice_flux_mode)
allocate(n_bcl_iter(config_n_ts_iter))
@@ -221,7 +242,9 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_dimension(block % dimensions, 'nVertLevels', nVertLevels)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_array(statePool, 'normalBaroclinicVelocity', normalBaroclinicVelocityCur, 1)
call mpas_pool_get_array(statePool, 'normalBarotropicVelocity', normalBarotropicVelocityCur, 1)
@@ -237,25 +260,26 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_array(statePool, 'layerThickness', layerThicknessCur, 1)
call mpas_pool_get_array(statePool, 'layerThickness', layerThicknessNew, 2)
- call mpas_pool_get_array(statePool, 'tracers', tracersCur, 1)
- call mpas_pool_get_array(statePool, 'tracers', tracersNew, 2)
-
call mpas_pool_get_array(statePool, 'highFreqThickness', highFreqThicknessCur, 1)
call mpas_pool_get_array(statePool, 'highFreqThickness', highFreqThicknessNew, 2)
call mpas_pool_get_array(statePool, 'lowFreqDivergence', lowFreqDivergenceCur, 1)
call mpas_pool_get_array(statePool, 'lowFreqDivergence', lowFreqDivergenceNew, 2)
+ call mpas_pool_get_array(diagnosticsPool, 'vertAleTransportTop', vertAleTransportTop)
+
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
! Initialize * variables that are used to compute baroclinic tendencies below.
+
+ !$omp do schedule(runtime) private(k)
do iEdge = 1, nEdges
do k = 1, nVertLevels !maxLevelEdgeTop % array(iEdge)
- ! The baroclinic velocity needs be recomputed at the beginning of a
+ ! The baroclinic velocity needs be recomputed at the beginning of a
! timestep because the implicit vertical mixing is conducted on the
! total u. We keep normalBarotropicVelocity from the previous timestep.
- ! Note that normalBaroclinicVelocity may now include a barotropic component, because the
+ ! Note that normalBaroclinicVelocity may now include a barotropic component, because the
! weights layerThickness have changed. That is OK, because the barotropicForcing variable
! subtracts out the barotropic component from the baroclinic.
normalBaroclinicVelocityCur(k,iEdge) = normalVelocityCur(k,iEdge) - normalBarotropicVelocityCur(iEdge)
@@ -263,29 +287,62 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
normalVelocityNew(k,iEdge) = normalVelocityCur(k,iEdge)
normalBaroclinicVelocityNew(k,iEdge) = normalBaroclinicVelocityCur(k,iEdge)
+ end do
+ end do
+ !$omp end do
- ! DWJ-POOL What's this for?
-! block % diagnostics % layerThicknessEdge % array(k,iEdge) &
-! = block % diagnostics % layerThicknessEdge % array(k,iEdge)
- end do
- end do
-
- sshNew(:) = sshCur(:)
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ sshNew(iCell) = sshCur(iCell)
+ end do
+ !$omp end do
- do iCell = 1, nCells
+ !$omp do schedule(runtime) private(k)
+ do iCell = 1, nCells
do k = 1, maxLevelCell(iCell)
layerThicknessNew(k,iCell) = layerThicknessCur(k,iCell)
-
- tracersNew(:,k,iCell) = tracersCur(:,k,iCell)
+ ! set vertAleTransportTop to zero for stage 1 velocity tendency, first time through.
+ vertAleTransportTop(k,iCell) = 0.0_RKIND
end do
end do
+ !$omp end do
+
+
+ threadnum = mpas_threading_get_thread_num()
+
+ call mpas_pool_begin_iteration(tracersPool)
+ do while ( mpas_pool_get_next_member(tracersPool, groupItr))
+ if ( groupItr % memberType == MPAS_POOL_FIELD ) then
+ call mpas_pool_get_array(tracersPool, groupItr % memberName, tracersGroupCur, 1)
+ call mpas_pool_get_array(tracersPool, groupItr % memberName, tracersGroupNew, 2)
+
+ if ( associated(tracersGroupCur) .and. associated(tracersGroupNew) ) then
+ !$omp do schedule(runtime) private(k)
+ do iCell = 1, nCells
+ do k = 1, maxLevelCell(iCell)
+ tracersGroupNew(:,k,iCell) = tracersGroupCur(:,k,iCell)
+ end do
+ end do
+ !$omp end do
+ end if
+ end if
+ end do
+
if (associated(highFreqThicknessNew)) then
- highFreqThicknessNew(:,:) = highFreqThicknessCur(:,:)
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ highFreqThicknessNew(:, iCell) = highFreqThicknessCur(:, iCell)
+ end do
+ !$omp end do
end if
if (associated(lowFreqDivergenceNew)) then
- lowFreqDivergenceNew(:,:) = lowFreqDivergenceCur(:,:)
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ lowFreqDivergenceNew(:, iCell) = lowFreqDivergenceCur(:, iCell)
+ end do
+ !$omp end do
endif
block => block % next
@@ -293,17 +350,20 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_timer_stop("se prep")
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! BEGIN large iteration loop
+ ! BEGIN large iteration loop
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
n_bcl_iter = config_n_bcl_iter_mid
n_bcl_iter(1) = config_n_bcl_iter_beg
n_bcl_iter(config_n_ts_iter) = config_n_bcl_iter_end
do split_explicit_step = 1, config_n_ts_iter
+ call mpas_timer_start('se loop', .false.)
+
stage1_tend_time = min(split_explicit_step,2)
call mpas_pool_get_subpool(domain % blocklist % structs, 'diagnostics', diagnosticsPool)
+ call mpas_threading_barrier()
! --- update halos for diagnostic ocean boundayr layer depth
call mpas_timer_start("se halo diag obd")
if (config_use_cvmix_kpp) then
@@ -329,10 +389,13 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
if (config_use_freq_filtered_thickness) then
call mpas_timer_start("se freq-filtered-thick computations")
+
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_subpool(block % structs, 'tend', tendPool)
+ call mpas_pool_get_subpool(tendPool, 'tracersTend', tracersTendPool)
call mpas_pool_get_subpool(block % structs, 'state', statepool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
@@ -341,10 +404,15 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
end do
call mpas_timer_stop("se freq-filtered-thick computations")
+ call mpas_threading_barrier()
+
call mpas_timer_start("se freq-filtered-thick halo update")
+
call mpas_dmpar_field_halo_exch(domain, 'tendHighFreqThickness')
call mpas_dmpar_field_halo_exch(domain, 'tendLowFreqDivergence')
+
call mpas_timer_stop("se freq-filtered-thick halo update")
+ call mpas_threading_barrier()
block => domain % blocklist
do while (associated(block))
@@ -352,7 +420,9 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'tend', tendPool)
+ call mpas_pool_get_subpool(tendPool, 'tracersTend', tracersTendPool)
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
@@ -361,27 +431,32 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_array(tendPool, 'highFreqThickness', highFreqThicknessTend)
+ !$omp do schedule(runtime) private(k)
do iCell = 1, nCells
do k = 1, maxLevelCell(iCell)
! this is h^{hf}_{n+1}
- highFreqThicknessNew(k,iCell) = highFreqThicknessCur(k,iCell) + dt * highFreqThicknessTend(k,iCell)
+ highFreqThicknessNew(k,iCell) = highFreqThicknessCur(k,iCell) + dt * highFreqThicknessTend(k,iCell)
end do
end do
+ !$omp end do
+
block => block % next
end do
endif
-
! compute velocity tendencies, T(u*,w*,p*)
call mpas_timer_start("se bcl vel")
+ call mpas_timer_start('se bcl vel tend', .false.)
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_subpool(block % structs, 'tend', tendPool)
+ call mpas_pool_get_subpool(tendPool, 'tracersTend', tracersTendPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'verticalMesh', verticalMeshPool)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool)
@@ -393,24 +468,12 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_array(statePool, 'highFreqThickness', highFreqThicknessNew, 2)
call mpas_pool_get_array(diagnosticsPool, 'layerThicknessEdge', layerThicknessEdge)
- call mpas_pool_get_array(diagnosticsPool, 'vertAleTransportTop', vertAleTransportTop)
-
- ! compute vertAleTransportTop. Use u (rather than normalTransportVelocity) for momentum advection.
- ! Use the most recent time level available.
- if (associated(highFreqThicknessNew)) then
- call ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, &
- layerThicknessCur, layerThicknessEdge, normalVelocityCur, &
- sshCur, dt, vertAleTransportTop, err, highFreqThicknessNew)
- else
- call ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, &
- layerThicknessCur, layerThicknessEdge, normalVelocityCur, &
- sshCur, dt, vertAleTransportTop, err)
- endif
- call ocn_tend_vel(tendPool, statePool, forcingPool, diagnosticsPool, meshPool, scratchPool, stage1_tend_time)
+ call ocn_tend_vel(tendPool, statePool, forcingPool, diagnosticsPool, meshPool, scratchPool, stage1_tend_time)
- block => block % next
+ block => block % next
end do
+ call mpas_timer_stop('se bcl vel tend')
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! BEGIN baroclinic iterations on linear Coriolis term
@@ -424,14 +487,17 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
split = 1
endif
+ call mpas_timer_start('bcl iters on linear Coriolis', .false.)
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_dimension(block % dimensions, 'nEdges', nEdges)
call mpas_pool_get_dimension(block % dimensions, 'nVertLevels', nVertLevels)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'tend', tendPool)
+ call mpas_pool_get_subpool(tendPool, 'tracersTend', tracersTendPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
@@ -448,19 +514,21 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_array(diagnosticsPool, 'layerThicknessEdge', layerThicknessEdge)
call mpas_pool_get_array(diagnosticsPool, 'barotropicForcing', barotropicForcing)
- allocate(uTemp(nVertLevels))
-
! Put f*normalBaroclinicVelocity^{perp} in normalVelocityNew as a work variable
call ocn_fuperp(statePool, meshPool, 2)
+ allocate(uTemp(nVertLevels))
+
+ !$omp do schedule(runtime) private(cell1, cell2, k, normalThicknessFluxSum, thicknessSum)
do iEdge = 1, nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
- uTemp = 0.0 ! could put this after with uTemp(maxleveledgetop+1:nvertlevels)=0
+ uTemp = 0.0_RKIND ! could put this after with uTemp(maxleveledgetop+1:nvertlevels)=0
do k = 1, maxLevelEdgeTop(iEdge)
- ! normalBaroclinicVelocityNew = normalBaroclinicVelocityOld + dt*(-f*normalBaroclinicVelocityPerp + T(u*,w*,p*) + g*grad(SSH*) )
+ ! normalBaroclinicVelocityNew = normalBaroclinicVelocityOld + dt*(-f*normalBaroclinicVelocityPerp
+ ! + T(u*,w*,p*) + g*grad(SSH*) )
! Here uNew is a work variable containing -fEdge(iEdge)*normalBaroclinicVelocityPerp(k,iEdge)
uTemp(k) = normalBaroclinicVelocityCur(k,iEdge) &
+ dt * (normalVelocityTend(k,iEdge) &
@@ -469,8 +537,8 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
/ dcEdge(iEdge) )
enddo
- ! thicknessSum is initialized outside the loop because on land boundaries
- ! maxLevelEdgeTop=0, but I want to initialize thicknessSum with a
+ ! thicknessSum is initialized outside the loop because on land boundaries
+ ! maxLevelEdgeTop=0, but I want to initialize thicknessSum with a
! nonzero value to avoid a NaN.
normalThicknessFluxSum = layerThicknessEdge(1,iEdge) * uTemp(1)
thicknessSum = layerThicknessEdge(1,iEdge)
@@ -485,31 +553,36 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
do k = 1, maxLevelEdgeTop(iEdge)
! These two steps are together here:
!{\bf u}'_{k,n+1} = {\bf u}'_{k,n} - \Delta t {\overline {\bf G}}
- !{\bf u}'_{k,n+1/2} = \frac{1}{2}\left({\bf u}^{'}_{k,n} +{\bf u}'_{k,n+1}\right)
+ !{\bf u}'_{k,n+1/2} = \frac{1}{2}\left({\bf u}^{'}_{k,n} +{\bf u}'_{k,n+1}\right)
! so that normalBaroclinicVelocityNew is at time n+1/2
- normalBaroclinicVelocityNew(k,iEdge) = 0.5*( &
+ normalBaroclinicVelocityNew(k,iEdge) = 0.5_RKIND*( &
normalBaroclinicVelocityCur(k,iEdge) + uTemp(k) - dt * barotropicForcing(iEdge))
enddo
-
+
enddo ! iEdge
+ !$omp end do
deallocate(uTemp)
block => block % next
end do
+ call mpas_timer_stop('bcl iters on linear Coriolis')
+
+ call mpas_threading_barrier()
call mpas_timer_start("se halo normalBaroclinicVelocity")
call mpas_dmpar_field_halo_exch(domain, 'normalBaroclinicVelocity', timeLevel=2)
call mpas_timer_stop("se halo normalBaroclinicVelocity")
+ call mpas_threading_barrier()
+
end do ! do j=1,config_n_bcl_iter
call mpas_timer_stop("se bcl vel")
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! END baroclinic iterations on linear Coriolis term
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
@@ -524,12 +597,14 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
if (trim(config_time_integrator) == 'unsplit_explicit') then
+ call mpas_timer_start('btr vel ue', .false.)
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_dimension(block % dimensions, 'nEdges', nEdges)
call mpas_pool_get_dimension(block % dimensions, 'nVertLevels', nVertLevels)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
@@ -542,31 +617,38 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_array(meshPool, 'edgeMask', edgeMask)
- ! For Split_Explicit unsplit, simply set normalBarotropicVelocityNew=0, normalBarotropicVelocitySubcycle=0, and uNew=normalBaroclinicVelocityNew
- normalBarotropicVelocityNew(:) = 0.0
+ ! For Split_Explicit unsplit, simply set normalBarotropicVelocityNew=0, normalBarotropicVelocitySubcycle=0, and
+ ! uNew=normalBaroclinicVelocityNew
- normalVelocityNew(:,:) = normalBaroclinicVelocityNew(:,:)
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ normalBarotropicVelocityNew(iEdge) = 0.0_RKIND
+ normalVelocityNew(:, iEdge) = normalBaroclinicVelocityNew(:, iEdge)
+ end do
+ !$omp end do
+ !$omp do schedule(runtime) private(k)
do iEdge = 1, nEdges
do k = 1, nVertLevels
- ! normalTransportVelocity = normalBaroclinicVelocity + normalGMBolusVelocity
- ! This is u used in advective terms for layerThickness and tracers
+ ! normalTransportVelocity = normalBaroclinicVelocity + normalGMBolusVelocity
+ ! This is u used in advective terms for layerThickness and tracers
! in tendency calls in stage 3.
-!mrp note: in QC version, there is an if (config_use_standardGM) on adding normalGMBolusVelocity
-! I think it is not needed because normalGMBolusVelocity=0 when GM not on.
normalTransportVelocity(k,iEdge) = edgeMask(k,iEdge) &
*( normalBaroclinicVelocityNew(k,iEdge) + normalGMBolusVelocity(k,iEdge) )
enddo
end do ! iEdge
-
+ !$omp end do
+
block => block % next
end do ! block
+ call mpas_timer_stop('btr vel ue')
elseif (trim(config_time_integrator) == 'split_explicit') then
! Initialize variables for barotropic subcycling
+ call mpas_timer_start('btr vel se init', .false.)
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_dimension(block % dimensions, 'nCells', nCells)
@@ -574,49 +656,61 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_array(diagnosticsPool, 'barotropicForcing', barotropicForcing)
call mpas_pool_get_array(diagnosticsPool, 'barotropicThicknessFlux', barotropicThicknessFlux)
call mpas_pool_get_array(statePool, 'ssh', sshCur, 1)
call mpas_pool_get_array(statePool, 'sshSubcycle', sshSubcycleCur, oldBtrSubcycleTime)
- call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleCur, oldBtrSubcycleTime)
+ call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleCur, &
+ oldBtrSubcycleTime)
call mpas_pool_get_array(statePool, 'normalBarotropicVelocity', normalBarotropicVelocityCur, 1)
call mpas_pool_get_array(statePool, 'normalBarotropicVelocity', normalBarotropicVelocityNew, 2)
if (config_filter_btr_mode) then
- barotropicForcing(:) = 0.0
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ barotropicForcing(iEdge) = 0.0_RKIND
+ end do
+ !$omp end do
endif
+ !$omp do schedule(runtime)
do iCell = 1, nCells
- ! sshSubcycleOld = sshOld
- sshSubcycleCur(iCell) = sshCur(iCell)
+ ! sshSubcycleOld = sshOld
+ sshSubcycleCur(iCell) = sshCur(iCell)
end do
+ !$omp end do
+ !$omp do schedule(runtime)
do iEdge = 1, nEdges
- ! normalBarotropicVelocitySubcycleOld = normalBarotropicVelocityOld
- normalBarotropicVelocitySubcycleCur(iEdge) = normalBarotropicVelocityCur(iEdge)
+ ! normalBarotropicVelocitySubcycleOld = normalBarotropicVelocityOld
+ normalBarotropicVelocitySubcycleCur(iEdge) = normalBarotropicVelocityCur(iEdge)
! normalBarotropicVelocityNew = BtrOld This is the first for the summation
- normalBarotropicVelocityNew(iEdge) = normalBarotropicVelocityCur(iEdge)
+ normalBarotropicVelocityNew(iEdge) = normalBarotropicVelocityCur(iEdge)
- ! barotropicThicknessFlux = 0
- barotropicThicknessFlux(iEdge) = 0.0
+ ! barotropicThicknessFlux = 0
+ barotropicThicknessFlux(iEdge) = 0.0_RKIND
end do
+ !$omp end do
block => block % next
end do ! block
+ call mpas_timer_stop('btr vel se init')
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! BEGIN Barotropic subcycle loop
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ call mpas_timer_start('btr se subcycle loop', .false.)
do j = 1, config_n_btr_subcycles * config_btr_subcycle_loop_factor
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Barotropic subcycle: VELOCITY PREDICTOR STEP
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- if (config_btr_gam1_velWt1 > 1.0e-12) then ! only do this part if it is needed in next SSH solve
+ if (config_btr_gam1_velWt1 > 1.0e-12_RKIND) then ! only do this part if it is needed in next SSH solve
uPerpTime = oldBtrSubcycleTime
block => domain % blocklist
@@ -625,6 +719,7 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
@@ -635,44 +730,53 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
call mpas_pool_get_array(meshPool, 'edgeMask', edgeMask)
- call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleCur, uPerpTime)
- call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleNew, newBtrSubcycleTime)
+ call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleCur, &
+ uPerpTime)
+ call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleNew, &
+ newBtrSubcycleTime)
call mpas_pool_get_array(statePool, 'sshSubcycle', sshSubcycleCur, oldBtrSubcycleTime)
call mpas_pool_get_array(diagnosticsPool, 'barotropicForcing', barotropicForcing)
+ !$omp do schedule(runtime) private(cell1, cell2, CoriolisTerm, i, eoe)
do iEdge = 1, nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
! Compute the barotropic Coriolis term, -f*uPerp
- CoriolisTerm = 0.0
+ CoriolisTerm = 0.0_RKIND
do i = 1, nEdgesOnEdge(iEdge)
eoe = edgesOnEdge(i,iEdge)
CoriolisTerm = CoriolisTerm + weightsOnEdge(i,iEdge) &
* normalBarotropicVelocitySubcycleCur(eoe) * fEdge(eoe)
end do
-
- ! normalBarotropicVelocityNew = normalBarotropicVelocityOld + dt/J*(-f*normalBarotropicVelocityoldPerp - g*grad(SSH) + G)
+
+ ! normalBarotropicVelocityNew = normalBarotropicVelocityOld + dt/J*(-f*normalBarotropicVelocityoldPerp
+ ! - g*grad(SSH) + G)
normalBarotropicVelocitySubcycleNew(iEdge) &
= (normalBarotropicVelocitySubcycleCur(iEdge) &
+ dt / config_n_btr_subcycles * (CoriolisTerm - gravity &
* (sshSubcycleCur(cell2) - sshSubcycleCur(cell1) ) &
/ dcEdge(iEdge) + barotropicForcing(iEdge))) * edgeMask(1, iEdge)
end do
+ !$omp end do
block => block % next
end do ! block
+ call mpas_threading_barrier()
+
! boundary update on normalBarotropicVelocityNew
call mpas_timer_start("se halo normalBarotropicVelocity")
+
call mpas_dmpar_field_halo_exch(domain, 'normalBarotropicVelocitySubcycle', timeLevel=newBtrSubcycleTime)
+
call mpas_timer_stop("se halo normalBarotropicVelocity")
endif ! config_btr_gam1_velWt1>1.0e-12
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Barotropic subcycle: SSH PREDICTOR STEP
+ ! Barotropic subcycle: SSH PREDICTOR STEP
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
block => domain % blocklist
do while (associated(block))
@@ -680,8 +784,10 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_dimension(block % dimensions, 'nEdges', nEdges)
call mpas_pool_get_subpool(block % structs, 'tend', tendPool)
+ call mpas_pool_get_subpool(tendPool, 'tracersTend', tracersTendPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_array(tendPool, 'ssh', sshTend)
@@ -698,27 +804,34 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_array(statePool, 'sshSubcycle', sshSubcycleCur, oldBtrSubcycleTime)
call mpas_pool_get_array(statePool, 'sshSubcycle', sshSubcycleNew, newBtrSubcycleTime)
- call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleCur, oldBtrSubcycleTime)
- call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleNew, newBtrSubcycleTime)
+ call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleCur, &
+ oldBtrSubcycleTime)
+ call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleNew, &
+ newBtrSubcycleTime)
call mpas_pool_get_array(diagnosticsPool, 'barotropicThicknessFlux', barotropicThicknessFlux)
-
- sshTend(:) = 0.0
-
+
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ sshTend(iCell) = 0.0_RKIND
+ end do
+ !$omp end do
+
if (config_btr_solve_SSH2) then
- ! If config_btr_solve_SSH2=.true., then do NOT accumulate barotropicThicknessFlux in this SSH predictor
+ ! If config_btr_solve_SSH2=.true., then do NOT accumulate barotropicThicknessFlux in this SSH predictor
! section, because it will be accumulated in the SSH corrector section.
- barotropicThicknessFlux_coeff = 0.0
+ barotropicThicknessFlux_coeff = 0.0_RKIND
else
! otherwise, DO accumulate barotropicThicknessFlux in this SSH predictor section
- barotropicThicknessFlux_coeff = 1.0
+ barotropicThicknessFlux_coeff = 1.0_RKIND
endif
-
+
! config_btr_gam1_velWt1 sets the forward weighting of velocity in the SSH computation
! config_btr_gam1_velWt1= 1 flux = normalBarotropicVelocityNew*H
! config_btr_gam1_velWt1=0.5 flux = 1/2*(normalBarotropicVelocityNew+normalBarotropicVelocityOld)*H
! config_btr_gam1_velWt1= 0 flux = normalBarotropicVelocityOld*H
+ !$omp do schedule(runtime) private(i, iEdge, cell1, cell2, sshEdge, thicknessSum, flux)
do iCell = 1, nCells
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
@@ -726,11 +839,11 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
cell1 = cellsOnEdge(1, iEdge)
cell2 = cellsOnEdge(2, iEdge)
- sshEdge = 0.5 * (sshSubcycleCur(cell1) + sshSubcycleCur(cell2) )
+ sshEdge = 0.5_RKIND * (sshSubcycleCur(cell1) + sshSubcycleCur(cell2) )
- ! method 0: orig, works only without pbc:
+ ! method 0: orig, works only without pbc:
!thicknessSum = sshEdge + refBottomDepthTopOfCell(maxLevelEdgeTop(iEdge)+1)
-
+
! method 1, matches method 0 without pbcs, works with pbcs.
thicknessSum = sshEdge + min(bottomDepth(cell1), bottomDepth(cell2))
@@ -741,24 +854,26 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
flux = ((1.0-config_btr_gam1_velWt1) * normalBarotropicVelocitySubcycleCur(iEdge) &
+ config_btr_gam1_velWt1 * normalBarotropicVelocitySubcycleNew(iEdge)) &
- * thicknessSum
+ * thicknessSum
sshTend(iCell) = sshTend(iCell) + edgeSignOncell(i, iCell) * flux &
* dvEdge(iEdge)
end do
end do
+ !$omp end do
+ !$omp do schedule(runtime) private(cell1, cell2, sshEdge, thicknessSum, flux)
do iEdge = 1, nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
- sshEdge = 0.5 * (sshSubcycleCur(cell1) &
+ sshEdge = 0.5_RKIND * (sshSubcycleCur(cell1) &
+ sshSubcycleCur(cell2) )
- ! method 0: orig, works only without pbc:
+ ! method 0: orig, works only without pbc:
!thicknessSum = sshEdge + refBottomDepthTopOfCell(maxLevelEdgeTop(iEdge)+1)
-
+
! method 1, matches method 0 without pbcs, works with pbcs.
thicknessSum = sshEdge + min(bottomDepth(cell1), bottomDepth(cell2))
@@ -769,40 +884,49 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
flux = ((1.0-config_btr_gam1_velWt1) * normalBarotropicVelocitySubcycleCur(iEdge) &
+ config_btr_gam1_velWt1 * normalBarotropicVelocitySubcycleNew(iEdge)) &
- * thicknessSum
+ * thicknessSum
barotropicThicknessFlux(iEdge) = barotropicThicknessFlux(iEdge) + barotropicThicknessFlux_coeff * flux
end do
-
+ !$omp end do
+
! SSHnew = SSHold + dt/J*(-div(Flux))
- do iCell = 1, nCells
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
sshSubcycleNew(iCell) = sshSubcycleCur(iCell) + dt / config_n_btr_subcycles * sshTend(iCell) / areaCell(iCell)
end do
-
+ !$omp end do
+
block => block % next
end do ! block
-
+
+ call mpas_threading_barrier()
+
! boundary update on SSHnew
call mpas_timer_start("se halo ssh")
call mpas_dmpar_field_halo_exch(domain, 'sshSubcycle', timeLevel=newBtrSubcycleTime)
call mpas_timer_stop("se halo ssh")
-
+
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Barotropic subcycle: VELOCITY CORRECTOR STEP
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
do BtrCorIter = 1, config_n_btr_cor_iter
uPerpTime = newBtrSubcycleTime
-
+
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_dimension(block % dimensions, 'nEdges', nEdges)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
- call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleCur, oldBtrSubcycleTime)
- call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleNew, newBtrSubcycleTime)
+ call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleCur, &
+ oldBtrSubcycleTime)
+ call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleNew, &
+ newBtrSubcycleTime)
call mpas_pool_get_array(statePool, 'sshSubcycle', sshSubcycleCur, oldBtrSubcycleTime)
call mpas_pool_get_array(statePool, 'sshSubcycle', sshSubcycleNew, newBtrSubcycleTime)
@@ -816,56 +940,76 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_array(diagnosticsPool, 'barotropicForcing', barotropicForcing)
- allocate(utemp(nEdges+1))
+ call mpas_pool_get_field(scratchPool, 'btrvel_temp', btrvel_tempField)
+ call mpas_allocate_scratch_field(btrvel_tempField, .true.)
+ call mpas_threading_barrier()
+ btrvel_temp => btrvel_tempField % array
+
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ btrvel_temp(iEdge) = normalBarotropicVelocitySubcycleNew(iEdge)
+ end do
+ !$omp end do
- uTemp(:) = normalBarotropicVelocitySubcycleNew(:)
- do iEdge = 1, nEdges
+ !$omp do schedule(runtime) private(cell1, cell2, eoe, CoriolisTerm, i, sshCell1, sshCell2)
+ do iEdge = 1, nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
-
+
! Compute the barotropic Coriolis term, -f*uPerp
- CoriolisTerm = 0.0
+ CoriolisTerm = 0.0_RKIND
do i = 1, nEdgesOnEdge(iEdge)
eoe = edgesOnEdge(i,iEdge)
CoriolisTerm = CoriolisTerm + weightsOnEdge(i,iEdge) &
!* normalBarotropicVelocitySubcycleNew(eoe) &
- * uTemp(eoe) * fEdge(eoe)
+ * btrvel_temp(eoe) * fEdge(eoe)
end do
-
+
! In this final solve for velocity, SSH is a linear
! combination of SSHold and SSHnew.
sshCell1 = (1-config_btr_gam2_SSHWt1) * sshSubcycleCur(cell1) + config_btr_gam2_SSHWt1 * sshSubcycleNew(cell1)
sshCell2 = (1-config_btr_gam2_SSHWt1) * sshSubcycleCur(cell2) + config_btr_gam2_SSHWt1 * sshSubcycleNew(cell2)
-
- ! normalBarotropicVelocityNew = normalBarotropicVelocityOld + dt/J*(-f*normalBarotropicVelocityoldPerp - g*grad(SSH) + G)
- normalBarotropicVelocitySubcycleNew(iEdge) = (normalBarotropicVelocitySubcycleCur(iEdge) &
+
+ ! normalBarotropicVelocityNew = normalBarotropicVelocityOld + dt/J*(-f*normalBarotropicVelocityoldPerp
+ ! - g*grad(SSH) + G)
+ normalBarotropicVelocitySubcycleNew(iEdge) = (normalBarotropicVelocitySubcycleCur(iEdge) &
+ dt / config_n_btr_subcycles *(CoriolisTerm - gravity *(sshCell2 - sshCell1) / dcEdge(iEdge) &
+ barotropicForcing(iEdge))) * edgeMask(1,iEdge)
end do
- deallocate(uTemp)
-
+ !$omp end do
+
+ call mpas_threading_barrier()
+ call mpas_deallocate_scratch_field(btrvel_tempField, .true.)
+ call mpas_threading_barrier()
+
block => block % next
end do ! block
-
+
+ call mpas_threading_barrier()
+
! boundary update on normalBarotropicVelocityNew
call mpas_timer_start("se halo normalBarotropicVelocity")
+
call mpas_dmpar_field_halo_exch(domain, 'normalBarotropicVelocitySubcycle', timeLevel=newBtrSubcycleTime)
+
call mpas_timer_stop("se halo normalBarotropicVelocity")
end do !do BtrCorIter=1,config_n_btr_cor_iter
-
+
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Barotropic subcycle: SSH CORRECTOR STEP
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
if (config_btr_solve_SSH2) then
-
+
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_dimension(block % dimensions, 'nCells', nCells)
call mpas_pool_get_dimension(block % dimensions, 'nEdges', nEdges)
call mpas_pool_get_subpool(block % structs, 'tend', tendPool)
+ call mpas_pool_get_subpool(tendPool, 'tracersTend', tracersTendPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_array(tendPool, 'ssh', sshTend)
@@ -881,18 +1025,24 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_array(statePool, 'sshSubcycle', sshSubcycleCur, oldBtrSubcycleTime)
call mpas_pool_get_array(statePool, 'sshSubcycle', sshSubcycleNew, newBtrSubcycleTime)
- call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleCur, oldBtrSubcycleTime)
- call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleNew, newBtrSubcycleTime)
+ call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleCur, &
+ oldBtrSubcycleTime)
+ call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleNew, &
+ newBtrSubcycleTime)
call mpas_pool_get_array(diagnosticsPool, 'barotropicThicknessFlux', barotropicThicknessFlux)
-
- sshTend(:) = 0.0
-
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ sshTend(iCell) = 0.0_RKIND
+ end do
+ !$omp end do
+
! config_btr_gam3_velWt2 sets the forward weighting of velocity in the SSH computation
! config_btr_gam3_velWt2= 1 flux = normalBarotropicVelocityNew*H
! config_btr_gam3_velWt2=0.5 flux = 1/2*(normalBarotropicVelocityNew+normalBarotropicVelocityOld)*H
! config_btr_gam3_velWt2= 0 flux = normalBarotropicVelocityOld*H
+ !$omp do schedule(runtime) private(i, iEdge, cell1, cell2, sshCell1, sshCell2, sshEdge, thicknessSum, flux)
do iCell = 1, nCells
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
@@ -905,19 +1055,19 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
+ config_btr_gam2_SSHWt1 * sshSubcycleNew(cell1)
sshCell2 = (1-config_btr_gam2_SSHWt1)* sshSubcycleCur(cell2) &
+ config_btr_gam2_SSHWt1 * sshSubcycleNew(cell2)
-
- sshEdge = 0.5 * (sshCell1 + sshCell2)
- ! method 0: orig, works only without pbc:
+ sshEdge = 0.5_RKIND * (sshCell1 + sshCell2)
+
+ ! method 0: orig, works only without pbc:
!thicknessSum = sshEdge + refBottomDepthTopOfCell(maxLevelEdgeTop(iEdge)+1)
-
+
! method 1, matches method 0 without pbcs, works with pbcs.
thicknessSum = sshEdge + min(bottomDepth(cell1), bottomDepth(cell2))
! method 2: may be better than method 1.
! take average of full thickness at two neighboring cells
!thicknessSum = sshEdge + 0.5 *( bottomDepth(cell1) + bottomDepth (cell2) )
-
+
flux = ((1.0-config_btr_gam3_velWt2) * normalBarotropicVelocitySubcycleCur(iEdge) &
+ config_btr_gam3_velWt2 * normalBarotropicVelocitySubcycleNew(iEdge)) &
* thicknessSum
@@ -927,120 +1077,146 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
end do
end do
+ !$omp end do
+ !$omp do schedule(runtime) private(cell1, cell2, sshCell1, sshCell2, sshEdge, thicknessSum, flux)
do iEdge = 1, nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
-
+
! SSH is a linear combination of SSHold and SSHnew.
sshCell1 = (1-config_btr_gam2_SSHWt1)* sshSubcycleCur(cell1) + config_btr_gam2_SSHWt1 * sshSubcycleNew(cell1)
sshCell2 = (1-config_btr_gam2_SSHWt1)* sshSubcycleCur(cell2) + config_btr_gam2_SSHWt1 * sshSubcycleNew(cell2)
- sshEdge = 0.5 * (sshCell1 + sshCell2)
+ sshEdge = 0.5_RKIND * (sshCell1 + sshCell2)
- ! method 0: orig, works only without pbc:
+ ! method 0: orig, works only without pbc:
!thicknessSum = sshEdge + refBottomDepthTopOfCell(maxLevelEdgeTop(iEdge)+1)
-
+
! method 1, matches method 0 without pbcs, works with pbcs.
thicknessSum = sshEdge + min(bottomDepth(cell1), bottomDepth(cell2))
! method 2, better, I think.
! take average of full thickness at two neighboring cells
!thicknessSum = sshEdge + 0.5 *( bottomDepth(cell1) + bottomDepth(cell2) )
-
+
flux = ((1.0-config_btr_gam3_velWt2) * normalBarotropicVelocitySubcycleCur(iEdge) &
+ config_btr_gam3_velWt2 * normalBarotropicVelocitySubcycleNew(iEdge)) &
* thicknessSum
-
+
barotropicThicknessFlux(iEdge) = barotropicThicknessFlux(iEdge) + flux
end do
-
+ !$omp end do
+
! SSHnew = SSHold + dt/J*(-div(Flux))
- do iCell = 1, nCells
- sshSubcycleNew(iCell) = sshSubcycleCur(iCell) &
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ sshSubcycleNew(iCell) = sshSubcycleCur(iCell) &
+ dt / config_n_btr_subcycles * sshTend(iCell) / areaCell(iCell)
end do
-
+ !$omp end do
+
block => block % next
end do ! block
-
+
+ call mpas_threading_barrier()
+
! boundary update on SSHnew
call mpas_timer_start("se halo ssh")
+
call mpas_dmpar_field_halo_exch(domain, 'sshSubcycle')
+
call mpas_timer_stop("se halo ssh")
endif ! config_btr_solve_SSH2
-
+
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Barotropic subcycle: Accumulate running sums, advance timestep pointers
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
+
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_dimension(block % dimensions, 'nEdges', nEdges)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_array(statePool, 'normalBarotropicVelocity', normalBarotropicVelocityNew, 2)
- call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleNew, newBtrSubcycleTime)
-
+ call mpas_pool_get_array(statePool, 'normalBarotropicVelocitySubcycle', normalBarotropicVelocitySubcycleNew, &
+ newBtrSubcycleTime)
+
! normalBarotropicVelocityNew = normalBarotropicVelocityNew + normalBarotropicVelocitySubcycleNEW
! This accumulates the sum.
- ! If the Barotropic Coriolis iteration is limited to one, this could
+ ! If the Barotropic Coriolis iteration is limited to one, this could
! be merged with the above code.
- do iEdge = 1, nEdges
- normalBarotropicVelocityNew(iEdge) = normalBarotropicVelocityNew(iEdge) + normalBarotropicVelocitySubcycleNew(iEdge)
+
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ normalBarotropicVelocityNew(iEdge) = normalBarotropicVelocityNew(iEdge) &
+ + normalBarotropicVelocitySubcycleNew(iEdge)
end do ! iEdge
+ !$omp end do
+
block => block % next
end do ! block
-
+
! advance time pointers
oldBtrSubcycleTime = mod(oldBtrSubcycleTime,2)+1
newBtrSubcycleTime = mod(newBtrSubcycleTime,2)+1
-
+
end do ! j=1,config_n_btr_subcycles
+ call mpas_timer_stop('btr se subcycle loop')
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! END Barotropic subcycle loop
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Normalize Barotropic subcycle sums: ssh, normalBarotropicVelocity, and F
+ call mpas_timer_start('btr se norm', .false.)
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_dimension(block % dimensions, 'nEdges', nEdges)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_array(statePool, 'normalBarotropicVelocity', normalBarotropicVelocityNew, 2)
call mpas_pool_get_array(diagnosticsPool, 'barotropicThicknessFlux', barotropicThicknessFlux)
-
+
+ !$omp do schedule(runtime)
do iEdge = 1, nEdges
barotropicThicknessFlux(iEdge) = barotropicThicknessFlux(iEdge) &
/ (config_n_btr_subcycles * config_btr_subcycle_loop_factor)
-
- normalBarotropicVelocityNew(iEdge) = normalBarotropicVelocityNew(iEdge) &
+
+ normalBarotropicVelocityNew(iEdge) = normalBarotropicVelocityNew(iEdge) &
/ (config_n_btr_subcycles * config_btr_subcycle_loop_factor + 1)
end do
-
+ !$omp end do
+
block => block % next
end do ! block
-
-
+ call mpas_timer_stop('btr se norm')
+
+ call mpas_threading_barrier()
+
! boundary update on F
call mpas_timer_start("se halo F")
call mpas_dmpar_field_halo_exch(domain, 'barotropicThicknessFlux')
call mpas_timer_stop("se halo F")
+ call mpas_threading_barrier()
! Check that you can compute SSH using the total sum or the individual increments
! over the barotropic subcycles.
- ! efficiency: This next block of code is really a check for debugging, and can
+ ! efficiency: This next block of code is really a check for debugging, and can
! be removed later.
+ call mpas_timer_start('btr se ssh verif', .false.)
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_dimension(block % dimensions, 'nEdges', nEdges)
call mpas_pool_get_dimension(block % dimensions, 'nVertLevels', nVertLevels)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
@@ -1059,9 +1235,9 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
! Correction velocity normalVelocityCorrection = (Flux - Sum(h u*))/H
! or, for the full latex version:
- !{\bf u}^{corr} = \left( {\overline {\bf F}}
+ !{\bf u}^{corr} = \left( {\overline {\bf F}}
! - \sum_{k=1}^{N^{edge}} h_{k,*}^{edge} {\bf u}_k^{avg} \right)
- ! \left/ \sum_{k=1}^{N^{edge}} h_{k,*}^{edge} \right.
+ ! \left/ \sum_{k=1}^{N^{edge}} h_{k,*}^{edge} \right.
if (config_vel_correction) then
useVelocityCorrection = 1
@@ -1069,15 +1245,15 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
useVelocityCorrection = 0
endif
+ !$omp do schedule(runtime) private(k, normalThicknessFluxSum, thicknessSum, normalVelocityCorrection)
do iEdge = 1, nEdges
! velocity for normalVelocityCorrectionection is normalBarotropicVelocity + normalBaroclinicVelocity + uBolus
-!mrp note: in QC version, there is an if (config_use_standardGM) on adding normalGMBolusVelocity
-! I think it is not needed because normalGMBolusVelocity=0 when GM not on.
- uTemp(:) = normalBarotropicVelocityNew(iEdge) + normalBaroclinicVelocityNew(:,iEdge) + normalGMBolusVelocity(:,iEdge)
+ uTemp(:) = normalBarotropicVelocityNew(iEdge) + normalBaroclinicVelocityNew(:,iEdge) &
+ + normalGMBolusVelocity(:,iEdge)
- ! thicknessSum is initialized outside the loop because on land boundaries
- ! maxLevelEdgeTop=0, but I want to initialize thicknessSum with a
+ ! thicknessSum is initialized outside the loop because on land boundaries
+ ! maxLevelEdgeTop=0, but I want to initialize thicknessSum with a
! nonzero value to avoid a NaN.
normalThicknessFluxSum = layerThicknessEdge(1,iEdge) * uTemp(1)
thicknessSum = layerThicknessEdge(1,iEdge)
@@ -1087,12 +1263,14 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
thicknessSum = thicknessSum + layerThicknessEdge(k,iEdge)
enddo
- normalVelocityCorrection = useVelocityCorrection*(( barotropicThicknessFlux(iEdge) - normalThicknessFluxSum)/thicknessSum)
+ normalVelocityCorrection = useVelocityCorrection * (( barotropicThicknessFlux(iEdge) - normalThicknessFluxSum) &
+ / thicknessSum)
do k = 1, nVertLevels
- ! normalTransportVelocity = normalBarotropicVelocity + normalBaroclinicVelocity + normalGMBolusVelocity + normalVelocityCorrection
- ! This is u used in advective terms for layerThickness and tracers
+ ! normalTransportVelocity = normalBarotropicVelocity + normalBaroclinicVelocity + normalGMBolusVelocity
+ ! + normalVelocityCorrection
+ ! This is u used in advective terms for layerThickness and tracers
! in tendency calls in stage 3.
!mrp note: in QC version, there is an if (config_use_standardGM) on adding normalGMBolusVelocity
! I think it is not needed because normalGMBolusVelocity=0 when GM not on.
@@ -1103,13 +1281,15 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
enddo
end do ! iEdge
+ !$omp end do
deallocate(uTemp)
block => block % next
end do ! block
+ call mpas_timer_stop('btr se ssh verif')
- endif ! split_explicit
+ endif ! split_explicit
call mpas_timer_stop("se btr vel")
@@ -1119,15 +1299,19 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Thickness tendency computations and thickness halo updates are completed before tracer
+ ! Thickness tendency computations and thickness halo updates are completed before tracer
! tendency computations to allow monotonic advection.
+ call mpas_timer_start('se thick tend', .false.)
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'verticalMesh', verticalMeshPool)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'tend', tendPool)
+ call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
+ call mpas_pool_get_subpool(tendPool, 'tracersTend', tracersTendPool)
call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool)
call mpas_pool_get_array(statePool, 'layerThickness', layerThicknessCur, 1)
@@ -1139,45 +1323,73 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_array(diagnosticsPool, 'vertAleTransportTop', vertAleTransportTop)
! compute vertAleTransportTop. Use normalTransportVelocity for advection of layerThickness and tracers.
- ! Use time level 1 values of layerThickness and layerThicknessEdge because
+ ! Use time level 1 values of layerThickness and layerThicknessEdge because
! layerThickness has not yet been computed for time level 2.
- if (associated(highFreqThicknessNew)) then
- call ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, &
+ call mpas_timer_start('thick vert trans vel top', .false.)
+ if (associated(highFreqThicknessNew)) then
+ call ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, scratchPool, &
layerThicknessCur, layerThicknessEdge, normalTransportVelocity, &
sshCur, dt, vertAleTransportTop, err, highFreqThicknessNew)
else
- call ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, &
+ call ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, scratchPool, &
layerThicknessCur, layerThicknessEdge, normalTransportVelocity, &
sshCur, dt, vertAleTransportTop, err)
endif
+ call mpas_timer_stop('thick vert trans vel top')
call ocn_tend_thick(tendPool, forcingPool, diagnosticsPool, meshPool)
block => block % next
end do
+ call mpas_timer_stop('se thick tend')
+
+ call mpas_threading_barrier()
! update halo for thickness tendencies
call mpas_timer_start("se halo thickness")
+
call mpas_dmpar_field_halo_exch(domain, 'tendLayerThickness')
+
call mpas_timer_stop("se halo thickness")
+ call mpas_threading_barrier()
+
+ call mpas_timer_start('se tracer tend', .false.)
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_subpool(block % structs, 'tend', tendPool)
+ call mpas_pool_get_subpool(tendPool, 'tracersTend', tracersTendPool)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
- call ocn_tend_tracer(tendPool, statePool, forcingPool, diagnosticsPool, meshPool, scratchPool, dt, 2)
+ call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
+ call mpas_pool_get_subpool(block % structs, 'shortwave', swForcingPool)
+ call ocn_tend_tracer(tendPool, statePool, forcingPool, diagnosticsPool, meshPool, swForcingPool, scratchPool, dt, 2)
block => block % next
end do
+ call mpas_timer_stop('se tracer tend')
+
+ call mpas_threading_barrier()
! update halo for tracer tendencies
call mpas_timer_start("se halo tracers")
- call mpas_dmpar_field_halo_exch(domain, 'tendTracers')
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'tend', tendPool)
+ call mpas_pool_get_subpool(tendPool, 'tracersTend', tracersTendPool)
+
+ call mpas_pool_begin_iteration(tracersTendPool)
+ do while ( mpas_pool_get_next_member(tracersTendPool, groupItr) )
+ if ( groupItr % memberType == MPAS_POOL_FIELD ) then
+ call mpas_dmpar_field_halo_exch(domain, groupItr % memberName)
+ end if
+ end do
call mpas_timer_stop("se halo tracers")
+ call mpas_threading_barrier()
+
+ call mpas_timer_start('se loop fini', .false.)
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_dimension(block % dimensions, 'nCells', nCells)
@@ -1186,19 +1398,19 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'tend', tendPool)
+ call mpas_pool_get_subpool(tendPool, 'tracersTend', tracersTendPool)
call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool)
call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
- call mpas_pool_get_dimension(statePool, 'num_tracers', num_tracers)
-
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
call mpas_pool_get_array(meshPool, 'edgeMask', edgeMask)
call mpas_pool_get_array(meshPool, 'maxLevelEdgeTop', maxLevelEdgeTop)
- call mpas_pool_get_array(statePool, 'tracers', tracersCur, 1)
- call mpas_pool_get_array(statePool, 'tracers', tracersNew, 2)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', tracersGroupCur, 1)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', tracersGroupNew, 2)
call mpas_pool_get_array(statePool, 'layerThickness', layerThicknessCur, 1)
call mpas_pool_get_array(statePool, 'layerThickness', layerThicknessNew, 2)
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocityCur, 1)
@@ -1212,12 +1424,13 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_array(statePool, 'normalBaroclinicVelocity', normalBaroclinicVelocityCur, 1)
call mpas_pool_get_array(statePool, 'normalBaroclinicVelocity', normalBaroclinicVelocityNew, 2)
- call mpas_pool_get_array(tendPool, 'tracers', tracersTend)
call mpas_pool_get_array(tendPool, 'layerThickness', layerThicknessTend)
call mpas_pool_get_array(tendPool, 'normalVelocity', normalVelocityTend)
call mpas_pool_get_array(tendPool, 'highFreqThickness', highFreqThicknessTend)
call mpas_pool_get_array(tendPool, 'lowFreqDivergence', lowFreqDivergenceTend)
+ call mpas_pool_get_array(tracersTendPool, 'activeTracersTend', activeTracersTend)
+
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! If iterating, reset variables for next iteration
@@ -1226,66 +1439,77 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
if (split_explicit_step < config_n_ts_iter) then
! Get indices for dynamic tracers (Includes T&S).
- call mpas_pool_get_dimension(statePool, 'dynamics_start', startIndex)
- call mpas_pool_get_dimension(statePool, 'dynamics_end', endIndex)
+ call mpas_pool_get_dimension(tracersPool, 'activeGRP_start', startIndex)
+ call mpas_pool_get_dimension(tracersPool, 'activeGRP_end', endIndex)
! Only need T & S for earlier iterations,
! then all the tracers needed the last time through.
+
+ !$omp do schedule(runtime) private(k, temp_h, temp, i)
do iCell = 1, nCells
! sshNew is a pointer, defined above.
do k = 1, maxLevelCell(iCell)
! this is h_{n+1}
- temp_h = layerThicknessCur(k,iCell) + dt * layerThicknessTend(k,iCell)
+ temp_h = layerThicknessCur(k,iCell) + dt * layerThicknessTend(k,iCell)
! this is h_{n+1/2}
layerThicknessNew(k,iCell) = 0.5*( layerThicknessCur(k,iCell) + temp_h)
do i = startIndex, endIndex
! This is Phi at n+1
- temp = ( tracersCur(i,k,iCell) * layerThicknessCur(k,iCell) + dt * tracersTend(i,k,iCell)) / temp_h
-
+ temp = ( tracersGroupCur(i,k,iCell) * layerThicknessCur(k,iCell) + dt * activeTracersTend(i,k,iCell)) &
+ / temp_h
+
! This is Phi at n+1/2
- tracersNew(i,k,iCell) = 0.5 * ( tracersCur(i,k,iCell) + temp )
+ tracersGroupNew(i,k,iCell) = 0.5_RKIND * ( tracersGroupCur(i,k,iCell) + temp )
end do
end do
end do ! iCell
+ !$omp end do
if (config_use_freq_filtered_thickness) then
+ !$omp do schedule(runtime) private(k, temp)
do iCell = 1, nCells
do k = 1, maxLevelCell(iCell)
! h^{hf}_{n+1} was computed in Stage 1
! this is h^{hf}_{n+1/2}
- highFreqThicknessnew(k,iCell) = 0.5 * (highFreqThicknessCur(k,iCell) + highFreqThicknessNew(k,iCell))
+ highFreqThicknessnew(k,iCell) = 0.5_RKIND * (highFreqThicknessCur(k,iCell) + highFreqThicknessNew(k,iCell))
! this is D^{lf}_{n+1}
temp = lowFreqDivergenceCur(k,iCell) &
- + dt * lowFreqDivergenceTend(k,iCell)
+ + dt * lowFreqDivergenceTend(k,iCell)
! this is D^{lf}_{n+1/2}
- lowFreqDivergenceNew(k,iCell) = 0.5 * (lowFreqDivergenceCur(k,iCell) + temp)
+ lowFreqDivergenceNew(k,iCell) = 0.5_RKIND * (lowFreqDivergenceCur(k,iCell) + temp)
end do
end do
+ !$omp end do
end if
+ !$omp do schedule(runtime) private(k)
do iEdge = 1, nEdges
do k = 1, nVertLevels
- ! u = normalBarotropicVelocity + normalBaroclinicVelocity
+ ! u = normalBarotropicVelocity + normalBaroclinicVelocity
! here normalBaroclinicVelocity is at time n+1/2
! This is u used in next iteration or step
- normalVelocityNew(k,iEdge) = edgeMask(k,iEdge) * ( normalBarotropicVelocityNew(iEdge) + normalBaroclinicVelocityNew(k,iEdge) )
+ normalVelocityNew(k,iEdge) = edgeMask(k,iEdge) * ( normalBarotropicVelocityNew(iEdge) &
+ + normalBaroclinicVelocityNew(k,iEdge) )
enddo
end do ! iEdge
+ !$omp end do
- ! Efficiency note: We really only need this to compute layerThicknessEdge, density, pressure, and SSH
+ ! Efficiency note: We really only need this to compute layerThicknessEdge, density, pressure, and SSH
! in this diagnostics solve.
- call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, 2)
+ call mpas_timer_start("slf diag solve", .false.)
+ call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, tracersPool, 2)
+ call mpas_timer_stop("slf diag solve")
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
@@ -1294,128 +1518,182 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
elseif (split_explicit_step == config_n_ts_iter) then
+ !$omp do schedule(runtime) private(k)
do iCell = 1, nCells
do k = 1, maxLevelCell(iCell)
-
! this is h_{n+1}
- layerThicknessNew(k,iCell) = layerThicknessCur(k,iCell) + dt * layerThicknessTend(k,iCell)
-
- ! This is Phi at n+1
- do i = 1, num_tracers
- tracersNew(i,k,iCell) = (tracersCur(i,k,iCell) * layerThicknessCur(k,iCell) + dt * tracersTend(i,k,iCell) ) &
- / layerThicknessNew(k,iCell)
-
- enddo
+ layerThicknessNew(k,iCell) = layerThicknessCur(k,iCell) + dt * layerThicknessTend(k,iCell)
end do
end do
+ !$omp end do
+
+ call mpas_pool_begin_iteration(tracersPool)
+ do while ( mpas_pool_get_next_member(tracersPool, groupItr) )
+ if ( groupItr % memberType == MPAS_POOL_FIELD ) then
+ configName = 'config_use_' // trim(groupItr % memberName)
+ call mpas_pool_get_config(domain % configs, configName, config_use_tracerGroup)
+
+ if ( config_use_tracerGroup ) then
+ call mpas_pool_get_array(tracersPool, groupItr % memberName, tracersGroupCur, 1)
+ call mpas_pool_get_array(tracersPool, groupItr % memberName, tracersGroupNew, 2)
+
+ modifiedGroupName = trim(groupItr % memberName) // 'Tend'
+ call mpas_pool_get_array(tracersTendPool, modifiedGroupName, tracersGroupTend)
+
+ !$omp do schedule(runtime) private(k)
+ do iCell = 1, nCells
+ do k = 1, maxLevelCell(iCell)
+ tracersGroupNew(:,k,iCell) = (tracersGroupCur(:,k,iCell) * layerThicknessCur(k,iCell) + dt &
+ * tracersGroupTend(:,k,iCell) ) / layerThicknessNew(k,iCell)
+ end do
+ end do
+ !$omp end do
+ end if
+ end if
+ end do
if (config_use_freq_filtered_thickness) then
+ !$omp do schedule(runtime) private(k)
do iCell = 1, nCells
do k = 1, maxLevelCell(iCell)
! h^{hf}_{n+1} was computed in Stage 1
! this is D^{lf}_{n+1}
- lowFreqDivergenceNew(k,iCell) = lowFreqDivergenceCur(k,iCell) + dt * lowFreqDivergenceTend(k,iCell)
+ lowFreqDivergenceNew(k,iCell) = lowFreqDivergenceCur(k,iCell) + dt * lowFreqDivergenceTend(k,iCell)
end do
end do
+ !$omp end do
end if
! Recompute final u to go on to next step.
- ! u_{n+1} = normalBarotropicVelocity_{n+1} + normalBaroclinicVelocity_{n+1}
- ! Right now normalBaroclinicVelocityNew is at time n+1/2, so back compute to get normalBaroclinicVelocity at time n+1
- ! using normalBaroclinicVelocity_{n+1/2} = 1/2*(normalBaroclinicVelocity_n + u_Bcl_{n+1})
+ ! u_{n+1} = normalBarotropicVelocity_{n+1} + normalBaroclinicVelocity_{n+1}
+ ! Right now normalBaroclinicVelocityNew is at time n+1/2, so back compute to get normalBaroclinicVelocity
+ ! at time n+1 using normalBaroclinicVelocity_{n+1/2} = 1/2*(normalBaroclinicVelocity_n + u_Bcl_{n+1})
! so the following lines are
! u_{n+1} = normalBarotropicVelocity_{n+1} + 2*normalBaroclinicVelocity_{n+1/2} - normalBaroclinicVelocity_n
! note that normalBaroclinicVelocity is recomputed at the beginning of the next timestep due to Imp Vert mixing,
! so normalBaroclinicVelocity does not have to be recomputed here.
-
+
+ !$omp do schedule(runtime) private(k)
do iEdge = 1, nEdges
do k = 1, maxLevelEdgeTop(iEdge)
- normalVelocityNew(k,iEdge) = normalBarotropicVelocityNew(iEdge) + 2 * normalBaroclinicVelocityNew(k,iEdge) - normalBaroclinicVelocityCur(k,iEdge)
+ normalVelocityNew(k,iEdge) = normalBarotropicVelocityNew(iEdge) + 2 * normalBaroclinicVelocityNew(k,iEdge) &
+ - normalBaroclinicVelocityCur(k,iEdge)
end do
end do ! iEdges
+ !$omp end do
endif ! split_explicit_step
block => block % next
end do
-
+ call mpas_timer_stop('se loop fini')
+ call mpas_timer_stop('se loop')
end do ! split_explicit_step = 1, config_n_ts_iter
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! END large iteration loop
+ ! END large iteration loop
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Perform Sea Ice Formation Adjustment
+ call mpas_timer_start('se sea ice formation', .false.)
block => domain % blocklist
do while(associated(block))
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
- call mpas_pool_get_dimension(statePool, 'index_temperature', indexTemperature)
- call mpas_pool_get_dimension(statePool, 'index_salinity', indexSalinity)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', indexTemperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', indexSalinity)
call mpas_pool_get_array(statePool, 'layerThickness', layerThicknessNew, 2)
- call mpas_pool_get_array(statePool, 'tracers', tracersNew, 2)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', tracersGroupNew, 2)
- call mpas_pool_get_array(forcingPool, 'seaIceEnergy', seaIceEnergy)
-
- call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, 2)
- call ocn_sea_ice_formation(meshPool, indexTemperature, indexSalinity, layerThicknessNew, &
- tracersNew, seaIceEnergy, err)
+ call mpas_timer_start('se sea ice diag solve', .false.)
+ call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, tracersPool, 2)
+ call mpas_timer_stop('se sea ice diag solve')
block => block % next
end do
+ call mpas_timer_stop('se sea ice formation')
call mpas_timer_start("se implicit vert mix")
+
block => domain % blocklist
do while(associated(block))
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
- ! Call ocean diagnostic solve in preparation for vertical mixing. Note
+ ! Call ocean diagnostic solve in preparation for vertical mixing. Note
! it is called again after vertical mixing, because u and tracers change.
- ! For Richardson vertical mixing, only density, layerThicknessEdge, and kineticEnergyCell need to
+ ! For Richardson vertical mixing, only density, layerThicknessEdge, and kineticEnergyCell need to
! be computed. For kpp, more variables may be needed. Either way, this
! could be made more efficient by only computing what is needed for the
! implicit vmix routine that follows.
- call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, 2)
+ call mpas_timer_start('se vmix diag solve', .false.)
+ call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, tracersPool, 2)
+ call mpas_timer_stop('se vmix diag solve')
! Compute normalGMBolusVelocity; it will be added to the baroclinic modes in Stage 2 above.
if (config_use_standardGM) then
+ call mpas_timer_start('se vmix gm comp Bolus vel', .false.)
call ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
+ call mpas_timer_stop('se vmix gm comp Bolus vel')
end if
- call ocn_vmix_implicit(dt, meshPool, diagnosticsPool, statePool, err, 2)
+ call mpas_timer_start('se vmix vmix imp', .false.)
+ call ocn_vmix_implicit(dt, meshPool, diagnosticsPool, statePool, forcingPool, scratchPool, err, 2)
+ call mpas_timer_stop('se vmix vmix imp')
block => block % next
end do
- ! Update halo on u and tracers, which were just updated for implicit vertical mixing. If not done,
+ call mpas_threading_barrier()
+
+ ! Update halo on u and tracers, which were just updated for implicit vertical mixing. If not done,
! this leads to lack of volume conservation. It is required because halo updates in stage 3 are only
- ! conducted on tendencies, not on the velocity and tracer fields. So this update is required to
+ ! conducted on tendencies, not on the velocity and tracer fields. So this update is required to
! communicate the change due to implicit vertical mixing across the boundary.
- call mpas_timer_start("se implicit vert mix halos")
+ call mpas_timer_start('se vmix halos', .false.)
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
+
+ call mpas_timer_start('se vmix halos normalVelFld', .false.)
call mpas_dmpar_field_halo_exch(domain, 'normalVelocity', timeLevel=2)
- call mpas_dmpar_field_halo_exch(domain, 'tracers', timeLevel=2)
- call mpas_timer_stop("se implicit vert mix halos")
+ call mpas_timer_stop('se vmix halos normalVelFld')
+
+ call mpas_pool_begin_iteration(tracersPool)
+ do while ( mpas_pool_get_next_member(tracersPool, groupItr) )
+ if ( groupItr % memberType == MPAS_POOL_FIELD ) then
+ call mpas_dmpar_field_halo_exch(domain, groupItr % memberName, timeLevel=2)
+ end if
+ end do
+ call mpas_timer_stop('se vmix halos')
call mpas_timer_stop("se implicit vert mix")
+ call mpas_threading_barrier()
+
+ call mpas_timer_start('se fini', .false.)
block => domain % blocklist
do while (associated(block))
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
- call mpas_pool_get_subpool(block % structs, 'average', averagePool)
+
+ call mpas_pool_get_dimension(block % dimensions, 'nCells', nCells)
+ call mpas_pool_get_dimension(block % dimensions, 'nEdges', nEdges)
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocityCur, 1)
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocityNew, 2)
@@ -1445,46 +1723,82 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
call mpas_pool_get_dimension(diagnosticsPool, 'index_SSHGradientMeridional', indexSSHGradientMeridional)
if (config_prescribe_velocity) then
- normalVelocityNew(:,:) = normalVelocityCur(:,:)
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ normalVelocityNew(:, iEdge) = normalVelocityCur(:, iEdge)
+ end do
+ !$omp end do
end if
if (config_prescribe_thickness) then
- layerThicknessNew(:,:) = layerThicknessCur(:,:)
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ layerThicknessNew(:, iCell) = layerThicknessCur(:, iCell)
+ end do
+ !$omp end do
end if
- call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, 2)
+ call mpas_timer_start('se final diag solve', .false.)
+ call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, tracersPool, 2)
+ call mpas_timer_stop('se final diag solve')
- ! Compute normalGMBolusVelocity; it will be added to normalVelocity in Stage 2 of the next cycle.
+ ! Update the effective desnity in land ice if we're coupling to land ice
+ call ocn_effective_density_in_land_ice_update(meshPool, forcingPool, statePool, scratchPool, err)
+
+ ! Compute normalGMBolusVelocity; it will be added to normalVelocity in Stage 2 of the next cycle.
if (config_use_standardGM) then
+ call mpas_timer_start('se final gm comp Bolus vel', .false.)
call ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
+ call mpas_timer_stop('se final gm comp Bolus vel')
end if
- call mpas_reconstruct(meshPool, normalVelocityNew, &
- velocityX, velocityY, velocityZ, &
- velocityZonal, velocityMeridional &
- )
-
- call mpas_reconstruct(meshPool, gradSSH, &
- gradSSHX, gradSSHY, gradSSHZ, &
- gradSSHZonal, gradSSHMeridional &
- )
-
- surfaceVelocity(indexSurfaceVelocityZonal, :) = velocityZonal(1, :)
- surfaceVelocity(indexSurfaceVelocityMeridional, :) = velocityMeridional(1, :)
-
- SSHGradient(indexSSHGradientZonal, :) = gradSSHZonal(1, :)
- SSHGradient(indexSSHGradientMeridional, :) = gradSSHMeridional(1, :)
+ call mpas_timer_start('se final mpas reconstruct', .false.)
+ call mpas_threading_barrier()
+ !$omp master
+ call mpas_reconstruct(meshPool, normalVelocityNew, &
+ velocityX, velocityY, velocityZ, &
+ velocityZonal, velocityMeridional, &
+ includeHalos = .true.)
+
+ call mpas_reconstruct(meshPool, gradSSH, &
+ gradSSHX, gradSSHY, gradSSHZ, &
+ gradSSHZonal, gradSSHMeridional, &
+ includeHalos = .true.)
+ !$omp end master
+ call mpas_threading_barrier()
+ call mpas_timer_stop('se final mpas reconstruct')
+
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ surfaceVelocity(indexSurfaceVelocityZonal, iCell) = velocityZonal(1, iCell)
+ surfaceVelocity(indexSurfaceVelocityMeridional, iCell) = velocityMeridional(1, iCell)
+
+ SSHGradient(indexSSHGradientZonal, iCell) = gradSSHZonal(iCell)
+ SSHGradient(indexSSHGradientMeridional, iCell) = gradSSHMeridional(iCell)
+ end do
+ !$omp end do
- call ocn_time_average_accumulate(averagePool, statePool, diagnosticsPool, 2)
- call ocn_time_average_coupled_accumulate(diagnosticsPool, forcingPool)
+ call ocn_time_average_coupled_accumulate(diagnosticsPool, statePool, forcingPool, 2)
+ call mpas_threading_barrier()
if (config_use_standardGM) then
+ call mpas_timer_start('se final reconstruct gm vect', .false.)
call ocn_reconstruct_gm_vectors(diagnosticsPool, meshPool)
+ call mpas_timer_stop('se final reconstruct gm vect')
end if
block => block % next
end do
+ if (trim(config_land_ice_flux_mode) == 'coupled') then
+ call mpas_timer_start("se effective density halo")
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'state', statePool)
+ call mpas_pool_get_field(statePool, 'effectiveDensityInLandIce', effectiveDensityField, 2)
+ call mpas_dmpar_exch_halo_field(effectiveDensityField)
+ call mpas_timer_stop("se effective density halo")
+ end if
+
+ call mpas_timer_stop('se fini')
call mpas_timer_stop("se timestep")
deallocate(n_bcl_iter)
@@ -1511,7 +1825,7 @@ subroutine ocn_time_integration_split_init(domain)!{{{
integer :: i, iCell, iEdge, iVertex, k
type (block_type), pointer :: block
- type (mpas_pool_type), pointer :: statePool, meshPool
+ type (mpas_pool_type), pointer :: statePool, meshPool, tracersPool
integer :: iTracer, cell, cell1, cell2
integer, dimension(:), pointer :: maxLevelEdgeTop
@@ -1531,6 +1845,7 @@ subroutine ocn_time_integration_split_init(domain)!{{{
call mpas_pool_get_config(block % configs, 'config_time_integrator', config_time_integrator)
call mpas_pool_get_config(block % configs, 'config_filter_btr_mode', config_filter_btr_mode)
call mpas_pool_get_subpool(block % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_dimension(block % dimensions, 'nVertLevels', nVertLevels)
@@ -1550,9 +1865,11 @@ subroutine ocn_time_integration_split_init(domain)!{{{
! This is only done upon start-up.
if (trim(config_time_integrator) == 'unsplit_explicit') then
call mpas_pool_get_array(statePool, 'normalBarotropicVelocity', normalBarotropicVelocity)
- normalBarotropicVelocity(:) = 0.0
- normalBaroclinicVelocity(:,:) = normalVelocity(:,:)
+ do iEdge = 1, nEdges
+ normalBarotropicVelocity(iEdge) = 0.0_RKIND
+ normalBaroclinicVelocity(:, iEdge) = normalVelocity(:, iEdge)
+ end do
elseif (trim(config_time_integrator) == 'split_explicit') then
@@ -1566,21 +1883,21 @@ subroutine ocn_time_integration_split_init(domain)!{{{
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
- ! normalBarotropicVelocity = sum(u)/sum(h) on each column
+ ! normalBarotropicVelocity = sum(h*u)/sum(h) on each edge
! ocn_diagnostic_solve has not yet been called, so compute hEdge
! just for this edge.
! thicknessSum is initialized outside the loop because on land boundaries
! maxLevelEdgeTop=0, but I want to initialize thicknessSum with a
! nonzero value to avoid a NaN.
- layerThicknessEdge1 = 0.5*( layerThickness(1,cell1) + layerThickness(1,cell2) )
+ layerThicknessEdge1 = 0.5_RKIND*( layerThickness(1,cell1) + layerThickness(1,cell2) )
normalThicknessFluxSum = layerThicknessEdge1 * normalVelocity(1,iEdge)
layerThicknessSum = layerThicknessEdge1
do k=2, maxLevelEdgeTop(iEdge)
! ocn_diagnostic_solve has not yet been called, so compute hEdge
! just for this edge.
- layerThicknessEdge1 = 0.5*( layerThickness(k,cell1) + layerThickness(k,cell2) )
+ layerThicknessEdge1 = 0.5_RKIND*( layerThickness(k,cell1) + layerThickness(k,cell2) )
normalThicknessFluxSum = normalThicknessFluxSum &
+ layerThicknessEdge1 * normalVelocity(k,iEdge)
@@ -1596,16 +1913,17 @@ subroutine ocn_time_integration_split_init(domain)!{{{
! normalBaroclinicVelocity=0, normalVelocity=0 on land cells
do k = maxLevelEdgeTop(iEdge)+1, nVertLevels
- normalBaroclinicVelocity(k,iEdge) = 0.0
- normalVelocity(k,iEdge) = 0.0
+ normalBaroclinicVelocity(k,iEdge) = 0.0_RKIND
+ normalVelocity(k,iEdge) = 0.0_RKIND
enddo
enddo
if (config_filter_btr_mode) then
! filter normalBarotropicVelocity out of initial condition
+
normalVelocity(:,:) = normalBaroclinicVelocity(:,:)
+ normalBarotropicVelocity(:) = 0.0_RKIND
- normalBarotropicVelocity(:) = 0.0
endif
endif
diff --git a/src/core_ocean/mode_init/Makefile b/src/core_ocean/mode_init/Makefile
new file mode 100644
index 0000000000..58829be224
--- /dev/null
+++ b/src/core_ocean/mode_init/Makefile
@@ -0,0 +1,85 @@
+.SUFFIXES: .F .o
+
+OBJS = mpas_ocn_init_mode.o
+
+UTILS = mpas_ocn_init_spherical_utils.o \
+ mpas_ocn_init_vertical_grids.o \
+ mpas_ocn_init_cell_markers.o \
+ mpas_ocn_init_interpolation.o \
+ mpas_ocn_init_ssh_and_ssp.o
+
+TEST_CASES = mpas_ocn_init_baroclinic_channel.o \
+ mpas_ocn_init_lock_exchange.o \
+ mpas_ocn_init_internal_waves.o \
+ mpas_ocn_init_overflow.o \
+ mpas_ocn_init_cvmix_WSwSBF.o \
+ mpas_ocn_init_iso.o \
+ mpas_ocn_init_soma.o \
+ mpas_ocn_init_ziso.o \
+ mpas_ocn_init_sub_ice_shelf_2D.o \
+ mpas_ocn_init_periodic_planar.o \
+ mpas_ocn_init_ecosys_column.o \
+ mpas_ocn_init_sea_mount.o \
+ mpas_ocn_init_global_ocean.o \
+ mpas_ocn_init_isomip.o
+ #mpas_ocn_init_TEMPLATE.o
+
+all: init_mode
+
+init_mode: $(UTILS) $(TEST_CASES) $(OBJS)
+
+mpas_ocn_init_mode.o: $(UTILS) $(TEST_CASES)
+
+mpas_ocn_init_cell_markers.o:
+
+mpas_ocn_init_interpolation.o:
+
+mpas_ocn_init_ssh_and_ssp.o: mpas_ocn_init_interpolation.o mpas_ocn_init_vertical_grids.o
+
+mpas_ocn_init_spherical_utils.o:
+
+mpas_ocn_init_vertical_grids.o:
+
+mpas_ocn_init_seaSurfaceHeightAndPressure.o:
+
+mpas_ocn_init_baroclinic_channel.o: $(UTILS)
+
+mpas_ocn_init_iso.o: $(UTILS)
+
+mpas_ocn_init_soma.o: $(UTILS)
+
+mpas_ocn_init_lock_exchange.o: $(UTILS)
+
+mpas_ocn_init_internal_waves.o: $(UTILS)
+
+mpas_ocn_init_overflow.o: $(UTILS)
+
+mpas_ocn_init_global_ocean.o: $(UTILS)
+
+mpas_ocn_init_sub_ice_shelf_2D.o: $(UTILS)
+
+mpas_ocn_init_cvmix_WSwSBF.o: $(UTILS)
+
+mpas_ocn_init_periodic_planar.o: $(UTILS)
+
+mpas_ocn_init_ecosys_column.o: $(UTILS)
+
+mpas_ocn_init_sea_mount.o: $(UTILS)
+
+mpas_ocn_init_isomip.o: $(UTILS)
+
+mpas_ocn_init_ziso.o: $(UTILS)
+
+#mpas_ocn_init_TEMPLATE.o: $(UTILS)
+
+clean:
+ $(RM) *.o *.mod *.f90
+
+.F.o:
+ $(RM) $@ $*.mod
+ifeq "$(GEN_F90)" "true"
+ $(CPP) $(CPPFLAGS) $(CPPINCLUDES) $< > $*.f90
+ $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES)
+else
+ $(FC) $(CPPFLAGS) $(FFLAGS) -c $*.F $(CPPINCLUDES) $(FCINCLUDES)
+endif
diff --git a/src/core_ocean/mode_init/Registry.xml b/src/core_ocean/mode_init/Registry.xml
new file mode 100644
index 0000000000..982e76fea2
--- /dev/null
+++ b/src/core_ocean/mode_init/Registry.xml
@@ -0,0 +1,15 @@
+#include "Registry_baroclinic_channel.xml"
+#include "Registry_lock_exchange.xml"
+#include "Registry_internal_waves.xml"
+#include "Registry_overflow.xml"
+#include "Registry_global_ocean.xml"
+#include "Registry_cvmix_WSwSBF.xml"
+#include "Registry_iso.xml"
+#include "Registry_soma.xml"
+#include "Registry_ziso.xml"
+#include "Registry_sub_ice_shelf_2D.xml"
+#include "Registry_periodic_planar.xml"
+#include "Registry_ecosys.xml"
+#include "Registry_sea_mount.xml"
+#include "Registry_isomip.xml"
+// #include "Registry_TEMPLATE.xml"
diff --git a/src/core_ocean/mode_init/Registry_TEMPLATE.xml b/src/core_ocean/mode_init/Registry_TEMPLATE.xml
new file mode 100644
index 0000000000..f80e1f7e75
--- /dev/null
+++ b/src/core_ocean/mode_init/Registry_TEMPLATE.xml
@@ -0,0 +1,14 @@
+
+
+
+
+
diff --git a/src/core_ocean/mode_init/Registry_baroclinic_channel.xml b/src/core_ocean/mode_init/Registry_baroclinic_channel.xml
new file mode 100644
index 0000000000..fbb982ae91
--- /dev/null
+++ b/src/core_ocean/mode_init/Registry_baroclinic_channel.xml
@@ -0,0 +1,42 @@
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/mode_init/Registry_cvmix_WSwSBF.xml b/src/core_ocean/mode_init/Registry_cvmix_WSwSBF.xml
new file mode 100644
index 0000000000..9f3143e6fa
--- /dev/null
+++ b/src/core_ocean/mode_init/Registry_cvmix_WSwSBF.xml
@@ -0,0 +1,107 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/mode_init/Registry_ecosys.xml b/src/core_ocean/mode_init/Registry_ecosys.xml
new file mode 100644
index 0000000000..2109b2c13d
--- /dev/null
+++ b/src/core_ocean/mode_init/Registry_ecosys.xml
@@ -0,0 +1,23 @@
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/mode_init/Registry_global_ocean.xml b/src/core_ocean/mode_init/Registry_global_ocean.xml
new file mode 100644
index 0000000000..22cdae6e52
--- /dev/null
+++ b/src/core_ocean/mode_init/Registry_global_ocean.xml
@@ -0,0 +1,294 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/mode_init/Registry_internal_waves.xml b/src/core_ocean/mode_init/Registry_internal_waves.xml
new file mode 100644
index 0000000000..71067d5a1e
--- /dev/null
+++ b/src/core_ocean/mode_init/Registry_internal_waves.xml
@@ -0,0 +1,47 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/mode_init/Registry_iso.xml b/src/core_ocean/mode_init/Registry_iso.xml
new file mode 100644
index 0000000000..57820b17ab
--- /dev/null
+++ b/src/core_ocean/mode_init/Registry_iso.xml
@@ -0,0 +1,334 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/mode_init/Registry_isomip.xml b/src/core_ocean/mode_init/Registry_isomip.xml
new file mode 100644
index 0000000000..0cb370e2a2
--- /dev/null
+++ b/src/core_ocean/mode_init/Registry_isomip.xml
@@ -0,0 +1,105 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/mode_init/Registry_lock_exchange.xml b/src/core_ocean/mode_init/Registry_lock_exchange.xml
new file mode 100644
index 0000000000..d58d8a20b2
--- /dev/null
+++ b/src/core_ocean/mode_init/Registry_lock_exchange.xml
@@ -0,0 +1,34 @@
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/mode_init/Registry_overflow.xml b/src/core_ocean/mode_init/Registry_overflow.xml
new file mode 100644
index 0000000000..a8f03927f3
--- /dev/null
+++ b/src/core_ocean/mode_init/Registry_overflow.xml
@@ -0,0 +1,63 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/mode_init/Registry_periodic_planar.xml b/src/core_ocean/mode_init/Registry_periodic_planar.xml
new file mode 100644
index 0000000000..3f0d2a6755
--- /dev/null
+++ b/src/core_ocean/mode_init/Registry_periodic_planar.xml
@@ -0,0 +1,20 @@
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/mode_init/Registry_sea_mount.xml b/src/core_ocean/mode_init/Registry_sea_mount.xml
new file mode 100644
index 0000000000..bf390eb74e
--- /dev/null
+++ b/src/core_ocean/mode_init/Registry_sea_mount.xml
@@ -0,0 +1,74 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/mode_init/Registry_soma.xml b/src/core_ocean/mode_init/Registry_soma.xml
new file mode 100644
index 0000000000..b123e03953
--- /dev/null
+++ b/src/core_ocean/mode_init/Registry_soma.xml
@@ -0,0 +1,58 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/mode_init/Registry_sub_ice_shelf_2D.xml b/src/core_ocean/mode_init/Registry_sub_ice_shelf_2D.xml
new file mode 100644
index 0000000000..8d2f8da8a3
--- /dev/null
+++ b/src/core_ocean/mode_init/Registry_sub_ice_shelf_2D.xml
@@ -0,0 +1,43 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/mode_init/Registry_ziso.xml b/src/core_ocean/mode_init/Registry_ziso.xml
new file mode 100644
index 0000000000..23f8231877
--- /dev/null
+++ b/src/core_ocean/mode_init/Registry_ziso.xml
@@ -0,0 +1,114 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_TEMPLATE.F b/src/core_ocean/mode_init/mpas_ocn_init_TEMPLATE.F
new file mode 100644
index 0000000000..e892c374d4
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_TEMPLATE.F
@@ -0,0 +1,336 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_TEMPLATE
+!
+!> \brief MPAS ocean initialize case -- TEMPLATE
+!> \author FILL_IN_AUTHOR
+!> \date FILL_IN_DATE
+!> \details
+!> This module contains the routines for initializing the
+!> TEMPLATE initial condition
+!>
+!> In order to add a new analysis member, do the following:
+!> 1. In src/core_ocean/mode_init, copy these to your new analysis member name:
+!> cp mpas_ocn_init_TEMPLATE.F mpas_ocn_init_your_new_name.F
+!> cp Registry_TEMPLATE.xml Registry_ocn_your_new_name.xml
+!>
+!> 2. In those two new files, replace the following text:
+!> TEMPLATE, FILL_IN_AUTHOR, FILL_IN_DATE
+!> TEMPLATE uses underscores (subroutine names), like your_new_name.
+!>
+!> 3. Add a #include line for your registry to
+!> src/core_ocean/mode_init/Registry.xml
+!>
+!> 4. Copy and change TEMPLATE lines in src/core_ocean/mode_init/mpas_ocn_init_mode.F
+!>
+!> 5. Add these dependency lines by following TEMPLATE examples in:
+!> in src/core_ocean/mode_init/Makefile
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_TEMPLATE
+
+ use mpas_kind_types
+ use mpas_io_units
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+
+ use ocn_constants
+ use ocn_init_vertical_grids
+ use ocn_init_cell_markers
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_setup_TEMPLATE, &
+ ocn_init_validate_TEMPLATE
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_setup_TEMPLATE
+!
+!> \brief Setup for this initial condition
+!> \author FILL_IN_AUTHOR
+!> \date FILL_IN_DATE
+!> \details
+!> This routine sets up the initial conditions for this case.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_TEMPLATE(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: tracersPool
+ type (mpas_pool_type), pointer :: verticalMeshPool
+
+ ! local variables
+ integer :: iCell, k, idx
+ real (kind=RKIND) :: yMin, yMax, xMin, xMax, dcEdgeMin, dcEdgeMinGlobal
+ real (kind=RKIND) :: yMinGlobal, yMaxGlobal, yMidGlobal, xMinGlobal, xMaxGlobal
+ real (kind=RKIND) :: localVar1, localVar2
+ real (kind=RKIND), dimension(:), pointer :: interfaceLocations
+
+ ! Define config variable pointers
+ character (len=StrKIND), pointer :: config_init_configuration, config_vertical_grid
+ logical, pointer :: config_TEMPLATE_example_flag1
+ real (kind=RKIND), pointer :: config_TEMPLATE_example_flag2
+
+ ! Define dimension pointers
+ integer, pointer :: nCellsSolve, nEdgesSolve, nVertLevels, nVertLevelsP1
+ integer, pointer :: index_temperature, index_salinity
+
+ ! Define variable pointers
+ logical, pointer :: on_a_sphere
+ integer, dimension(:), pointer :: maxLevelCell
+ real (kind=RKIND), dimension(:), pointer :: xCell, yCell,refBottomDepth, refZMid, &
+ vertCoordMovementWeights, bottomDepth, &
+ fCell, fEdge, fVertex, dcEdge
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness, restingThickness
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
+
+ iErr = 0
+
+ call mpas_pool_get_config(ocnConfigs, 'config_init_configuration', config_init_configuration)
+
+ if(config_init_configuration .ne. trim('TEMPLATE')) return
+
+ ! Get config flag settings
+
+ call mpas_pool_get_config(ocnConfigs, 'config_vertical_grid', config_vertical_grid)
+
+ call mpas_pool_get_config(ocnConfigs, 'config_TEMPLATE_example_flag1', config_TEMPLATE_example_flag1)
+ call mpas_pool_get_config(ocnConfigs, 'config_TEMPLATE_example_flag2', config_TEMPLATE_example_flag2)
+
+ ! Determine vertical grid for configuration
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevelsP1', nVertLevelsP1)
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+
+ ! you may restrict your case geometry as follows:
+ ! if ( on_a_sphere ) call mpas_dmpar_global_abort('MPAS-ocean: ERROR: The TEMPLATE configuration can only be applied ' &
+ ! // 'to a planar mesh. Exiting...')
+
+ allocate(interfaceLocations(nVertLevelsP1))
+ call ocn_generate_vertical_grid( config_vertical_grid, interfaceLocations )
+
+ !--------------------------------------------------------------------
+ ! Use this section to make boundaries non-periodic
+ !--------------------------------------------------------------------
+
+ ! Initalize min/max values to large positive and negative values
+ yMin = 1.0E10_RKIND
+ yMax = -1.0E10_RKIND
+ xMin = 1.0E10_RKIND
+ xMax = -1.0E10_RKIND
+ dcEdgeMin = 1.0E10_RKIND
+
+ ! Determine local min and max values.
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
+
+ yMin = min( yMin, minval(yCell(1:nCellsSolve)))
+ yMax = max( yMax, maxval(yCell(1:nCellsSolve)))
+ xMin = min( xMin, minval(xCell(1:nCellsSolve)))
+ xMax = max( xMax, maxval(xCell(1:nCellsSolve)))
+ dcEdgeMin = min( dcEdgeMin, minval(dcEdge(1:nEdgesSolve)))
+
+ block_ptr => block_ptr % next
+ end do
+
+ ! Determine global min and max values.
+ call mpas_dmpar_min_real(domain % dminfo, yMin, yMinGlobal)
+ call mpas_dmpar_max_real(domain % dminfo, yMax, yMaxGlobal)
+ call mpas_dmpar_min_real(domain % dminfo, xMin, xMinGlobal)
+ call mpas_dmpar_max_real(domain % dminfo, xMax, xMaxGlobal)
+ call mpas_dmpar_min_real(domain % dminfo, dcEdgeMin, dcEdgeMinGlobal)
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+
+ call ocn_mark_north_boundary(meshPool, yMaxGlobal, dcEdgeMinGlobal, iErr)
+ call ocn_mark_south_boundary(meshPool, yMinGlobal, dcEdgeMinGlobal, iErr)
+
+ block_ptr => block_ptr % next
+ end do
+
+ !--------------------------------------------------------------------
+ ! Use this section to set initial values
+ !--------------------------------------------------------------------
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', index_temperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', index_salinity)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_array(meshPool, 'vertCoordMovementWeights', vertCoordMovementWeights)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'fCell', fCell)
+ call mpas_pool_get_array(meshPool, 'fEdge', fEdge)
+ call mpas_pool_get_array(meshPool, 'fVertex', fVertex)
+
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+
+ call mpas_pool_get_array(verticalMeshPool, 'refZMid', refZMid)
+ call mpas_pool_get_array(verticalMeshPool, 'restingThickness', restingThickness)
+
+
+ ! ! Set refBottomDepth and refZMid
+ do k = 1, nVertLevels
+ refBottomDepth(k) = config_TEMPLATE_bottom_depth * interfaceLocations(k+1)
+ refZMid(k) = - 0.5_RKIND * (interfaceLocations(k+1) + interfaceLocations(k)) * config_TEMPLATE_bottom_depth
+ end do
+
+ ! Set vertCoordMovementWeights
+ vertCoordMovementWeights(:) = 1.0_RKIND
+
+ do iCell = 1, nCellsSolve
+
+ ! Set temperature
+ idx = index_temperature
+ do k = 1, nVertLevels
+ ! activeTracers(idx, k, iCell) =
+ end do
+
+ ! Set salinity
+ idx = index_salinity
+ do k = 1, nVertLevels
+ ! activeTracers(idx, k, iCell) =
+ end do
+
+ ! Set layerThickness and restingThickness
+ do k = 1, nVertLevels
+ ! layerThickness(k, iCell) =
+ ! restingThickness(k, iCell) =
+ end do
+
+ ! Set bottomDepth
+ ! bottomDepth(iCell) =
+
+ ! Set maxLevelCell
+ ! maxLevelCell(iCell) =
+
+ ! Set Coriolis parameters, if other than zero
+ fCell(iCell) = config_TEMPLATE_coriolis_parameter
+ fEdge(iCell) = config_TEMPLATE_coriolis_parameter
+ fVertex(iCell) = config_TEMPLATE_coriolis_parameter
+
+ end do
+
+ block_ptr => block_ptr % next
+ end do
+
+ deallocate(interfaceLocations)
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_setup_TEMPLATE!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_validate_TEMPLATE
+!
+!> \brief Validation for this initial condition
+!> \author FILL_IN_AUTHOR
+!> \date FILL_IN_DATE
+!> \details
+!> This routine validates the configuration options for this case.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_validate_TEMPLATE(configPool, packagePool, iocontext, iErr)!{{{
+
+ !--------------------------------------------------------------------
+ type (mpas_pool_type), intent(inout) :: configPool, packagePool
+ type (mpas_io_context_type), intent(inout) :: iocontext
+
+ integer, intent(out) :: iErr
+
+ character (len=StrKIND), pointer :: config_init_configuration
+ integer, pointer :: config_vert_levels, config_TEMPLATE_vert_levels
+
+ iErr = 0
+
+ call mpas_pool_get_config(configPool, 'config_init_configuration', config_init_configuration)
+
+ if(config_init_configuration .ne. trim('TEMPLATE')) return
+
+ call mpas_pool_get_config(configPool, 'config_vert_levels', config_vert_levels)
+ call mpas_pool_get_config(configPool, 'config_TEMPLATE_vert_levels', config_TEMPLATE_vert_levels)
+
+ if(config_vert_levels <= 0 .and. config_TEMPLATE_vert_levels > 0) then
+ config_vert_levels = config_TEMPLATE_vert_levels
+ else if (config_vert_levels <= 0) then
+ write(stderrUnit,*) 'IERROR: Validation failed for TEMPLATE. Not given a usable value for vertical levels.'
+ iErr = 1
+ end if
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_validate_TEMPLATE!}}}
+
+
+!***********************************************************************
+
+end module ocn_init_TEMPLATE
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_baroclinic_channel.F b/src/core_ocean/mode_init/mpas_ocn_init_baroclinic_channel.F
new file mode 100644
index 0000000000..327bf9021f
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_baroclinic_channel.F
@@ -0,0 +1,379 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_baroclinic_channel
+!
+!> \brief MPAS ocean initialize case -- Baroclinic Channel
+!> \author Doug Jacobsen
+!> \date 02/18/2014
+!> \details
+!> This module contains the routines for initializing the
+!> the baroclinic channel test case
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_baroclinic_channel
+
+ use mpas_kind_types
+ use mpas_io_units
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+ use mpas_dmpar
+
+ use ocn_constants
+ use ocn_init_vertical_grids
+ use ocn_init_cell_markers
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_setup_baroclinic_channel, &
+ ocn_init_validate_baroclinic_channel
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_setup_baroclinic_channel
+!
+!> \brief Setup for baroclinic channel test case
+!> \author Doug Jacobsen
+!> \date 02/19/2014
+!> \details
+!> This routine sets up the initial conditions for the baroclinic channel test case.
+!> It should also ensure the mesh that was input is valid for the configuration.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_baroclinic_channel(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+ real (kind=RKIND) :: yMin, yMax, xMin, xMax, dcEdgeMin, dcEdgeMinGlobal
+ real (kind=RKIND) :: yMinGlobal, yMaxGlobal, yMidGlobal, xMinGlobal, xMaxGlobal
+ real (kind=RKIND) :: temperature, yOffset, xPerturbationMin, xPerturbationMax
+ real (kind=RKIND) :: perturbationWidth
+
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: tracersPool
+ type (mpas_pool_type), pointer :: verticalMeshPool
+
+ integer :: iCell, k, idx
+
+ ! Define config variable pointers
+ character (len=StrKIND), pointer :: config_init_configuration, config_vertical_grid
+ logical, pointer :: config_baroclinic_channel_use_distances
+ real (kind=RKIND), pointer :: config_baroclinic_channel_gradient_width_dist, &
+ config_baroclinic_channel_gradient_width_frac, &
+ config_baroclinic_channel_bottom_depth, &
+ config_baroclinic_channel_surface_temperature, &
+ config_baroclinic_channel_bottom_temperature, &
+ config_baroclinic_channel_temperature_difference, &
+ config_baroclinic_channel_salinity, &
+ config_baroclinic_channel_coriolis_parameter
+
+ ! Define dimension pointers
+ integer, pointer :: nCellsSolve, nEdgesSolve, nVertLevels, nVertLevelsP1
+ integer, pointer :: index_temperature, index_salinity, index_tracer1
+
+ ! Define variable pointers
+ integer, dimension(:), pointer :: maxLevelCell
+ real (kind=RKIND), dimension(:), pointer :: xCell, yCell,refBottomDepth, refZMid, &
+ vertCoordMovementWeights, bottomDepth, &
+ fCell, fEdge, fVertex, dcEdge
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness, restingThickness
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers, debugTracers
+
+ ! Define local interfaceLocations variable
+ real (kind=RKIND), dimension(:), pointer :: interfaceLocations
+
+ logical, pointer :: on_a_sphere
+
+ iErr = 0
+
+ call mpas_pool_get_config(ocnConfigs, 'config_init_configuration', config_init_configuration)
+
+ if(config_init_configuration .ne. trim('baroclinic_channel')) return
+
+ call mpas_pool_get_config(ocnConfigs, 'config_vertical_grid', config_vertical_grid)
+
+ call mpas_pool_get_config(ocnConfigs, 'config_baroclinic_channel_use_distances', config_baroclinic_channel_use_distances)
+ call mpas_pool_get_config(ocnConfigs, 'config_baroclinic_channel_gradient_width_dist', &
+ config_baroclinic_channel_gradient_width_dist)
+ call mpas_pool_get_config(ocnConfigs, 'config_baroclinic_channel_gradient_width_frac', &
+ config_baroclinic_channel_gradient_width_frac)
+ call mpas_pool_get_config(ocnConfigs, 'config_baroclinic_channel_bottom_depth', config_baroclinic_channel_bottom_depth)
+ call mpas_pool_get_config(ocnConfigs, 'config_baroclinic_channel_surface_temperature', &
+ config_baroclinic_channel_surface_temperature)
+ call mpas_pool_get_config(ocnConfigs, 'config_baroclinic_channel_bottom_temperature', &
+ config_baroclinic_channel_bottom_temperature)
+ call mpas_pool_get_config(ocnConfigs, 'config_baroclinic_channel_temperature_difference', &
+ config_baroclinic_channel_temperature_difference)
+ call mpas_pool_get_config(ocnConfigs, 'config_baroclinic_channel_salinity', config_baroclinic_channel_salinity)
+ call mpas_pool_get_config(ocnConfigs, 'config_baroclinic_channel_coriolis_parameter', &
+ config_baroclinic_channel_coriolis_parameter)
+
+ ! Determine vertical grid for configuration
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevelsP1', nVertLevelsP1)
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+
+ if ( on_a_sphere ) call mpas_dmpar_global_abort('MPAS-ocean: ERROR: The baroclinic channel configuration ' &
+ // 'can only be applied to a planar mesh. Exiting...')
+
+ allocate(interfaceLocations(nVertLevelsP1))
+ call ocn_generate_vertical_grid( config_vertical_grid, interfaceLocations )
+
+ ! Initalize min/max values to large positive and negative values
+ yMin = 1.0E10_RKIND
+ yMax = -1.0E10_RKIND
+ xMin = 1.0E10_RKIND
+ xMax = -1.0E10_RKIND
+ dcEdgeMin = 1.0E10_RKIND
+
+ ! Determine local min and max values.
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
+
+ yMin = min( yMin, minval(yCell(1:nCellsSolve)))
+ yMax = max( yMax, maxval(yCell(1:nCellsSolve)))
+ xMin = min( xMin, minval(xCell(1:nCellsSolve)))
+ xMax = max( xMax, maxval(xCell(1:nCellsSolve)))
+ dcEdgeMin = min( dcEdgeMin, minval(dcEdge(1:nEdgesSolve)))
+
+ block_ptr => block_ptr % next
+ end do
+
+ ! Determine global min and max values.
+ call mpas_dmpar_min_real(domain % dminfo, yMin, yMinGlobal)
+ call mpas_dmpar_max_real(domain % dminfo, yMax, yMaxGlobal)
+ call mpas_dmpar_min_real(domain % dminfo, xMin, xMinGlobal)
+ call mpas_dmpar_max_real(domain % dminfo, xMax, xMaxGlobal)
+ call mpas_dmpar_min_real(domain % dminfo, dcEdgeMin, dcEdgeMinGlobal)
+
+ yMidGlobal = (yMinGlobal + yMaxGlobal) * 0.5_RKIND
+ xPerturbationMin = xMinGlobal + 4.0_RKIND * (xMaxGlobal - xMinGlobal) / 6.0_RKIND
+ xPerturbationMax = xMinGlobal + 5.0_RKIND * (xMaxGlobal - xMinGlobal) / 6.0_RKIND
+ if(config_baroclinic_channel_use_distances) then
+ perturbationWidth = config_baroclinic_channel_gradient_width_dist
+ else
+ perturbationWidth = (yMaxGlobal - yMinGlobal) * config_baroclinic_channel_gradient_width_frac
+ end if
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', index_temperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', index_salinity)
+ call mpas_pool_get_dimension(tracersPool, 'index_tracer1', index_tracer1)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_array(meshPool, 'vertCoordMovementWeights', vertCoordMovementWeights)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'fCell', fCell)
+ call mpas_pool_get_array(meshPool, 'fEdge', fEdge)
+ call mpas_pool_get_array(meshPool, 'fVertex', fVertex)
+
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+ call mpas_pool_get_array(tracersPool, 'debugTracers', debugTracers, 1)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+
+ call mpas_pool_get_array(verticalMeshPool, 'refZMid', refZMid)
+ call mpas_pool_get_array(verticalMeshPool, 'restingThickness', restingThickness)
+
+ call ocn_mark_north_boundary(meshPool, yMaxGlobal, dcEdgeMinGlobal, iErr)
+ call ocn_mark_south_boundary(meshPool, yMinGlobal, dcEdgeMinGlobal, iErr)
+
+ ! Set refBottomDepth and refZMid
+ do k = 1, nVertLevels
+ refBottomDepth(k) = config_baroclinic_channel_bottom_depth * interfaceLocations(k+1)
+ refZMid(k) = - 0.5_RKIND * (interfaceLocations(k+1) + interfaceLocations(k)) * config_baroclinic_channel_bottom_depth
+ end do
+
+ ! Set vertCoordMovementWeights
+ vertCoordMovementWeights(:) = 1.0_RKIND
+
+ do iCell = 1, nCellsSolve
+ ! Determine cutoff location for large sin wave
+ yOffset = perturbationWidth * sin (6.0_RKIND * pii * (xCell(iCell) - xMinGlobal) / (xMaxGlobal - xMinGlobal))
+
+ ! Set debug tracer
+ if ( associated(debugTracers) ) then
+ idx = index_tracer1
+ do k = 1, nVertLevels
+ debugTracers(idx, k, iCell) = 1.0_RKIND
+ enddo
+ end if
+
+ ! Set stratification based on northern half of domain temperature
+ if ( associated(activeTracers) ) then
+ idx = index_temperature
+ do k = nVertLevels, 1, -1
+ temperature = config_baroclinic_channel_bottom_temperature &
+ + (config_baroclinic_channel_surface_temperature - config_baroclinic_channel_bottom_temperature) &
+ * ( (refZMid(k) + refBottomDepth(nVertLevels)) / refBottomDepth(nVertLevels) )
+ activeTracers(idx, k, iCell) = temperature
+ end do
+
+ if(yCell(iCell) < yMidGlobal - yOffset) then
+ ! If cell is in the southern half, outside the sin width, subtract temperature difference
+ activeTracers(idx, :, iCell) = activeTracers(idx, :, iCell) - config_baroclinic_channel_temperature_difference
+ else if(yCell(iCell) >= yMidGlobal - yOffset .and. &
+ yCell(iCell) < yMidGlobal - yOffset + perturbationWidth) then
+ activeTracers(idx, :, iCell) = activeTracers(idx, :, iCell) - config_baroclinic_channel_temperature_difference &
+ * ( 1.0_RKIND - ( yCell(iCell) - ((yMaxGlobal + yMinGlobal) * 0.5_RKIND &
+ - yOffset)) / perturbationWidth)
+ end if
+
+ ! Determine yOffset for 3rd crest in sin wave.
+ yOffset = 0.5_RKIND * perturbationWidth * sin(pii * (xCell(iCell) - xPerturbationMin) &
+ / (xPerturbationMax - xPerturbationMin))
+
+ if ( yCell(iCell) >= yMidGlobal - yOffset - 0.5_RKIND * perturbationWidth .and. &
+ yCell(iCell) <= yMidGlobal - yOffset + 0.5_RKIND * perturbationWidth .and. &
+ xCell(iCell) >= xPerturbationMin .and. &
+ xCell(iCell) <= xPerturbationMax) then
+
+
+ do k = 1, nVertLevels
+ activeTracers(idx, k, iCell) = activeTracers(idx, k, iCell) &
+ + 0.3_RKIND * ( 1.0_RKIND - ( ( yCell(iCell) - (yMidGlobal - yOffset)) &
+ / (0.5_RKIND * perturbationWidth)))
+ end do
+ end if
+
+ ! Set salinity
+ idx = index_salinity
+ activeTracers(idx, :, iCell) = config_baroclinic_channel_salinity
+ end if
+
+ ! Set layerThickness and restingThickness
+ do k = 1, nVertLevels
+ layerThickness(k, iCell) = config_baroclinic_channel_bottom_depth * ( interfaceLocations(k+1) &
+ - interfaceLocations(k) )
+ restingThickness(k, iCell) = config_baroclinic_channel_bottom_depth * ( interfaceLocations(k+1) &
+ - interfaceLocations(k) )
+
+ end do
+
+ ! Set bottomDepth
+ bottomDepth(iCell) = config_baroclinic_channel_bottom_depth
+
+ ! Set maxLevelCell
+ maxLevelCell(iCell) = nVertLevels
+ end do
+
+ ! Set Coriolis parameters
+ fCell(:) = config_baroclinic_channel_coriolis_parameter
+ fEdge(:) = config_baroclinic_channel_coriolis_parameter
+ fVertex(:) = config_baroclinic_channel_coriolis_parameter
+
+ block_ptr => block_ptr % next
+ end do
+
+ deallocate(interfaceLocations)
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_setup_baroclinic_channel!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_validate_baroclinic_channel
+!
+!> \brief Validation for baroclinic channel test case
+!> \author Doug Jacobsen
+!> \date 02/20/2014
+!> \details
+!> This routine validates the configuration options for the baroclinic channel test case.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_validate_baroclinic_channel(configPool, packagePool, iocontext, iErr)!{{{
+
+ !--------------------------------------------------------------------
+ type (mpas_pool_type), intent(inout) :: configPool, packagePool
+ type (mpas_io_context_type), intent(inout) :: iocontext
+
+ integer, intent(out) :: iErr
+
+ character (len=StrKIND), pointer :: config_init_configuration
+ integer, pointer :: config_vert_levels, config_baroclinic_channel_vert_levels
+
+ iErr = 0
+
+ call mpas_pool_get_config(configPool, 'config_init_configuration', config_init_configuration)
+
+ if(config_init_configuration .ne. trim('baroclinic_channel')) return
+
+ call mpas_pool_get_config(configPool, 'config_vert_levels', config_vert_levels)
+ call mpas_pool_get_config(configPool, 'config_baroclinic_channel_vert_levels', config_baroclinic_channel_vert_levels)
+
+ if(config_vert_levels <= 0 .and. config_baroclinic_channel_vert_levels > 0) then
+ config_vert_levels = config_baroclinic_channel_vert_levels
+ else if (config_vert_levels <= 0) then
+ write(stderrUnit,*) 'ERROR: Validation failed for baroclinic channel. Not given a usable value for vertical levels.'
+ iErr = 1
+ end if
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_validate_baroclinic_channel!}}}
+
+!***********************************************************************
+
+end module ocn_init_baroclinic_channel
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_cell_markers.F b/src/core_ocean/mode_init/mpas_ocn_init_cell_markers.F
new file mode 100644
index 0000000000..6a923a689f
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_cell_markers.F
@@ -0,0 +1,301 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_cell_markers
+!
+!> \brief MPAS ocean cell marker
+!> \author Doug Jacobsen
+!> \date 03/20/2015
+!> \details
+!> This module contains the routines for marking
+!> cells for removing
+!
+!-----------------------------------------------------------------------
+module ocn_init_cell_markers
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+ use mpas_timer
+
+ use ocn_constants
+
+ implicit none
+ private
+
+ public :: ocn_mark_north_boundary, ocn_mark_south_boundary
+ public :: ocn_mark_east_boundary, ocn_mark_west_boundary
+ public :: ocn_mark_maxlevelcell
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+ !***********************************************************************
+ !
+ ! routine ocn_mark_north_boundary
+ !
+ !> \brief North boundary marker
+ !> \author Doug Jacobsen
+ !> \date 03/30/2015
+ !> \details
+ !> This routine marks cells along the north boundary of a domain for removal.
+ !> It can only be applied to a planar mesh. North-south is defined as the y direction.
+ !
+ !-----------------------------------------------------------------------
+ subroutine ocn_mark_north_boundary(meshPool, yMax, edgeMin, iErr)!{{{
+ implicit none
+
+ type (mpas_pool_type), intent(in) :: meshPool
+ real (kind=RKIND), intent(in) :: yMax
+ real (kind=RKIND), intent(in) :: edgeMin
+ integer, intent(out) :: iErr
+
+ real (kind=RKIND), dimension(:), pointer :: yCell
+ integer, dimension(:), pointer :: cullCell
+
+ logical, pointer :: on_a_sphere
+ integer, pointer :: nCells
+
+ integer :: iCell
+
+ iErr = 0
+
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+
+ if ( on_a_sphere ) write(stderrUnit, *) 'WARNING: Can only mark north boundaries of planar meshes. ' &
+ // 'Skipping marking of cells...'
+
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'cullCell', cullCell)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ if ( associated(cullCell) ) then
+ do iCell = 1, nCells
+ if ( yCell(iCell) > yMax - 0.8_RKIND * edgeMin ) then
+ cullCell(iCell) = 1
+ end if
+ end do
+ end if
+
+ end subroutine ocn_mark_north_boundary!}}}
+
+ !***********************************************************************
+ !
+ ! routine ocn_mark_south_boundary
+ !
+ !> \brief south boundary marker
+ !> \author Doug Jacobsen
+ !> \date 03/30/2015
+ !> \details
+ !> This routine marks cells along the south boundary of a domain for removal.
+ !> It can only be applied to a planar mesh. north-south is defined as the y direction.
+ !
+ !-----------------------------------------------------------------------
+ subroutine ocn_mark_south_boundary(meshPool, yMin, edgeMin, iErr)!{{{
+ implicit none
+
+ type (mpas_pool_type), intent(in) :: meshPool
+ real (kind=RKIND), intent(in) :: yMin
+ real (kind=RKIND), intent(in) :: edgeMin
+ integer, intent(out) :: iErr
+
+ real (kind=RKIND), dimension(:), pointer :: yCell
+ integer, dimension(:), pointer :: cullCell
+
+ logical, pointer :: on_a_sphere
+ integer, pointer :: nCells
+
+ integer :: iCell
+
+ iErr = 0
+
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+
+ if ( on_a_sphere ) write(stderrUnit, *) 'WARNING: Can only mark north boundaries of planar meshes. ' &
+ // 'Skipping marking of cells...'
+
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'cullCell', cullCell)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ if ( associated(cullCell) ) then
+ do iCell = 1, nCells
+ if ( yCell(iCell) < yMin + 0.8_RKIND * edgeMin ) then
+ cullCell(iCell) = 1
+ end if
+ end do
+ end if
+
+ end subroutine ocn_mark_south_boundary!}}}
+
+ !***********************************************************************
+ !
+ ! routine ocn_mark_east_boundary
+ !
+ !> \brief East boundary marker
+ !> \author Doug Jacobsen
+ !> \date 03/30/2015
+ !> \details
+ !> This routine marks cells along the east boundary of a domain for removal.
+ !> It can only be applied to a planar mesh. west-east is defined as the x direction.
+ !
+ !-----------------------------------------------------------------------
+ subroutine ocn_mark_east_boundary(meshPool, xMax, edgeMin, iErr)!{{{
+ implicit none
+
+ type (mpas_pool_type), intent(in) :: meshPool
+ real (kind=RKIND), intent(in) :: xMax
+ real (kind=RKIND), intent(in) :: edgeMin
+ integer, intent(out) :: iErr
+
+ real (kind=RKIND), dimension(:), pointer :: xCell
+ integer, dimension(:), pointer :: cullCell
+
+ logical, pointer :: on_a_sphere
+ integer, pointer :: nCells
+
+ integer :: iCell
+
+ iErr = 0
+
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+
+ if ( on_a_sphere ) write(stderrUnit, *) 'WARNING: Can only mark north boundaries of planar meshes. ' &
+ // 'Skipping marking of cells...'
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'cullCell', cullCell)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ if ( associated(cullCell) ) then
+ do iCell = 1, nCells
+ if ( xCell(iCell) > xMax - 0.8_RKIND * edgeMin ) then
+ cullCell(iCell) = 1
+ end if
+ end do
+ end if
+
+ end subroutine ocn_mark_east_boundary!}}}
+
+ !***********************************************************************
+ !
+ ! routine ocn_mark_west_boundary
+ !
+ !> \brief West boundary marker
+ !> \author Doug Jacobsen
+ !> \date 03/30/2015
+ !> \details
+ !> This routine marks cells along the west boundary of a domain for removal.
+ !> It can only be applied to a planar mesh. west-east is defined as the x direction.
+ !
+ !-----------------------------------------------------------------------
+ subroutine ocn_mark_west_boundary(meshPool, xMin, edgeMin, iErr)!{{{
+ implicit none
+
+ type (mpas_pool_type), intent(in) :: meshPool
+ real (kind=RKIND), intent(in) :: xMin
+ real (kind=RKIND), intent(in) :: edgeMin
+ integer, intent(out) :: iErr
+
+ real (kind=RKIND), dimension(:), pointer :: xCell
+ integer, dimension(:), pointer :: cullCell
+
+ logical, pointer :: on_a_sphere
+ integer, pointer :: nCells
+
+ integer :: iCell
+
+ iErr = 0
+
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+
+ if ( on_a_sphere ) write(stderrUnit, *) 'WARNING: Can only mark north boundaries of planar meshes. ' &
+ // 'Skipping marking of cells...'
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'cullCell', cullCell)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ if ( associated(cullCell) ) then
+ do iCell = 1, nCells
+ if ( xCell(iCell) < xMin + 0.8_RKIND * edgeMin ) then
+ cullCell(iCell) = 1
+ end if
+ end do
+ end if
+
+ end subroutine ocn_mark_west_boundary!}}}
+
+ !***********************************************************************
+ !
+ ! routine ocn_mark_maxlevelcell
+ !
+ !> \brief MaxLevelCell cell marker
+ !> \author Doug Jacobsen
+ !> \date 03/31/2015
+ !> \details
+ !> This routine marks cells for removal that have maxLevelCell <= 0.
+ !
+ !-----------------------------------------------------------------------
+ subroutine ocn_mark_maxlevelcell(meshPool, iErr)!{{{
+ implicit none
+
+ type (mpas_pool_type), intent(in) :: meshPool
+ integer, intent(out) :: iErr
+
+ integer, dimension(:), pointer :: cullCell, maxLevelCell
+
+ logical, pointer :: on_a_sphere
+
+ integer, pointer :: nCells
+
+ integer :: iCell
+
+ iErr = 0
+
+ call mpas_pool_get_array(meshPool, 'cullCell', cullCell)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ if ( associated(cullCell) ) then
+ do iCell = 1, nCells
+ if ( maxLevelCell(iCell) <= 0 ) then
+ cullCell(iCell) = 1
+ end if
+ end do
+ end if
+
+ end subroutine ocn_mark_maxlevelcell!}}}
+
+!***********************************************************************
+
+end module ocn_init_cell_markers
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_cvmix_WSwSBF.F b/src/core_ocean/mode_init/mpas_ocn_init_cvmix_WSwSBF.F
new file mode 100644
index 0000000000..2c4e5d4351
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_cvmix_WSwSBF.F
@@ -0,0 +1,478 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_cvmix_WSwSBF
+!
+!> \brief MPAS ocean initialize case -- CVMix Unit Test
+!> WSwSBF means Wind Stress with Surface Buoyancy Forcing
+!> \author Todd Ringler
+!> \date 04/23/2015
+!> \details
+!> This module contains the routines for initializing the
+!> the cvmix WSwSBF unit test configuration. This in a
+!> single column configuration
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_cvmix_WSwSBF
+
+ use mpas_kind_types
+ use mpas_io_units
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+
+ use ocn_init_cell_markers
+ use ocn_init_vertical_grids
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_setup_cvmix_WSwSBF, &
+ ocn_init_validate_cvmix_WSwSBF
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_setup_cvmix_WSwSBF
+!
+!> \brief Setup for cvmix WSwSBF unit test configuration
+!> \author Todd Ringler
+!> \date 04/23/2015
+!> \details
+!> This routine sets up the initial conditions for the cvmix WSwSBF unit test configuration.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_cvmix_WSwSBF(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+ real (kind=RKIND) :: temperature, salinity
+
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool, verticalMeshPool, statePool
+ type (mpas_pool_type), pointer :: diagnosticsPool, forcingPool
+
+ type (mpas_pool_type), pointer :: tracersPool, &
+ tracersSurfaceRestoringFieldsPool, &
+ tracersInteriorRestoringFieldsPool
+
+ integer, pointer :: nVertLevels, nVertLevelsP1, nCellsSolve, nEdgesSolve, nVerticesSolve
+ integer, pointer :: index_temperature, index_salinity, index_tracer1
+
+ integer, dimension(:), pointer :: maxLevelCell
+ real (kind=RKIND), dimension(:), pointer :: refBottomDepth, refZMid, vertCoordMovementWeights
+ real (kind=RKIND), dimension(:), pointer :: windStressZonal, windStressMeridional
+ real (kind=RKIND), dimension(:), pointer :: latentHeatFlux, sensibleHeatFlux, shortWaveHeatFlux
+ real (kind=RKIND), dimension(:), pointer :: evaporationFlux, rainFlux
+ real (kind=RKIND), dimension(:), pointer :: salinityRestore, bottomDepth, angleEdge
+ real (kind=RKIND), dimension(:), pointer :: fCell, fEdge, fVertex
+ real (kind=RKIND), dimension(:, :), pointer :: layerThickness, restingThickness
+ real (kind=RKIND), dimension(:, :, :), pointer :: activeTracers, debugTracers
+ real (kind=RKIND), dimension(:, :), pointer :: activeTracersPistonVelocity, activeTracersSurfaceRestoringValue
+ real (kind=RKIND), dimension(:, :, :), pointer :: activeTracersInteriorRestoringValue, activeTracersInteriorRestoringRate
+
+ real (kind=RKIND), dimension(:), pointer :: interfaceLocations
+
+ integer :: iCell, iEdge, iVertex, k, kML
+
+ real (kind=RKIND) :: BLdepth
+
+ character (len=StrKIND), pointer :: config_init_configuration, &
+ config_cvmix_WSwSBF_vertical_grid
+
+ integer, pointer :: config_cvmix_WSwSBF_vert_levels
+
+ real (kind=RKIND), pointer :: config_cvmix_WSwSBF_surface_temperature, &
+ config_cvmix_WSwSBF_surface_salinity, &
+ config_cvmix_WSwSBF_surface_restoring_temperature, &
+ config_cvmix_WSwSBF_surface_restoring_salinity, &
+ config_cvmix_WSwSBF_temperature_piston_velocity, &
+ config_cvmix_WSwSBF_salinity_piston_velocity, &
+ config_cvmix_WSwSBF_sensible_heat_flux, &
+ config_cvmix_WSwSBF_latent_heat_flux, &
+ config_cvmix_WSwSBF_shortwave_heat_flux, &
+ config_cvmix_WSwSBF_rain_flux, &
+ config_cvmix_WSwSBF_evaporation_flux, &
+ config_cvmix_WSwSBF_interior_temperature_restoring_rate, &
+ config_cvmix_WSwSBF_interior_salinity_restoring_rate, &
+ config_cvmix_WSwSBF_temperature_gradient, &
+ config_cvmix_WSwSBF_salinity_gradient, &
+ config_cvmix_WSwSBF_bottom_depth, &
+ config_cvmix_WSwSBF_max_windstress, &
+ config_cvmix_WSwSBF_coriolis_parameter, &
+ config_cvmix_WSwSBF_temperature_gradient_mixed_layer, &
+ config_cvmix_WSwSBF_salinity_gradient_mixed_layer, &
+ config_cvmix_WSwSBF_mixed_layer_depth_temperature, &
+ config_cvmix_WSwSBF_mixed_layer_depth_salinity, &
+ config_cvmix_WSwSBF_mixed_layer_temperature_change, &
+ config_cvmix_WSwSBF_mixed_layer_salinity_change
+ ! assume no error
+ iErr = 0
+
+ ! get and test if this is the configuration specified
+ call mpas_pool_get_config(domain % configs, 'config_init_configuration', config_init_configuration)
+ if(config_init_configuration .ne. trim('cvmix_WSwSBF')) return
+
+ ! build the vertical grid
+ ! intent(out) is interfaceLocations. An array ranging from 0 to 1
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_vertical_grid', config_cvmix_WSwSBF_vertical_grid)
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, 'nVertLevelsP1', nVertLevelsP1)
+ allocate(interfaceLocations(nVertLevelsP1))
+ call ocn_generate_vertical_grid(config_cvmix_WSwSBF_vertical_grid, interfaceLocations)
+
+ ! load the remaining configuration parameters
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_surface_temperature', &
+ config_cvmix_WSwSBF_surface_temperature)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_surface_salinity', config_cvmix_WSwSBF_surface_salinity)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_surface_restoring_temperature', &
+ config_cvmix_WSwSBF_surface_restoring_temperature)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_surface_restoring_salinity', &
+ config_cvmix_WSwSBF_surface_restoring_salinity)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_temperature_piston_velocity', &
+ config_cvmix_WSwSBF_temperature_piston_velocity)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_salinity_piston_velocity', &
+ config_cvmix_WSwSBF_salinity_piston_velocity)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_sensible_heat_flux', config_cvmix_WSwSBF_sensible_heat_flux)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_latent_heat_flux', config_cvmix_WSwSBF_latent_heat_flux)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_shortwave_heat_flux', &
+ config_cvmix_WSwSBF_shortwave_heat_flux)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_rain_flux', config_cvmix_WSwSBF_rain_flux)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_evaporation_flux', config_cvmix_WSwSBF_evaporation_flux)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_interior_temperature_restoring_rate', &
+ config_cvmix_WSwSBF_interior_temperature_restoring_rate)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_interior_salinity_restoring_rate', &
+ config_cvmix_WSwSBF_interior_salinity_restoring_rate)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_temperature_gradient', &
+ config_cvmix_WSwSBF_temperature_gradient)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_salinity_gradient', config_cvmix_WSwSBF_salinity_gradient)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_bottom_depth', config_cvmix_WSwSBF_bottom_depth)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_max_windstress', config_cvmix_WSwSBF_max_windstress)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_coriolis_parameter', config_cvmix_WSwSBF_coriolis_parameter)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_temperature_gradient_mixed_layer', &
+ config_cvmix_WSwSBF_temperature_gradient_mixed_layer)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_salinity_gradient_mixed_layer', &
+ config_cvmix_WSwSBF_salinity_gradient_mixed_layer)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_mixed_layer_depth_temperature', &
+ config_cvmix_WSwSBF_mixed_layer_depth_temperature)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_mixed_layer_depth_salinity', &
+ config_cvmix_WSwSBF_mixed_layer_depth_salinity)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_mixed_layer_temperature_change', &
+ config_cvmix_WSwSBF_mixed_layer_temperature_change)
+ call mpas_pool_get_config(domain % configs, 'config_cvmix_WSwSBF_mixed_layer_salinity_change', &
+ config_cvmix_WSwSBF_mixed_layer_salinity_change)
+
+ ! load data that required to initialize the ocean simulation
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool)
+
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_subpool(forcingPool, 'tracersSurfaceRestoringFields', tracersSurfaceRestoringFieldsPool)
+ call mpas_pool_get_subpool(forcingPool, 'tracersInteriorRestoringFields', tracersInteriorRestoringFieldsPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
+ call mpas_pool_get_dimension(meshPool, 'nVerticesSolve', nVerticesSolve)
+
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', index_temperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', index_salinity)
+ call mpas_pool_get_dimension(tracersPool, 'index_tracer1', index_tracer1)
+
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_array(meshPool, 'vertCoordMovementWeights', vertCoordMovementWeights)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'angleEdge', angleEdge)
+
+ call mpas_pool_get_array(meshPool, 'fCell', fCell)
+ call mpas_pool_get_array(meshPool, 'fEdge', fEdge)
+ call mpas_pool_get_array(meshPool, 'fVertex', fVertex)
+
+ call mpas_pool_get_array(verticalMeshPool, 'refZMid', refZMid)
+ call mpas_pool_get_array(verticalMeshPool, 'restingThickness', restingThickness)
+
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+ call mpas_pool_get_array(tracersPool, 'debugTracers', debugTracers, 1)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+
+ call mpas_pool_get_array(forcingPool, 'windStressZonal', windStressZonal, 1)
+ call mpas_pool_get_array(forcingPool, 'windStressMeridional', windStressMeridional, 1)
+ call mpas_pool_get_array(tracersSurfaceRestoringFieldsPool, 'activeTracersPistonVelocity', activeTracersPistonVelocity, 1)
+ call mpas_pool_get_array(tracersSurfaceRestoringFieldsPool, 'activeTracersSurfaceRestoringValue', &
+ activeTracersSurfaceRestoringValue, 1)
+ call mpas_pool_get_array(tracersInteriorRestoringFieldsPool, 'activeTracersInteriorRestoringRate', &
+ activeTracersInteriorRestoringRate, 1)
+ call mpas_pool_get_array(tracersInteriorRestoringFieldsPool, 'activeTracersInteriorRestoringValue', &
+ activeTracersInteriorRestoringValue, 1)
+ call mpas_pool_get_array(forcingPool, 'latentHeatFlux', latentHeatFlux)
+ call mpas_pool_get_array(forcingPool, 'sensibleHeatFlux', sensibleHeatFlux)
+ call mpas_pool_get_array(forcingPool, 'shortWaveHeatFlux', shortWaveHeatFlux)
+ call mpas_pool_get_array(forcingPool, 'evaporationFlux', evaporationFlux)
+ call mpas_pool_get_array(forcingPool, 'rainFlux', rainFlux)
+
+
+ ! Set refBottomDepth and refBottomDepthTopOfCell
+ do k = 1, nVertLevels
+ refBottomDepth(k) = config_cvmix_WSwSBF_bottom_depth * interfaceLocations(k+1)
+ refZMid(k) = - 0.5_RKIND * config_cvmix_WSwSBF_bottom_depth * (interfaceLocations(k) + interfaceLocations(k+1))
+ end do
+
+ ! Set vertCoordMovementWeights
+ vertCoordMovementWeights(:) = 1.0_RKIND
+
+ do iCell = 1, nCellsSolve
+ if(associated(activeTracers) ) then
+
+ ! Loop from surface through surface layer depth
+ k=1
+
+ do while (k .le. nVertLevels .and. refZMid(k) > - config_cvmix_WSwSBF_mixed_layer_depth_temperature)
+ temperature = config_cvmix_WSwSBF_surface_temperature + refZMid(k) * &
+ config_cvmix_WSwSBF_temperature_gradient_mixed_layer
+ activeTracers(index_temperature, k, iCell) = temperature
+ k = k + 1
+ enddo
+
+ ! the value of k is now the first layer below the surface layer
+ if ( k > 1 ) then
+ temperature = activeTracers(index_temperature, k-1, iCell) + config_cvmix_WSwSBF_mixed_layer_temperature_change
+ activeTracers(index_temperature, k, iCell) = temperature
+ BLdepth = refZMid(k)
+ else
+ activeTracers(index_temperature, k, iCell) = config_cvmix_WSwSBF_surface_temperature
+ BLdepth = 0.0_RKIND
+ endif
+
+ ! find the first level below the mixed layer
+ kML = k + 1
+
+ ! now loop from the bottom of the mixed layer thru to the bottom of the domain
+ do k = kML, nVertLevels
+ temperature = activeTracers(index_temperature, kML-1, iCell) + (refZMid(k) - BLdepth) * &
+ config_cvmix_WSwSBF_temperature_gradient
+ activeTracers(index_temperature, k, iCell) = temperature
+ enddo
+
+ !
+ ! next compute the salinity profile
+ !
+
+ ! Loop from surface through surface layer depth
+ k=1
+ do while (k .le. nVertLevels .and. refZMid(k) > - config_cvmix_WSwSBF_mixed_layer_depth_salinity)
+ salinity = config_cvmix_WSwSBF_surface_salinity + refZMid(k) * config_cvmix_WSwSBF_salinity_gradient_mixed_layer
+ activeTracers(index_salinity, k, iCell) = salinity
+ k = k + 1
+ enddo
+
+ ! the value of k is now the first layer below the surface layer
+ if ( k > 1 ) then
+ salinity = activeTracers(index_salinity, k-1, iCell) + config_cvmix_WSwSBF_mixed_layer_salinity_change
+ activeTracers(index_salinity, k, iCell) = salinity
+ BLdepth = refZMid(k)
+ else
+ activeTracers(index_salinity, k, iCell) = config_cvmix_WSwSBF_surface_salinity
+ BLdepth = 0.0_RKIND
+ endif
+
+ ! find the first level below the mixed layer
+ kML = k + 1
+
+ ! now loop from the bottom of the mixed layer thru to the bottom of the domain
+ do k = kML, nVertLevels
+ salinity = activeTracers(index_salinity, kML-1, iCell) + (refZMid(k) - BLdepth) * &
+ config_cvmix_WSwSBF_salinity_gradient
+ activeTracers(index_salinity, k, iCell) = salinity
+ enddo
+
+ endif ! if (associated(activeTracer))
+
+ ! as a place holder, have some debug tracer in the top few layers and zero below
+ if ( associated(debugTracers) ) then
+ debugTracers(index_tracer1, k, iCell) = 0.0_RKIND
+ do k=1,min(4,nVertLevels)
+ debugTracers(index_tracer1, k, iCell) = 1.0_RKIND
+ enddo
+ endif
+
+ ! Set layerThickness
+ do k = 1, nVertLevels
+ layerThickness(k, iCell) = config_cvmix_WSwSBF_bottom_depth * (interfaceLocations(k+1) - interfaceLocations(k))
+ restingThickness(k, iCell) = layerThickness(k, iCell)
+ end do
+
+ ! Set surface temperature restoring value and rate
+ ! Value in units of C, piston velocity in units of m/s
+ if ( associated(activeTracersSurfaceRestoringValue) ) then
+ activeTracersSurfaceRestoringValue(index_temperature, iCell) = config_cvmix_WSwSBF_surface_restoring_temperature
+ end if
+ if ( associated(activeTracersPistonVelocity) ) then
+ activeTracersPistonVelocity(index_temperature, iCell) = config_cvmix_WSwSBF_temperature_piston_velocity
+ end if
+
+ ! Set surface salinity restoring value and rate
+ ! Value in units of PSU, piston velocity in units of m/s
+ if ( associated(activeTracersSurfaceRestoringValue) ) then
+ activeTracersSurfaceRestoringValue(index_salinity, iCell) = config_cvmix_WSwSBF_surface_restoring_salinity
+ end if
+ if ( associated(activeTracersPistonVelocity) ) then
+ activeTracersPistonVelocity(index_salinity, iCell) = config_cvmix_WSwSBF_salinity_piston_velocity
+ end if
+
+ ! Set sensible heat flux
+ sensibleHeatFlux(iCell) = config_cvmix_WSwSBF_sensible_heat_flux
+
+ ! Set latent heat flux
+ latentHeatFlux(iCell) = config_cvmix_WSwSBF_latent_heat_flux
+
+ ! Set shortwave heat flux
+ shortWaveHeatFlux(iCell) = config_cvmix_WSwSBF_shortwave_heat_flux
+
+ ! Set precipation and evaporation
+ rainFlux(iCell) = config_cvmix_WSwSBF_rain_flux
+ evaporationFlux(iCell) = config_cvmix_WSwSBF_evaporation_flux
+
+ ! Set interior temperature restoring value and rate
+ do k = 1, nVertLevels
+ if ( associated(activeTracersInteriorRestoringValue) ) then
+ activeTracersInteriorRestoringValue(index_temperature, k, iCell) = activeTracers(index_temperature, k, iCell)
+ end if
+ if ( associated(activeTracersInteriorRestoringRate) ) then
+ activeTracersInteriorRestoringRate(index_temperature, k, iCell) = &
+ config_cvmix_WSwSBF_interior_temperature_restoring_rate
+ end if
+ enddo
+
+ ! Set interior salinity restoring value and rate
+ do k = 1, nVertLevels
+ if ( associated(activeTracersInteriorRestoringValue) ) then
+ activeTracersInteriorRestoringValue(index_salinity, k, iCell) = activeTracers(index_salinity, k, iCell)
+ end if
+ if ( associated(activeTracersInteriorRestoringRate) ) then
+ activeTracersInteriorRestoringRate(index_salinity, k, iCell) = config_cvmix_WSwSBF_interior_salinity_restoring_rate
+ end if
+ enddo
+
+ ! Set Coriolis parameter
+ fCell(iCell) = config_cvmix_WSwSBF_coriolis_parameter
+
+ ! Set bottomDepth
+ bottomDepth(iCell) = config_cvmix_WSwSBF_bottom_depth
+
+ ! Set maxLevelCell
+ maxLevelCell(iCell) = nVertLevels
+
+ end do ! do iCell
+
+ do iCell = 1, nCellsSolve
+ windStressZonal(iCell) = config_cvmix_WSwSBF_max_windstress
+ windStressMeridional(iCell) = 0.0_RKIND
+ enddo
+
+ do iEdge = 1, nEdgesSolve
+ fEdge(iEdge) = config_cvmix_WSwSBF_coriolis_parameter
+ end do
+
+ do iVertex=1, nVerticesSolve
+ fVertex(iVertex) = config_cvmix_WSwSBF_coriolis_parameter
+ end do
+
+ block_ptr => block_ptr % next
+ end do
+
+ deallocate(interfaceLocations)
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_setup_cvmix_WSwSBF!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_validate_cvmix_WSwSBF
+!
+!> \brief Validation for CVMix WSwSBF mixing unit test case
+!> \author Doug Jacobsen
+!> \date 04/01/2015
+!> \details
+!> This routine validates the configuration options for the CVMix WSwSBF mixing unit test configuration.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_validate_cvmix_WSwSBF(configPool, packagePool, iocontext, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (mpas_pool_type), intent(inout) :: configPool
+ type (mpas_pool_type), intent(inout) :: packagePool
+ type (mpas_io_context_type), intent(inout) :: iocontext
+
+ integer, intent(out) :: iErr
+
+ character (len=StrKIND), pointer :: config_init_configuration
+ integer, pointer :: config_vert_levels, config_cvmix_WSwSBF_vert_levels
+
+ iErr = 0
+
+ call mpas_pool_get_config(configPool, 'config_init_configuration', config_init_configuration)
+
+ if(config_init_configuration .ne. trim('cvmix_WSwSBF')) return
+
+ call mpas_pool_get_config(configPool, 'config_vert_levels', config_vert_levels)
+ call mpas_pool_get_config(configPool, 'config_cvmix_WSwSBF_vert_levels', config_cvmix_WSwSBF_vert_levels)
+
+ if(config_vert_levels <= 0 .and. config_cvmix_WSwSBF_vert_levels > 0) then
+ config_vert_levels = config_cvmix_WSwSBF_vert_levels
+ else if(config_vert_levels <= 0) then
+ write(stderrUnit,*) 'ERROR: Validation failed for CVMix WSwSBF unit test case. Not given a usable value for ' &
+ // 'vertical levels.'
+ iErr = 1
+ end if
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_validate_cvmix_WSwSBF!}}}
+
+!***********************************************************************
+
+end module ocn_init_cvmix_WSwSBF
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_ecosys_column.F b/src/core_ocean/mode_init/mpas_ocn_init_ecosys_column.F
new file mode 100644
index 0000000000..8049d41a6d
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_ecosys_column.F
@@ -0,0 +1,561 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_ecosys_column
+!
+!> \brief MPAS ocean initialize case -- BGC (ecosys + DMS + MacroMolecules)
+!> \author Mathew Maltrud
+!> \date 11/01/2015
+!> \details
+!> This module contains the routines for initializing the
+!> the ecosys column test configuration. This in a
+!> single column configuration.
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_ecosys_column
+
+ use mpas_kind_types
+ use mpas_io_units
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+ use mpas_io_streams
+
+ use ocn_init_cell_markers
+ use ocn_init_vertical_grids
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_setup_ecosys_column, &
+ ocn_init_setup_ecosys_read_column, &
+ ocn_init_validate_ecosys_column
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ type (field2DReal) :: columnIC
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_setup_ecosys_column
+!
+!> \brief Setup for ecosys column test configuration
+!> \author Mathew Maltrud
+!> \date 11/01/2015
+!> \details
+!> This routine sets up the initial conditions for the ecosys column test configuration.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_ecosys_column(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool, verticalMeshPool, statePool
+ type (mpas_pool_type), pointer :: diagnosticsPool, forcingPool
+ type (mpas_pool_type), pointer :: ecosysAuxiliary ! additional forcing fields
+
+ type (mpas_pool_type), pointer :: tracersPool
+
+ integer, pointer :: nVertLevels, nVertLevelsP1, nCellsSolve, index_dummy
+
+ integer, dimension(:), pointer :: maxLevelCell
+ real (kind=RKIND), dimension(:), pointer :: refBottomDepth, refZMid, vertCoordMovementWeights
+ real (kind=RKIND), dimension(:), pointer :: bottomDepth
+ real (kind=RKIND), dimension(:, :), pointer :: layerThickness, restingThickness
+ real (kind=RKIND), dimension(:), pointer :: PH_PREV, PH_PREV_ALT_CO2
+ real (kind=RKIND), dimension(:, :), pointer :: PH_PREV_3D, PH_PREV_ALT_CO2_3D
+ real (kind=RKIND), dimension(:, :, :), pointer :: activeTracers, ecosysTracers, DMSTracers, &
+ MacroMoleculesTracers
+
+ real (kind=RKIND), dimension(:), pointer :: interfaceLocations
+
+ real (kind=RKIND), allocatable, dimension(:,:) :: ecoFieldColumn
+
+ integer :: iCell, iEdge, iVertex, iField, k, numTracersTotal, nVertLevelsInputColumn
+
+ integer, allocatable, dimension(:) :: indexField
+
+ character (len=StrKIND) :: fieldName
+
+ character (len=StrKIND), pointer :: config_init_configuration, &
+ config_ecosys_column_TS_filename, &
+ config_ecosys_column_ecosys_filename, &
+ config_ecosys_column_vertical_grid
+
+ integer, pointer :: config_ecosys_column_vert_levels
+
+ real (kind=RKIND), pointer :: config_ecosys_column_bottom_depth
+
+ ! assume no error
+ iErr = 0
+
+ ! get and test if this is the configuration specified
+ call mpas_pool_get_config(domain % configs, 'config_init_configuration', config_init_configuration)
+ if(config_init_configuration .ne. trim('ecosys_column')) return
+
+ ! build the vertical grid
+ ! intent(out) is interfaceLocations. An array ranging from 0 to 1
+ call mpas_pool_get_config(domain % configs, 'config_ecosys_column_vertical_grid', config_ecosys_column_vertical_grid)
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, 'nVertLevelsP1', nVertLevelsP1)
+ allocate(interfaceLocations(nVertLevelsP1))
+ call ocn_generate_vertical_grid(config_ecosys_column_vertical_grid, interfaceLocations)
+
+ ! load the remaining configuration parameters
+ call mpas_pool_get_config(domain % configs, 'config_ecosys_column_bottom_depth', config_ecosys_column_bottom_depth)
+ call mpas_pool_get_config(domain % configs, 'config_ecosys_column_TS_filename', config_ecosys_column_TS_filename)
+ call mpas_pool_get_config(domain % configs, 'config_ecosys_column_ecosys_filename', config_ecosys_column_ecosys_filename)
+ call mpas_pool_get_config(domain % configs, 'config_ecosys_column_vert_levels', config_ecosys_column_vert_levels)
+
+ nVertLevelsInputColumn = config_ecosys_column_vert_levels
+
+ ! load data that required to initialize the ocean simulation
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool)
+
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_array(meshPool, 'vertCoordMovementWeights', vertCoordMovementWeights)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+
+ call mpas_pool_get_array(verticalMeshPool, 'refZMid', refZMid)
+ call mpas_pool_get_array(verticalMeshPool, 'restingThickness', restingThickness)
+
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+ call mpas_pool_get_array(tracersPool, 'ecosysTracers', ecosysTracers, 1)
+ call mpas_pool_get_array(tracersPool, 'DMSTracers', DMSTracers, 1)
+ call mpas_pool_get_array(tracersPool, 'MacroMoleculesTracers', MacroMoleculesTracers, 1)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+
+ call mpas_pool_get_subpool(forcingPool, 'ecosysAuxiliary', ecosysAuxiliary)
+
+ call mpas_pool_get_array(ecosysAuxiliary, 'PH_PREV', PH_PREV)
+ call mpas_pool_get_array(ecosysAuxiliary, 'PH_PREV_ALT_CO2', PH_PREV_ALT_CO2)
+ call mpas_pool_get_array(ecosysAuxiliary, 'PH_PREV_3D', PH_PREV_3D)
+ call mpas_pool_get_array(ecosysAuxiliary, 'PH_PREV_ALT_CO2_3D', PH_PREV_ALT_CO2_3D)
+
+ ! Set refBottomDepth and refBottomDepthTopOfCell
+ do k = 1, nVertLevels
+ refBottomDepth(k) = config_ecosys_column_bottom_depth * interfaceLocations(k+1)
+ refZMid(k) = - 0.5_RKIND * config_ecosys_column_bottom_depth * (interfaceLocations(k) + interfaceLocations(k+1))
+ end do
+
+ ! Set vertCoordMovementWeights
+ vertCoordMovementWeights(:) = 1.0_RKIND
+
+ if (nVertLevelsInputColumn /= nVertLevels) return
+
+ numTracersTotal = 32 ! T,S + 30 eco
+ allocate(ecoFieldColumn(nVertLevelsInputColumn, numTracersTotal))
+ allocate(indexField(numTracersTotal))
+
+ if ( associated(activeTracers) ) then
+ fieldName = 'temperature'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_TS_filename, &
+ nVertLevelsInputColumn, 1, ecoFieldColumn, iErr)
+
+ fieldName = 'salinity'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_TS_filename, &
+ nVertLevelsInputColumn, 2, ecoFieldColumn, iErr)
+
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', index_dummy)
+ indexField(1) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', index_dummy)
+ indexField(2) = index_dummy
+ do iCell = 1, nCellsSolve
+ do k = 1, nVertLevels
+ activeTracers(indexField(1), k, iCell) = ecoFieldColumn(k,1)
+ activeTracers(indexField(2), k, iCell) = ecoFieldColumn(k,2)
+ end do
+ end do
+ end if
+
+ if ( associated(ecosysTracers) ) then
+
+ fieldName = 'PO4'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 3, ecoFieldColumn, iErr)
+ fieldName = 'NO3'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 4, ecoFieldColumn, iErr)
+ fieldName = 'SiO3'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 5, ecoFieldColumn, iErr)
+ fieldName = 'NH4'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 6, ecoFieldColumn, iErr)
+ fieldName = 'Fe'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 7, ecoFieldColumn, iErr)
+ fieldName = 'O2'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 8, ecoFieldColumn, iErr)
+ fieldName = 'DIC'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 9, ecoFieldColumn, iErr)
+ fieldName = 'DIC_ALT_CO2'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 10, ecoFieldColumn, iErr)
+ fieldName = 'ALK'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 11, ecoFieldColumn, iErr)
+ fieldName = 'DOC'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 12, ecoFieldColumn, iErr)
+ fieldName = 'DON'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 13, ecoFieldColumn, iErr)
+ fieldName = 'DOFe'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 14, ecoFieldColumn, iErr)
+ fieldName = 'DOP'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 15, ecoFieldColumn, iErr)
+ fieldName = 'DOPr'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 16, ecoFieldColumn, iErr)
+ fieldName = 'DONr'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 17, ecoFieldColumn, iErr)
+ fieldName = 'zooC'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 18, ecoFieldColumn, iErr)
+ fieldName = 'spChl'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 19, ecoFieldColumn, iErr)
+ fieldName = 'spC'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 20, ecoFieldColumn, iErr)
+ fieldName = 'spFe'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 21, ecoFieldColumn, iErr)
+ fieldName = 'spCaCO3'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 22, ecoFieldColumn, iErr)
+ fieldName = 'diatChl'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 23, ecoFieldColumn, iErr)
+ fieldName = 'diatC'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 24, ecoFieldColumn, iErr)
+ fieldName = 'diatFe'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 25, ecoFieldColumn, iErr)
+ fieldName = 'diatSi'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 26, ecoFieldColumn, iErr)
+ fieldName = 'diazChl'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 27, ecoFieldColumn, iErr)
+ fieldName = 'diazC'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 28, ecoFieldColumn, iErr)
+ fieldName = 'diazFe'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 29, ecoFieldColumn, iErr)
+ fieldName = 'phaeoChl'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 30, ecoFieldColumn, iErr)
+ fieldName = 'phaeoC'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 31, ecoFieldColumn, iErr)
+ fieldName = 'phaeoFe'
+ call ocn_init_setup_ecosys_read_column(domain, fieldName, config_ecosys_column_ecosys_filename, &
+ nVertLevelsInputColumn, 32, ecoFieldColumn, iErr)
+
+ call mpas_pool_get_dimension(tracersPool, 'index_PO4', index_dummy)
+ indexField(3) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_NO3', index_dummy)
+ indexField(4) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_SiO3', index_dummy)
+ indexField(5) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_NH4', index_dummy)
+ indexField(6) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_Fe', index_dummy)
+ indexField(7) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_O2', index_dummy)
+ indexField(8) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DIC', index_dummy)
+ indexField(9) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DIC_ALT_CO2', index_dummy)
+ indexField(10) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_ALK', index_dummy)
+ indexField(11) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DOC', index_dummy)
+ indexField(12) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DON', index_dummy)
+ indexField(13) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DOFe', index_dummy)
+ indexField(14) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DOP', index_dummy)
+ indexField(15) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DOPr', index_dummy)
+ indexField(16) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DONr', index_dummy)
+ indexField(17) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_zooC', index_dummy)
+ indexField(18) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_spChl', index_dummy)
+ indexField(19) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_spC', index_dummy)
+ indexField(20) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_spFe', index_dummy)
+ indexField(21) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_spCaCO3', index_dummy)
+ indexField(22) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diatChl', index_dummy)
+ indexField(23) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diatC', index_dummy)
+ indexField(24) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diatFe', index_dummy)
+ indexField(25) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diatSi', index_dummy)
+ indexField(26) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diazChl', index_dummy)
+ indexField(27) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diazC', index_dummy)
+ indexField(28) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diazFe', index_dummy)
+ indexField(29) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_phaeoChl', index_dummy)
+ indexField(30) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_phaeoC', index_dummy)
+ indexField(31) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_phaeoFe', index_dummy)
+ indexField(32) = index_dummy
+
+ do iField = 3, numTracersTotal
+ do iCell = 1, nCellsSolve
+ do k = 1, nVertLevels
+ ecosysTracers(indexField(iField), k, iCell) = ecoFieldColumn(k,iField)
+ end do
+ end do
+ end do
+
+ do iCell = 1, nCellsSolve
+ PH_PREV(iCell) = 8.0_RKIND
+ PH_PREV_ALT_CO2(iCell) = 8.0_RKIND
+ do k = 1, nVertLevels
+ PH_PREV_3D(k, iCell) = 8.0_RKIND
+ PH_PREV_ALT_CO2_3D(k, iCell) = 8.0_RKIND
+ end do
+ end do
+
+ end if ! associated(ecosysTracers)
+
+ if ( associated(DMSTracers) ) then
+ call mpas_pool_get_dimension(tracersPool, 'index_DMS', index_dummy)
+ indexField(1) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DMSP', index_dummy)
+ indexField(2) = index_dummy
+ do iCell = 1, nCellsSolve
+ do k = 1, nVertLevels
+ DMSTracers(indexField(1), k, iCell) = 0.0_RKIND
+ DMSTracers(indexField(2), k, iCell) = 0.0_RKIND
+ end do
+ end do
+ end if ! associated(DMSTracers)
+
+ if ( associated(MacroMoleculesTracers) ) then
+ call mpas_pool_get_dimension(tracersPool, 'index_PROT', index_dummy)
+ indexField(1) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_POLY', index_dummy)
+ indexField(2) = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_LIP', index_dummy)
+ indexField(3) = index_dummy
+ do iCell = 1, nCellsSolve
+ do k = 1, nVertLevels
+ MacroMoleculesTracers(indexField(1), k, iCell) = 0.0_RKIND
+ MacroMoleculesTracers(indexField(2), k, iCell) = 0.0_RKIND
+ MacroMoleculesTracers(indexField(3), k, iCell) = 0.0_RKIND
+ end do
+ end do
+ end if ! associated(MacroMoleculesTracers)
+
+ do iCell = 1, nCellsSolve
+ ! Set layerThickness
+ do k = 1, nVertLevels
+ layerThickness(k, iCell) = config_ecosys_column_bottom_depth * (interfaceLocations(k+1) - interfaceLocations(k))
+ restingThickness(k, iCell) = layerThickness(k, iCell)
+ end do
+
+ ! Set bottomDepth
+ bottomDepth(iCell) = config_ecosys_column_bottom_depth
+
+ ! Set maxLevelCell
+ maxLevelCell(iCell) = nVertLevels
+ end do
+
+ block_ptr => block_ptr % next
+ end do
+
+ deallocate(interfaceLocations)
+ deallocate(ecoFieldColumn, indexField)
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_setup_ecosys_column!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_validate_ecosys_column
+!
+!> \brief Validation for ecosys column test case
+!> \author Mathew Maltrud
+!> \date 11/01/2015
+!> \details
+!> This routine validates the configuration options for the ecosys column test configuration.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_validate_ecosys_column(configPool, packagePool, iocontext, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (mpas_pool_type), intent(inout) :: configPool
+ type (mpas_pool_type), intent(inout) :: packagePool
+ type (mpas_io_context_type), intent(inout) :: iocontext
+
+ integer, intent(out) :: iErr
+
+ character (len=StrKIND), pointer :: config_init_configuration
+ integer, pointer :: config_vert_levels, config_ecosys_column_vert_levels
+
+ iErr = 0
+
+ call mpas_pool_get_config(configPool, 'config_init_configuration', config_init_configuration)
+
+ if(config_init_configuration .ne. trim('ecosys_column')) return
+
+ call mpas_pool_get_config(configPool, 'config_vert_levels', config_vert_levels)
+ call mpas_pool_get_config(configPool, 'config_ecosys_column_vert_levels', config_ecosys_column_vert_levels)
+
+ if(config_vert_levels <= 0 .and. config_ecosys_column_vert_levels > 0) then
+ config_vert_levels = config_ecosys_column_vert_levels
+ else if(config_vert_levels <= 0) then
+ write(stderrUnit,*) 'ERROR: Validation failed for ecosys column test case. Not given a usable value for vertical levels.'
+ iErr = 1
+ end if
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_validate_ecosys_column!}}}
+
+!***********************************************************************
+
+!
+! routine ocn_init_setup_ecosys_read_column
+!
+!> \brief Read a column of a specified field from a given file
+!> \author Mathew Maltrud
+!> \date 11/01/2014
+!> \details
+!> This routine reads a column of a specified field from a given file
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_ecosys_read_column(domain, fieldName, fileName, &
+ nVertLevelsInputColumn, iField, ecoFieldColumn, iErr)!{{{
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+ integer, intent(in) :: nVertLevelsInputColumn, iField
+ character (len=StrKIND), intent(in) :: fieldName, fileName
+ real (kind=RKIND), dimension(:,:), intent(inout) :: ecoFieldColumn
+
+ type (block_type), pointer :: block_ptr
+
+ type (MPAS_Stream_type) :: columnStream
+
+ character (len=StrKIND), pointer :: config_global_ocean_temperature_file, config_global_ocean_temperature_varname, &
+ config_global_ocean_tracer_nlon_dimname, config_global_ocean_tracer_nlat_dimname, &
+ config_global_ocean_depth_dimname
+
+ integer :: k
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_tracer_nlon_dimname', &
+ config_global_ocean_tracer_nlon_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_depth_dimname', config_global_ocean_depth_dimname)
+
+ ! Define stream for reading a column
+! call MPAS_createStream(columnStream, domain % iocontext, fileName, MPAS_IO_NETCDF, MPAS_IO_READ, ierr=iErr)
+ call MPAS_createStream(columnStream, domain % iocontext, fileName, MPAS_IO_NETCDF, MPAS_IO_READ)
+
+ ! Setup field for stream to be read in
+ columnIC % fieldName = trim(fieldName)
+ columnIC % dimSizes(1) = nVertLevelsInputColumn
+ columnIC % dimSizes(2) = 1
+ columnIC % dimNames(1) = 'nVertLevels'
+ columnIC % dimNames(2) = 'nCells'
+ columnIC % isVarArray = .false.
+ columnIC % isPersistent = .true.
+ columnIC % isActive = .true.
+ columnIC % hasTimeDimension = .false.
+ columnIC % block => domain % blocklist
+ allocate(columnIC % array(nVertLevelsInputColumn, 1))
+
+ ! Add column field to stream
+ call MPAS_streamAddField(columnStream, columnIC, iErr)
+
+ ! Read stream
+ call MPAS_readStream(columnStream, 1, iErr)
+
+ ! Close stream
+ call MPAS_closeStream(columnStream)
+
+ do k = 1, nVertLevelsInputColumn
+ ecoFieldColumn(k,iField) = columnIC % array(k,1)
+ end do
+
+ end subroutine ocn_init_setup_ecosys_read_column
+
+!***********************************************************************
+
+end module ocn_init_ecosys_column
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_global_ocean.F b/src/core_ocean/mode_init/mpas_ocn_init_global_ocean.F
new file mode 100644
index 0000000000..3088f905b2
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_global_ocean.F
@@ -0,0 +1,2590 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_global_ocean
+!
+!> \brief MPAS ocean initialize case -- Global Ocean
+!> \author Doug Jacobsen
+!> \date 03/04/2014
+!> \details
+!> This module contains the routines for initializing the
+!> the global ocean test case
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_global_ocean
+
+ use mpas_kind_types
+ use mpas_io_units
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+ use mpas_io
+ use mpas_io_streams
+ use mpas_stream_manager
+ use mpas_timekeeping
+ use mpas_dmpar
+
+ use ocn_constants
+ use ocn_equation_of_state
+ use ocn_init_cell_markers
+ use ocn_init_vertical_grids
+ use ocn_init_interpolation
+ use ocn_init_ssh_and_ssp
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_setup_global_ocean, &
+ ocn_init_validate_global_ocean
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ integer :: nDepth
+ integer :: nLatTracer, nLonTracer, nLonSW, nLatSW
+ integer :: nLatWind, nLonWind
+ integer :: nLatTopo, nLonTopo
+ integer :: nLatLandIceThk, nLonLandIceThk
+ type (field1DReal) :: depthIC
+ type (field1DReal) :: windLat, windLon
+ type (field1DReal) :: topoLat, topoLon
+ type (field1DReal) :: landIceThkLat, landIceThkLon
+ type (field1DReal) :: tracerLat, tracerLon
+ type (field1DReal) :: swDataLat, swDataLon
+ type (field2DReal) :: topoIC, zonalWindIC, meridionalWindIC, chlorophyllIC, zenithAngleIC, clearSkyIC
+ type (field2DReal) :: landIceThkIC, landIceDraftIC
+ type (field2DReal) :: oceanFracIC, landIceFracIC, groundedFracIC
+ type (field3DReal) :: temperatureIC, salinityIC
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_setup_global_ocean
+!
+!> \brief Setup for global ocean test case
+!> \author Doug Jacobsen
+!> \date 03/04/2014
+!> \details
+!> This routine sets up the initial conditions for the global ocean test case.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_global_ocean(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ type (block_type), pointer :: block_ptr
+ type (mpas_pool_type), pointer :: meshPool
+ integer, intent(out) :: iErr
+
+ character (len=StrKIND), pointer :: config_init_configuration, config_sw_absorption_type
+ logical, pointer :: config_global_ocean_cull_inland_seas
+ logical, pointer :: config_global_ocean_depress_by_land_ice
+
+ logical, pointer :: on_a_sphere
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_init_configuration', config_init_configuration)
+ call mpas_pool_get_config(domain % configs, 'config_sw_absorption_type', config_sw_absorption_type)
+
+ if (trim(config_init_configuration) /= "global_ocean") return
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool)
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+
+ if ( .not. on_a_sphere ) call mpas_dmpar_global_abort('MPAS-ocean: ERROR: The global ocean configuration can ' &
+ // 'only be applied to a spherical mesh. Exiting...')
+
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_cull_inland_seas', &
+ config_global_ocean_cull_inland_seas)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_depress_by_land_ice', &
+ config_global_ocean_depress_by_land_ice)
+
+ write(stderrUnit,*) 'Reading depth levels.'
+ call ocn_init_setup_global_ocean_read_depth_levels(domain, iErr)
+
+ write(stderrUnit,*) 'Reading topography data.'
+ call ocn_init_setup_global_ocean_read_topo(domain, iErr)
+ write(stderrUnit,*) 'Interpolating topography data.'
+ call ocn_init_setup_global_ocean_create_model_topo(domain, iErr)
+ write(stderrUnit,*) 'Cleaning up topography IC fields'
+ call ocn_init_global_ocean_destroy_topo_fields()
+
+ if (config_global_ocean_depress_by_land_ice) then
+ write(stderrUnit,*) 'Reading land ice topography data.'
+ call ocn_init_setup_global_ocean_read_land_ice_topography(domain, iErr)
+ write(stderrUnit,*) 'Interpolating land ice topography data.'
+ call ocn_init_setup_global_ocean_interpolate_land_ice_topography(domain, iErr)
+ end if
+
+ write(stderrUnit,*) 'Initializing vertical coordinate with ssh = 0.'
+ ! compute the vertical grid (layerThickness, restingThickness, maxLevelCell, zMid)
+ ! based on bottomDepth and refBottomDepth (and refSSH if land ice is present)
+ call ocn_init_ssh_and_ssp_vertical_grid(domain, iErr)
+
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: ocn_init_ssh_and_ssp_vertical_grid failed.'
+ call mpas_dmpar_finalize(domain % dminfo)
+ end if
+
+ if(trim(config_sw_absorption_type) == 'ohlmann00') then
+
+ write(stderrUnit,*) 'Reading penetrating shortwave lat/lon data'
+ call ocn_init_setup_global_ocean_read_swData_lat_lon(domain,iErr)
+ write(stderrUnit,*) 'Interpolating penetrating shortwave data'
+ call ocn_init_setup_global_ocean_interpolate_swData(domain,iErr)
+ write(stderrUnit,*) 'Cleaning penetrating shortwave data'
+ call ocn_init_global_ocean_destroy_swData_fields()
+
+ endif
+
+ write(stderrUnit,*) 'Reading temperature IC.'
+ call ocn_init_setup_global_ocean_read_temperature(domain, iErr)
+ write(stderrUnit,*) 'Reading salinity IC.'
+ call ocn_init_setup_global_ocean_read_salinity(domain, iErr)
+ write(stderrUnit,*) 'Reading Lat/Lon tracer coordinates'
+ call ocn_init_setup_global_ocean_read_tracer_lat_lon(domain, iErr)
+ write(stderrUnit,*) 'Interpolating tracers'
+ call ocn_init_setup_global_ocean_interpolate_tracers(domain, iErr)
+
+ write(stderrUnit,*) 'Reading windstress IC.'
+ call ocn_init_setup_global_ocean_read_windstress(domain, iErr)
+ write(stderrUnit,*) 'Interpolating windstress.'
+ call ocn_init_setup_global_ocean_interpolate_windstress(domain, iErr)
+ write(stderrUnit,*) 'Destroying windstress fields'
+ call ocn_init_global_ocean_destroy_windstress_fields()
+
+ if (config_global_ocean_depress_by_land_ice) then
+ write(stderrUnit,*) 'Recalculating ocean layer topography due to land ice depression'
+ ! compute or update the SSP (or possibly SSH), also computing density and bottomPressure along the way
+ ! If this is the initial guess, the vertical grid and activeTracers may also be recomputed based on SSH
+ call ocn_init_ssh_and_ssp_balance(domain, iErr)
+
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: ocn_init_ssh_and_ssp_balance failed.'
+ call mpas_dmpar_finalize(domain % dminfo)
+ end if
+
+ write(stderrUnit,*) 'Cleaning up land ice topography IC fields'
+ call ocn_init_global_ocean_destroy_land_ice_topography_fields()
+ end if
+
+ write(stderrUnit,*) 'Copying restoring fields'
+ ! this occurs after ocn_init_ssh_and_ssp_balance because activeTracers may have been remapped
+ ! to a new vertical coordinate
+ call ocn_init_setup_global_ocean_interpolate_restoring(domain, iErr)
+ write(stderrUnit,*) 'Cleaning up tracer IC fields'
+ call ocn_init_global_ocean_destroy_tracer_fields()
+
+ write(stderrUnit,*) 'Compute Haney number'
+ call ocn_compute_Haney_number(domain, iErr)
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: ocn_compute_Haney_number failed.'
+ call mpas_dmpar_finalize(domain % dminfo)
+ end if
+
+
+ if (config_global_ocean_cull_inland_seas) then
+ write(stderrUnit,*) 'Removing inland seas.'
+ call ocn_init_setup_global_ocean_cull_inland_seas(domain, iErr)
+ end if
+
+ block_ptr => domain % blocklist
+ do while (associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+
+ call ocn_mark_maxlevelcell(meshPool, iErr)
+ block_ptr => block_ptr % next
+ end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_setup_global_ocean!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_setup_global_ocean_read_topo
+!
+!> \brief Read the topography IC file
+!> \author Doug Jacobsen
+!> \date 03/04/2014
+!> \details
+!> This routine reads the topography IC file, including latitude and longitude
+!> information for topography data.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_global_ocean_read_topo(domain, iErr)!{{{
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+
+ type (MPAS_Stream_type) :: topographyStream
+
+ character (len=StrKIND), pointer :: config_global_ocean_topography_file, &
+ config_global_ocean_topography_lat_varname, &
+ config_global_ocean_topography_nlat_dimname, &
+ config_global_ocean_topography_lon_varname, &
+ config_global_ocean_topography_nlon_dimname, &
+ config_global_ocean_topography_varname, &
+ config_global_ocean_topography_ocean_frac_varname
+
+ logical, pointer :: config_global_ocean_topography_latlon_degrees, config_global_ocean_topography_has_ocean_frac
+
+ integer :: iLat, iLon
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_topography_file', &
+ config_global_ocean_topography_file)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_topography_lat_varname', &
+ config_global_ocean_topography_lat_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_topography_nlat_dimname', &
+ config_global_ocean_topography_nlat_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_topography_lon_varname', &
+ config_global_ocean_topography_lon_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_topography_nlon_dimname', &
+ config_global_ocean_topography_nlon_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_topography_varname', &
+ config_global_ocean_topography_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_topography_latlon_degrees', &
+ config_global_ocean_topography_latlon_degrees)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_topography_ocean_frac_varname', &
+ config_global_ocean_topography_ocean_frac_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_topography_has_ocean_frac', &
+ config_global_ocean_topography_has_ocean_frac)
+
+ ! Define stream for depth levels
+ call MPAS_createStream(topographyStream, domain % iocontext, config_global_ocean_topography_file, MPAS_IO_NETCDF, &
+ MPAS_IO_READ, ierr=iErr)
+
+ ! Setup topoLat, topoLon, and topoIC fields for stream to be read in
+ topoLat % fieldName = trim(config_global_ocean_topography_lat_varname)
+ topoLat % dimSizes(1) = nLatTopo
+ topoLat % dimNames(1) = trim(config_global_ocean_topography_nlat_dimname)
+ topoLat % isVarArray = .false.
+ topoLat % isPersistent = .true.
+ topoLat % isActive = .true.
+ topoLat % hasTimeDimension = .false.
+ topoLat % block => domain % blocklist
+ allocate(topoLat % attLists(1))
+ allocate(topoLat % array(nLatTopo))
+
+ topoLon % fieldName = trim(config_global_ocean_topography_lon_varname)
+ topoLon % dimSizes(1) = nLonTopo
+ topoLon % dimNames(1) = trim(config_global_ocean_topography_nlon_dimname)
+ topoLon % isVarArray = .false.
+ topoLon % isPersistent = .true.
+ topoLon % isActive = .true.
+ topoLon % hasTimeDimension = .false.
+ topoLon % block => domain % blocklist
+ allocate(topoLon % attLists(1))
+ allocate(topoLon % array(nLonTopo))
+
+ topoIC % fieldName = trim(config_global_ocean_topography_varname)
+ topoIC % dimSizes(1) = nLonTopo
+ topoIC % dimSizes(2) = nLatTopo
+ topoIC % dimNames(1) = trim(config_global_ocean_topography_nlon_dimname)
+ topoIC % dimNames(2) = trim(config_global_ocean_topography_nlat_dimname)
+ topoIC % isVarArray = .false.
+ topoIC % isPersistent = .true.
+ topoIC % isActive = .true.
+ topoIC % hasTimeDimension = .false.
+ topoIC % block => domain % blocklist
+ allocate(topoIC % attLists(1))
+ allocate(topoIC % array(nLonTopo, nLatTopo))
+
+ ! Add topoLat, topoLon, and topoIC fields to stream
+ call MPAS_streamAddField(topographyStream, topoLat, iErr)
+ call MPAS_streamAddField(topographyStream, topoLon, iErr)
+ call MPAS_streamAddField(topographyStream, topoIC, iErr)
+
+ if(config_global_ocean_topography_has_ocean_frac) then
+ oceanFracIC % fieldName = trim(config_global_ocean_topography_ocean_frac_varname)
+ oceanFracIC % dimSizes(1) = nLonTopo
+ oceanFracIC % dimSizes(2) = nLatTopo
+ oceanFracIC % dimNames(1) = trim(config_global_ocean_topography_nlon_dimname)
+ oceanFracIC % dimNames(2) = trim(config_global_ocean_topography_nlat_dimname)
+ oceanFracIC % isVarArray = .false.
+ oceanFracIC % isPersistent = .true.
+ oceanFracIC % isActive = .true.
+ oceanFracIC % hasTimeDimension = .false.
+ oceanFracIC % block => domain % blocklist
+ allocate(oceanFracIC % attLists(1))
+ allocate(oceanFracIC % array(nLonTopo, nLatTopo))
+
+ call MPAS_streamAddField(topographyStream, oceanFracIC, iErr)
+ end if
+
+ ! Read stream
+ call MPAS_readStream(topographyStream, 1, iErr)
+
+ ! Close stream
+ call MPAS_closeStream(topographyStream)
+
+ if (config_global_ocean_topography_latlon_degrees) then
+ topoLat % array(:) = topoLat % array(:) * pii / 180.0_RKIND
+ topoLon % array(:) = topoLon % array(:) * pii / 180.0_RKIND
+ end if
+
+ end subroutine ocn_init_setup_global_ocean_read_topo!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_setup_global_ocean_read_land_ice_topography
+!
+!> \brief Read the ice sheet thickness IC file
+!> \author Jeremy Fyke, Xylar Asay-Davis, Mark Petersen (modified from Doug Jacobsen code)
+!> \date 06/15/2015
+!> \details
+!> This routine reads the ice sheet topography IC file, including latitude and longitude
+!> information for ice sheet topography data.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_global_ocean_read_land_ice_topography(domain, iErr)!{{{
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+
+ type (MPAS_Stream_type) :: landIceThicknessStream
+
+ character (len=StrKIND), pointer :: config_global_ocean_land_ice_topo_file, config_global_ocean_land_ice_topo_lat_varname, &
+ config_global_ocean_land_ice_topo_draft_varname, &
+ config_global_ocean_land_ice_topo_ice_frac_varname, &
+ config_global_ocean_land_ice_topo_grounded_frac_varname, &
+ config_global_ocean_land_ice_topo_nlat_dimname, config_global_ocean_land_ice_topo_lon_varname, &
+ config_global_ocean_land_ice_topo_nlon_dimname, config_global_ocean_land_ice_topo_thickness_varname
+
+ logical, pointer :: config_global_ocean_land_ice_topo_latlon_degrees
+
+ integer :: iLat, iLon
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_land_ice_topo_file', &
+ config_global_ocean_land_ice_topo_file)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_land_ice_topo_lat_varname', &
+ config_global_ocean_land_ice_topo_lat_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_land_ice_topo_nlat_dimname', &
+ config_global_ocean_land_ice_topo_nlat_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_land_ice_topo_lon_varname', &
+ config_global_ocean_land_ice_topo_lon_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_land_ice_topo_nlon_dimname', &
+ config_global_ocean_land_ice_topo_nlon_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_land_ice_topo_thickness_varname', &
+ config_global_ocean_land_ice_topo_thickness_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_land_ice_topo_draft_varname', &
+ config_global_ocean_land_ice_topo_draft_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_land_ice_topo_ice_frac_varname', &
+ config_global_ocean_land_ice_topo_ice_frac_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_land_ice_topo_grounded_frac_varname', &
+ config_global_ocean_land_ice_topo_grounded_frac_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_land_ice_topo_latlon_degrees', &
+ config_global_ocean_land_ice_topo_latlon_degrees)
+
+ ! Define stream for depth levels
+ call MPAS_createStream(landIceThicknessStream, domain % iocontext, config_global_ocean_land_ice_topo_file, &
+ MPAS_IO_NETCDF, MPAS_IO_READ, ierr=iErr)
+
+ ! Setup landIceThkLat, landIceThkLon, and landIceThkIC fields for stream to be read in
+ landIceThkLat % fieldName = trim(config_global_ocean_land_ice_topo_lat_varname)
+ landIceThkLat % dimSizes(1) = nLatLandIceThk
+ landIceThkLat % dimNames(1) = trim(config_global_ocean_land_ice_topo_nlat_dimname)
+ landIceThkLat % isVarArray = .false.
+ landIceThkLat % isPersistent = .true.
+ landIceThkLat % isActive = .true.
+ landIceThkLat % hasTimeDimension = .false.
+ landIceThkLat % block => domain % blocklist
+ allocate(landIceThkLat % attLists(1))
+ allocate(landIceThkLat % array(nLatLandIceThk))
+
+ landIceThkLon % fieldName = trim(config_global_ocean_land_ice_topo_lon_varname)
+ landIceThkLon % dimSizes(1) = nLonLandIceThk
+ landIceThkLon % dimNames(1) = trim(config_global_ocean_land_ice_topo_nlon_dimname)
+ landIceThkLon % isVarArray = .false.
+ landIceThkLon % isPersistent = .true.
+ landIceThkLon % isActive = .true.
+ landIceThkLon % hasTimeDimension = .false.
+ landIceThkLon % block => domain % blocklist
+ allocate(landIceThkLon % attLists(1))
+ allocate(landIceThkLon % array(nLonLandIceThk))
+
+ landIceThkIC % fieldName = trim(config_global_ocean_land_ice_topo_thickness_varname)
+ landIceThkIC % dimSizes(1) = nLonLandIceThk
+ landIceThkIC % dimSizes(2) = nLatLandIceThk
+ landIceThkIC % dimNames(1) = trim(config_global_ocean_land_ice_topo_nlon_dimname)
+ landIceThkIC % dimNames(2) = trim(config_global_ocean_land_ice_topo_nlat_dimname)
+ landIceThkIC % isVarArray = .false.
+ landIceThkIC % isPersistent = .true.
+ landIceThkIC % isActive = .true.
+ landIceThkIC % hasTimeDimension = .false.
+ landIceThkIC % block => domain % blocklist
+ allocate(landIceThkIC % attLists(1))
+ allocate(landIceThkIC % array(nLonLandIceThk, nLatLandIceThk))
+
+ landIceDraftIC % fieldName = trim(config_global_ocean_land_ice_topo_draft_varname)
+ landIceDraftIC % dimSizes(1) = nLonLandIceThk
+ landIceDraftIC % dimSizes(2) = nLatLandIceThk
+ landIceDraftIC % dimNames(1) = trim(config_global_ocean_land_ice_topo_nlon_dimname)
+ landIceDraftIC % dimNames(2) = trim(config_global_ocean_land_ice_topo_nlat_dimname)
+ landIceDraftIC % isVarArray = .false.
+ landIceDraftIC % isPersistent = .true.
+ landIceDraftIC % isActive = .true.
+ landIceDraftIC % hasTimeDimension = .false.
+ landIceDraftIC % block => domain % blocklist
+ allocate(landIceDraftIC % attLists(1))
+ allocate(landIceDraftIC % array(nLonLandIceThk, nLatLandIceThk))
+
+ landIceFracIC % fieldName = trim(config_global_ocean_land_ice_topo_ice_frac_varname)
+ landIceFracIC % dimSizes(1) = nLonLandIceThk
+ landIceFracIC % dimSizes(2) = nLatLandIceThk
+ landIceFracIC % dimNames(1) = trim(config_global_ocean_land_ice_topo_nlon_dimname)
+ landIceFracIC % dimNames(2) = trim(config_global_ocean_land_ice_topo_nlat_dimname)
+ landIceFracIC % isVarArray = .false.
+ landIceFracIC % isPersistent = .true.
+ landIceFracIC % isActive = .true.
+ landIceFracIC % hasTimeDimension = .false.
+ landIceFracIC % block => domain % blocklist
+ allocate(landIceFracIC % attLists(1))
+ allocate(landIceFracIC % array(nLonLandIceThk, nLatLandIceThk))
+
+ groundedFracIC % fieldName = trim(config_global_ocean_land_ice_topo_grounded_frac_varname)
+ groundedFracIC % dimSizes(1) = nLonLandIceThk
+ groundedFracIC % dimSizes(2) = nLatLandIceThk
+ groundedFracIC % dimNames(1) = trim(config_global_ocean_land_ice_topo_nlon_dimname)
+ groundedFracIC % dimNames(2) = trim(config_global_ocean_land_ice_topo_nlat_dimname)
+ groundedFracIC % isVarArray = .false.
+ groundedFracIC % isPersistent = .true.
+ groundedFracIC % isActive = .true.
+ groundedFracIC % hasTimeDimension = .false.
+ groundedFracIC % block => domain % blocklist
+ allocate(groundedFracIC % attLists(1))
+ allocate(groundedFracIC % array(nLonLandIceThk, nLatLandIceThk))
+
+ ! Add landIceThkLat, landIceThkLon, and landIceThkIC fields to stream
+ call MPAS_streamAddField(landIceThicknessStream, landIceThkLat, iErr)
+ call MPAS_streamAddField(landIceThicknessStream, landIceThkLon, iErr)
+ call MPAS_streamAddField(landIceThicknessStream, landIceThkIC, iErr)
+ call MPAS_streamAddField(landIceThicknessStream, landIceDraftIC, iErr)
+ call MPAS_streamAddField(landIceThicknessStream, landIceFracIC, iErr)
+ call MPAS_streamAddField(landIceThicknessStream, groundedFracIC, iErr)
+
+ ! Read stream
+ call MPAS_readStream(landIceThicknessStream, 1, iErr)
+
+ ! Close stream
+ call MPAS_closeStream(landIceThicknessStream)
+
+ if (config_global_ocean_land_ice_topo_latlon_degrees) then
+ landIceThkLat % array(:) = landIceThkLat % array(:) * pii / 180.0_RKIND
+ landIceThkLon % array(:) = landIceThkLon % array(:) * pii / 180.0_RKIND
+ end if
+
+ end subroutine ocn_init_setup_global_ocean_read_land_ice_topography!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_setup_global_ocean_create_model_topo
+!
+!> \brief Interpolate the topography IC to MPAS mesh
+!> \author Doug Jacobsen
+!> \date 03/04/2014
+!> \details
+!> This routine interpolates topography data to the MPAS mesh. Currently it
+!> uses a bilinear interpolation
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_global_ocean_create_model_topo(domain, iErr)!{{{
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool, scratchPool, statePool, verticalMeshPool, diagnosticsPool
+
+ real (kind=RKIND) :: alpha, beta, depthLat1, depthLat2, proposedDepth
+
+ real (kind=RKIND), dimension(:), pointer :: latCell, lonCell, bottomDepth, bottomDepthObserved, &
+ refBottomDepth, refLayerThickness, refZMid, oceanFracObserved
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness
+
+ integer, pointer :: nCells, nCellsSolve, nVertLevels
+
+ type (field1DInteger), pointer :: maxLevelCellField, smoothedLevelsField
+ integer, dimension(:), pointer :: maxLevelCell, nEdgesOnCell
+ integer, dimension(:, :), pointer :: cellsOnCell
+
+ integer :: iCell, coc, j, k, maxLevel
+ integer :: minimum_levels
+
+ character (len=StrKIND), pointer :: config_global_ocean_topography_method
+ logical, pointer :: config_global_ocean_smooth_topography, config_global_ocean_topography_has_ocean_frac
+ real (kind=RKIND), pointer :: config_global_ocean_minimum_depth
+
+ logical :: isOcean
+
+ integer, dimension(:), pointer :: scratchMaxLevelCell
+ type (field1DInteger), pointer :: scratchMaxLevelCellField
+
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_topography_method', config_global_ocean_topography_method)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_minimum_depth', config_global_ocean_minimum_depth)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_smooth_topography', config_global_ocean_smooth_topography)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_topography_has_ocean_frac', &
+ config_global_ocean_topography_has_ocean_frac)
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'scratch', scratchPool)
+ call mpas_pool_get_field(scratchPool, 'scratchMaxLevelCell', scratchMaxLevelCellField)
+ call mpas_allocate_scratch_field(scratchMaxLevelCellField, .false.)
+
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+
+ call mpas_pool_get_array(meshPool, 'latCell', latCell)
+ call mpas_pool_get_array(meshPool, 'lonCell', lonCell)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'bottomDepthObserved', bottomDepthObserved)
+ call mpas_pool_get_array(meshPool, 'oceanFracObserved', oceanFracObserved)
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+
+
+ do k = 1, nVertLevels
+ if (refBottomDepth(k).gt.config_global_ocean_minimum_depth) then
+ minimum_levels = k
+ write (stdoutUnit,'(a,f8.2,2a,i5,a,f8.2,a)') 'config_global_ocean_minimum_depth=', &
+ config_global_ocean_minimum_depth,' m. ', 'Setting minimum layer index to ', &
+ minimum_levels, ' with a bottom depth of ', refBottomDepth(k), ' m.'
+ exit
+ end if
+ end do
+
+ ! Record depth of the bottom of the ocean, before any alterations for modeling purposes.
+ if (config_global_ocean_topography_method .eq. "nearest_neighbor") then
+
+ call ocn_init_interpolation_nearest_horiz(topoLon % array, topoLat % array, &
+ topoIC % array, nLonTopo, nLatTopo, &
+ lonCell, latCell, bottomDepthObserved, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+
+ if (config_global_ocean_topography_has_ocean_frac) then
+ call ocn_init_interpolation_nearest_horiz(topoLon % array, topoLat % array, &
+ oceanFracIC % array, nLonTopo, nLatTopo, &
+ lonCell, latCell, oceanFracObserved, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+ end if
+
+ elseif (config_global_ocean_topography_method .eq. "bilinear_interpolation") then
+ call ocn_init_interpolation_bilinear_horiz(topoLon % array, topoLat % array, &
+ topoIC % array, nLonTopo, nLatTopo, &
+ lonCell, latCell, bottomDepthObserved, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+
+ if (config_global_ocean_topography_has_ocean_frac) then
+ call ocn_init_interpolation_bilinear_horiz(topoLon % array, topoLat % array, &
+ oceanFracIC % array, nLonTopo, nLatTopo, &
+ lonCell, latCell, oceanFracObserved, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+ end if
+
+ else
+ write(stderrUnit,*) 'ERROR: Invalid choice of config_global_ocean_topography_method.'
+ iErr = 1
+ call mpas_dmpar_finalize(domain % dminfo)
+ endif
+
+ do iCell = 1, nCells
+ ! Record depth of the bottom of the ocean, before any alterations for modeling purposes.
+ ! Flip the sign to positive down.
+ bottomDepthObserved(iCell) = -bottomDepthObserved(iCell)
+ isOcean = bottomDepthObserved(iCell) > 0.0_RKIND
+ if (config_global_ocean_topography_has_ocean_frac) then
+ ! if there is an ocean-fraction field, mark cells that are < 50% ocean as land
+ isOcean = isOcean .and. (oceanFracObserved(iCell) >= 0.5_RKIND)
+ end if
+ if (isOcean) then
+ ! Enforce minimum depth
+ bottomDepth(iCell) = max(bottomDepthObserved(iCell), refBottomDepth(minimum_levels))
+
+ maxLevelCell(iCell) = -1
+ do k = 1, nVertLevels
+ if (refBottomDepth(k) >= bottomDepth(iCell)) then
+ maxLevelCell(iCell) = k
+ exit
+ end if
+ end do
+
+ if (maxLevelCell(iCell) == -1) then
+ maxLevelCell(iCell) = nVertLevels
+ bottomDepth(iCell) = refBottomDepth( nVertLevels )
+ end if
+
+ else
+ bottomDepth(iCell) = 0.0_RKIND
+ maxLevelCell(iCell) = -1
+ end if
+ end do
+
+
+ ! Smooth depth levels. Enforce different in maxLevelCell to only be a maximum
+ ! of 1 vertical level between two neighboring cells.
+ if (config_global_ocean_smooth_topography) then
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+
+ call mpas_pool_get_field(scratchPool, 'smoothedLevels', smoothedLevelsField)
+
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell)
+ call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell)
+
+ call mpas_allocate_scratch_field(smoothedLevelsField, .true.)
+
+ maxLevelCell(nCells+1) = -1
+ smoothedLevelsField % array = maxLevelCell
+
+ do iCell = 1, nCellsSolve
+ maxLevel = 0
+ do j = 1, nEdgesOnCell(iCell)
+ coc = cellsOnCell(j, iCell)
+ maxLevel = max(maxLevel, maxLevelCell(coc))
+ end do
+
+ if (maxLevel < maxLevelCell(iCell) ) then
+ smoothedLevelsField % array(iCell) = maxLevel + 1
+ bottomDepth(iCell) = refBottomDepth(maxLevel + 1)
+ end if
+ end do
+
+ maxLevelCell(:) = smoothedLevelsField % array(:)
+
+ call mpas_deallocate_scratch_field(smoothedLevelsField, .true.)
+ end if
+
+ block_ptr => block_ptr % next
+ end do
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool)
+ call mpas_pool_get_field(meshPool, 'maxLevelCell', maxLevelCellField)
+ call mpas_dmpar_exch_halo_field(maxLevelCellField)
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+
+ call mpas_pool_get_array(verticalMeshPool, 'refLayerThickness', refLayerThickness)
+ call mpas_pool_get_array(verticalMeshPool, 'refZMid', refZMid)
+ call mpas_pool_get_array(scratchPool, 'scratchMaxLevelCell', scratchMaxLevelCell)
+
+ ! Compute refLayerThickness and refZMid
+ call ocn_compute_layerThickness_zMid_from_bottomDepth(refLayerThickness,refZMid, &
+ refBottomDepth,refBottomDepth(nVertLevels), &
+ nVertLevels,nVertLevels,iErr)
+
+ ! save maxLevelCell from topo to use in reading/smoothing tracers
+ scratchMaxLevelCell(:) = maxLevelCell(:)
+
+ block_ptr => block_ptr % next
+ end do
+
+ end subroutine ocn_init_setup_global_ocean_create_model_topo!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_setup_global_ocean_interpolate_land_ice_topography
+!
+!> \brief Interpolate the topography IC to MPAS mesh
+!> \author Jeremy Fyke, Xylar Asay-Davis, Mark Petersen
+!> \date 06/25/2014
+!> \details
+!> This routine interpolates ice sheet thickness data to the MPAS mesh.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_global_ocean_interpolate_land_ice_topography(domain, iErr)!{{{
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool, forcingPool, landIceInitPool, diagnosticsPool
+
+ real (kind=RKIND), dimension(:), pointer :: latCell, lonCell
+ real (kind=RKIND), dimension(:), pointer :: landIceThkObserved, landIceDraftObserved, &
+ landIceFracObserved, landIceGroundedFracObserved
+
+ real (kind=RKIND), dimension(:), pointer :: seaSurfacePressure, landIceFraction, refSSH, &
+ bottomDepth
+
+ integer, pointer :: nCells
+ integer, dimension(:), pointer :: maxLevelCell, modifySSHMask
+ real (kind=RKIND), pointer :: config_land_ice_flux_rho_ice
+ character (len=StrKIND), pointer :: config_global_ocean_topography_method, config_iterative_init_variable
+
+ integer :: iCell
+
+ real (kind=RKIND), parameter :: groundedThreshold = 0.5_RKIND, &
+ landIceFracThreshold = 0.0_RKIND
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_topography_method', &
+ config_global_ocean_topography_method)
+ call mpas_pool_get_config(domain % configs, 'config_land_ice_flux_rho_ice', config_land_ice_flux_rho_ice)
+ call mpas_pool_get_config(domain % configs, 'config_iterative_init_variable', config_iterative_init_variable)
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'landIceInit', landIceInitPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_array(meshPool, 'latCell', latCell)
+ call mpas_pool_get_array(meshPool, 'lonCell', lonCell)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(landIceInitPool, 'landIceDraftObserved', landIceDraftObserved)
+ call mpas_pool_get_array(landIceInitPool, 'landIceThkObserved', landIceThkObserved)
+ call mpas_pool_get_array(landIceInitPool, 'landIceFracObserved', landIceFracObserved)
+ call mpas_pool_get_array(landIceInitPool, 'landIceGroundedFracObserved', landIceGroundedFracObserved)
+ call mpas_pool_get_array(diagnosticsPool, 'refSSH', refSSH)
+ call mpas_pool_get_array(diagnosticsPool, 'modifySSHMask', modifySSHMask)
+ call mpas_pool_get_array(forcingPool, 'seaSurfacePressure', seaSurfacePressure)
+ call mpas_pool_get_array(forcingPool, 'landIceFraction', landIceFraction)
+
+ if (config_global_ocean_topography_method .eq. "nearest_neighbor") then
+
+ call ocn_init_interpolation_nearest_horiz(landIceThkLon % array, landIceThkLat % array, &
+ landIceThkIC % array, nLonLandIceThk, nLatLandIceThk, &
+ lonCell, latCell, landIceThkObserved, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+
+ call ocn_init_interpolation_nearest_horiz(landIceThkLon % array, landIceThkLat % array, &
+ landIceDraftIC % array, nLonLandIceThk, nLatLandIceThk, &
+ lonCell, latCell, landIceDraftObserved, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+
+ call ocn_init_interpolation_nearest_horiz(landIceThkLon % array, landIceThkLat % array, &
+ landIceFracIC % array, nLonLandIceThk, nLatLandIceThk, &
+ lonCell, latCell, landIceFracObserved, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+
+ call ocn_init_interpolation_nearest_horiz(landIceThkLon % array, landIceThkLat % array, &
+ groundedFracIC % array, nLonLandIceThk, nLatLandIceThk, &
+ lonCell, latCell, landIceGroundedFracObserved, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+
+ elseif (config_global_ocean_topography_method .eq. "bilinear_interpolation") then
+ call ocn_init_interpolation_bilinear_horiz(landIceThkLon % array, landIceThkLat % array, &
+ landIceThkIC % array, nLonLandIceThk, nLatLandIceThk, &
+ lonCell, latCell, landIceThkObserved, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+
+ call ocn_init_interpolation_bilinear_horiz(landIceThkLon % array, landIceThkLat % array, &
+ landIceDraftIC % array, nLonLandIceThk, nLatLandIceThk, &
+ lonCell, latCell, landIceDraftObserved, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+
+ call ocn_init_interpolation_bilinear_horiz(landIceThkLon % array, landIceThkLat % array, &
+ landIceFracIC % array, nLonLandIceThk, nLatLandIceThk, &
+ lonCell, latCell, landIceFracObserved, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+
+ call ocn_init_interpolation_bilinear_horiz(landIceThkLon % array, landIceThkLat % array, &
+ groundedFracIC % array, nLonLandIceThk, nLatLandIceThk, &
+ lonCell, latCell, landIceGroundedFracObserved, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+
+ else
+ write(stderrUnit,*) 'ERROR: Invalid choice of config_global_ocean_topography_method.'
+ iErr = 1
+ call mpas_dmpar_finalize(domain % dminfo)
+ endif
+
+ refSSH(:) = 0.0_RKIND
+ landIceFraction(:) = 0.0_RKIND
+ modifySSHMask(:) = 0
+ do iCell = 1, nCells
+ if(landIceGroundedFracObserved(iCell) >= groundedThreshold) then
+ ! Land ice is grounded. Remove the full column from the ocean.
+ ! Note: land ice data file has grounded_mask variable. This
+ ! could also be used
+ ! as another option to choose cells for removal.
+ maxLevelCell(iCell) = -1
+ ! Set bottom depth to be zero. Culling of inland seas is based
+ ! on bottom depth.
+ bottomDepth(iCell) = 0.0_RKIND
+ cycle
+ end if
+
+ if(landIceFracObserved(iCell) > landIceFracThreshold) then
+ landIceFraction(iCell) = landIceFracObserved(iCell)
+ end if
+
+ ! nothing to do here if the cell is open ocean or land
+ if (landIceFraction(iCell) <= 0.0_RKIND .or. maxLevelCell(iCell) <= 0) cycle
+
+ modifySSHMask(iCell) = 1
+ if(config_iterative_init_variable == 'ssh') then
+ ! we compute the SSP first and find out the SSH
+ seaSurfacePressure(iCell) = config_land_ice_flux_rho_ice &
+ * gravity * landIceThkObserved(iCell)
+ else if(config_iterative_init_variable == 'ssp') then
+ ! we compute the refSSH first and find out the SSP
+ refSSH(iCell) = min(0.0_RKIND,landIceDraftObserved(iCell))
+ else
+ write(stderrUnit,*) 'ERROR: Invalid choice of config_iterative_init_variable.'
+ iErr = 1
+ call mpas_dmpar_finalize(domain % dminfo)
+ end if
+ end do
+
+ block_ptr => block_ptr % next
+ end do
+
+ end subroutine ocn_init_setup_global_ocean_interpolate_land_ice_topography!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_setup_global_ocean_cull_inland_seas
+!
+!> \brief Read the topography IC file
+!> \author Doug Jacobsen
+!> \date 03/04/2014
+!> \details
+!> This routine removes all inland seas. These are defined as isolated ocean cells.
+!> It uses a parallel version of an advancing front algorithm which might not be
+!> optimal for this purpose.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_global_ocean_cull_inland_seas(domain, iErr)!{{{
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: scratchPool, meshPool
+
+ type (field1DInteger), pointer :: cullStackField, touchedCellField, oceanCellField
+
+ real (kind=RKIND), dimension(:), pointer :: latCell, lonCell, bottomDepth
+ integer, dimension(:), pointer :: stack, oceanMask, touchMask
+ integer, pointer :: stackSize
+
+ integer :: iCell
+ integer :: localStackSize, globalStackSize
+ integer :: j, coc
+ integer :: touched
+
+ integer, pointer :: nCells, nCellsSolve, nVertLevels
+ integer, dimension(:), pointer :: maxLevelCell, nEdgesOnCell
+ integer, dimension(:, :), pointer :: cellsOnCell
+
+ iErr = 0
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'scratch', scratchPool)
+
+ call mpas_pool_get_field(scratchPool, 'cullStack', cullStackField)
+ call mpas_pool_get_field(scratchPool, 'touchedCell', touchedCellField)
+ call mpas_pool_get_field(scratchPool, 'oceanCell', oceanCellField)
+
+ call mpas_allocate_scratch_field(cullStackField, .false.)
+ call mpas_allocate_scratch_field(touchedCellField, .false.)
+ call mpas_allocate_scratch_field(oceanCellField, .false.)
+
+ ! Seed all deepest points for advancing front algorithm
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+
+ call mpas_pool_get_array(meshPool, 'latCell', latCell)
+ call mpas_pool_get_array(meshPool, 'lonCell', lonCell)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+
+ call mpas_pool_get_array(scratchPool, 'cullStack', stack)
+ call mpas_pool_get_array(scratchPool, 'oceanCell', oceanMask)
+ call mpas_pool_get_array(scratchPool, 'touchedCell', touchMask)
+ call mpas_pool_get_array(scratchPool, 'cullStackSize', stackSize)
+
+ stack(:) = 0
+ oceanMask(:) = 0
+ touchMask(:) = 0
+ stackSize = 0
+
+ ! Add all cells that have maxLevelCell == nVertLevels to stack
+ do iCell = 1, nCellsSolve
+ if (maxLevelCell(iCell) == nVertLevels) then
+ stackSize = stackSize + 1
+ stack(stackSize) = iCell
+ touchMask(iCell) = 1
+ oceanMask(iCell) = 1
+ end if
+ end do
+
+ block_ptr => block_ptr % next
+ end do
+
+ ! Advancing front algorithm continues until all stacks on all processes are empty.
+ globalStackSize = 1
+ do while(globalStackSize /= 0)
+ ! Advance front on each block with a non-zero stack until stack is empty.
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell)
+ call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+
+ call mpas_pool_get_array(scratchPool, 'cullStack', stack)
+ call mpas_pool_get_array(scratchPool, 'oceanCell', oceanMask)
+ call mpas_pool_get_array(scratchPool, 'touchedCell', touchMask)
+ call mpas_pool_get_array(scratchPool, 'cullStackSize', stackSize)
+
+ touched = 0
+ do while(stackSize > 0)
+ iCell = stack(stackSize)
+ stackSize = stackSize - 1
+ do j = 1, nEdgesOnCell(iCell)
+ coc = cellsOnCell(j, iCell)
+ if (touchMask(coc) == 0 .and. bottomDepth(coc) > 0.0_RKIND) then
+ oceanMask(coc) = 1
+ stackSize = stackSize + 1
+ stack(stackSize) = coc
+ end if
+ touchMask(coc) = 1
+ touched = touched + 1
+ end do
+ end do
+
+ block_ptr => block_ptr % next
+ end do
+
+ ! Perform a halo exchange on oceanMask
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'scratch', scratchPool)
+ call mpas_pool_get_field(scratchPool, 'oceanCell', oceanCellField)
+ call mpas_dmpar_exch_halo_field(oceanCellField)
+
+ ! Check to see if any cells have been masked as ocean in the halo that have not been touched.
+ ! If there are any, add them to the stack. Also, compute globalStackSize
+ localStackSize = 0
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_array(scratchPool, 'cullStack', stack)
+ call mpas_pool_get_array(scratchPool, 'oceanCell', oceanMask)
+ call mpas_pool_get_array(scratchPool, 'touchedCell', touchMask)
+ call mpas_pool_get_array(scratchPool, 'cullStackSize', stackSize)
+
+ do iCell = nCellsSolve, nCells
+ if (oceanMask(iCell) == 1 .and. touchMask(iCell) == 0) then
+ stackSize = stackSize + 1
+ stack(stackSize) = iCell
+ touchMask(iCell) = 1
+ end if
+ end do
+
+ localStackSize = localStackSize + stackSize
+ block_ptr => block_ptr % next
+ end do
+
+ call mpas_dmpar_sum_int(domain % dminfo, localStackSize, globalStackSize)
+ end do
+
+ ! Mark all cells that aren't ocean cells for removal
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+
+ call mpas_pool_get_array(scratchPool, 'oceanCell', oceanMask)
+
+ do iCell = 1, nCellsSolve
+ if (oceanMask(iCell) == 0) then
+ maxLevelCell(iCell) = -1
+ end if
+ end do
+ block_ptr => block_ptr % next
+ end do
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'scratch', scratchPool)
+
+ call mpas_pool_get_field(scratchPool, 'cullStack', cullStackField)
+ call mpas_pool_get_field(scratchPool, 'touchedCell', touchedCellField)
+ call mpas_pool_get_field(scratchPool, 'oceanCell', oceanCellField)
+
+ call mpas_deallocate_scratch_field(cullStackField, .false.)
+ call mpas_deallocate_scratch_field(touchedCellField, .false.)
+ call mpas_deallocate_scratch_field(oceanCellField, .false.)
+
+ !block_ptr => domain % blocklist
+ !do while (associated(block_ptr))
+ ! call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+
+ ! call ocn_mark_maxlevelcell(meshPool, iErr)
+ ! block_ptr => block_ptr % next
+ !end do
+
+ end subroutine ocn_init_setup_global_ocean_cull_inland_seas!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_setup_global_ocean_read_depth_levels
+!
+!> \brief Read depth levels for global ocean test case
+!> \author Doug Jacobsen
+!> \date 03/04/2014
+!> \details
+!> This routine reads the depth levels from the temperature IC file and sets
+!> refBottomDepth accordingly
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_global_ocean_read_depth_levels(domain, iErr)!{{{
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+
+ type (MPAS_Stream_type) :: depthStream
+
+ type (mpas_pool_type), pointer :: meshPool
+
+ character (len=StrKIND), pointer :: config_global_ocean_depth_file, config_global_ocean_depth_varname, &
+ config_global_ocean_depth_dimname
+
+ real (kind=RKIND), pointer :: config_global_ocean_depth_conversion_factor
+
+ integer :: k, iCell
+
+ real (kind=RKIND), dimension(:), pointer :: refBottomDepth
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_depth_file', config_global_ocean_depth_file)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_depth_varname', config_global_ocean_depth_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_depth_dimname', config_global_ocean_depth_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_depth_conversion_factor', &
+ config_global_ocean_depth_conversion_factor)
+
+ ! Define stream for depth levels
+ call MPAS_createStream(depthStream, domain % iocontext, config_global_ocean_depth_file, MPAS_IO_NETCDF, &
+ MPAS_IO_READ, ierr=iErr)
+
+ ! Setup depth field for stream to be read in
+ depthIC % fieldName = trim(config_global_ocean_depth_varname)
+ depthIC % dimSizes(1) = nDepth
+ depthIC % dimNames(1) = trim(config_global_ocean_depth_dimname)
+ depthIC % isVarArray = .false.
+ depthIC % isPersistent = .true.
+ depthIC % isActive = .true.
+ depthIC % hasTimeDimension = .false.
+ depthIC % block => domain % blocklist
+ allocate(depthIC % attLists(1))
+ allocate(depthIC % array(nDepth))
+
+ ! Add depth field to stream
+ call MPAS_streamAddField(depthStream, depthIC, iErr)
+
+ ! Read stream
+ call MPAS_readStream(depthStream, 1, iErr)
+
+ ! Close stream
+ call MPAS_closeStream(depthStream)
+ depthIC % array(:) = depthIC % array(:) * config_global_ocean_depth_conversion_factor
+
+ ! Set refBottomDepth depending on depth levels. And convert appropriately
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ ! depthIC is the mid-depth of each layer. Convert to bottom depth.
+ refBottomDepth(1) = 2.0_RKIND * depthIC % array(1)
+ do k=2,nDepth
+ refBottomDepth(k) = refBottomDepth(k-1) + 2*(depthIC % array(k) - refBottomDepth(k-1))
+ enddo
+
+ block_ptr => block_ptr % next
+ end do
+
+ end subroutine ocn_init_setup_global_ocean_read_depth_levels!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_setup_global_ocean_read_tracer_lat_lon
+!
+!> \brief Read Lat/Lon for tracers in global ocean test case
+!> \author Doug Jacobsen
+!> \date 03/04/2014
+!> \details
+!> This routine reads the latitude and longitude coordinats for tracers from the temperature IC file.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_global_ocean_read_tracer_lat_lon(domain, iErr)!{{{
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+
+ type (MPAS_Stream_type) :: tracerStream
+
+ character (len=StrKIND), pointer :: config_global_ocean_temperature_file, config_global_ocean_tracer_lat_varname, &
+ config_global_ocean_tracer_nlat_dimname, config_global_ocean_tracer_lon_varname, &
+ config_global_ocean_tracer_nlon_dimname
+
+ logical, pointer :: config_global_ocean_tracer_latlon_degrees
+
+ integer :: iLat, iLon
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_temperature_file', config_global_ocean_temperature_file)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_tracer_lat_varname', &
+ config_global_ocean_tracer_lat_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_tracer_nlat_dimname', &
+ config_global_ocean_tracer_nlat_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_tracer_lon_varname', &
+ config_global_ocean_tracer_lon_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_tracer_nlon_dimname', &
+ config_global_ocean_tracer_nlon_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_tracer_latlon_degrees', &
+ config_global_ocean_tracer_latlon_degrees)
+
+ ! Define stream for depth levels
+ call MPAS_createStream(tracerStream, domain % iocontext, config_global_ocean_temperature_file, MPAS_IO_NETCDF, &
+ MPAS_IO_READ, ierr=iErr)
+
+ ! Setup tracerLat and tracerLon fields for stream to be read in
+ tracerLat % fieldName = trim(config_global_ocean_tracer_lat_varname)
+ tracerLat % dimSizes(1) = nLatTracer
+ tracerLat % dimNames(1) = trim(config_global_ocean_tracer_nlat_dimname)
+ tracerLat % isVarArray = .false.
+ tracerLat % isPersistent = .true.
+ tracerLat % isActive = .true.
+ tracerLat % hasTimeDimension = .false.
+ tracerLat % block => domain % blocklist
+ allocate(tracerLat % attLists(1))
+ allocate(tracerLat % array(nLatTracer))
+
+ tracerLon % fieldName = trim(config_global_ocean_tracer_lon_varname)
+ tracerLon % dimSizes(1) = nLonTracer
+ tracerLon % dimNames(1) = trim(config_global_ocean_tracer_nlon_dimname)
+ tracerLon % isVarArray = .false.
+ tracerLon % isPersistent = .true.
+ tracerLon % isActive = .true.
+ tracerLon % hasTimeDimension = .false.
+ tracerLon % block => domain % blocklist
+ allocate(tracerLon % attLists(1))
+ allocate(tracerLon % array(nLonTracer))
+
+ ! Add tracerLat and tracerLon fields to stream
+ call MPAS_streamAddField(tracerStream, tracerLat, iErr)
+ call MPAS_streamAddField(tracerStream, tracerLon, iErr)
+
+ ! Read stream
+ call MPAS_readStream(tracerStream, 1, iErr)
+
+ ! Close stream
+ call MPAS_closeStream(tracerStream)
+
+ if (config_global_ocean_tracer_latlon_degrees) then
+ do iLat = 1, nLatTracer
+ tracerLat % array(iLat) = tracerLat % array(iLat) * pii / 180.0_RKIND
+ end do
+
+ do iLon = 1, nLonTracer
+ tracerLon % array(iLon) = tracerLon % array(iLon) * pii / 180.0_RKIND
+ end do
+ end if
+
+ end subroutine ocn_init_setup_global_ocean_read_tracer_lat_lon!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_setup_global_ocean_read_swData_lat_lon
+!
+!> \brief Read Lat/Lon for swData in global ocean test case
+!> \author Luke Van Roekel
+!> \date 11/16/2015
+!> \details
+!> This routine reads the latitude and longitude coordinats for swData (chlorophyll,
+! clearSkyRadiation, zenithangle) from the swData IC file.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_global_ocean_read_swData_lat_lon(domain, iErr)!{{{
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+
+ type (MPAS_Stream_type) :: SWStream
+
+ character (len=StrKIND), pointer :: config_global_ocean_swData_file, config_global_ocean_swData_lat_varname, &
+ config_global_ocean_swData_nlat_dimname, config_global_ocean_swData_lon_varname, &
+ config_global_ocean_swData_nlon_dimname
+
+ logical, pointer :: config_global_ocean_swData_latlon_degrees
+
+ integer :: iLat, iLon
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_swData_file', config_global_ocean_swData_file)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_swData_lat_varname', &
+ config_global_ocean_swData_lat_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_swData_nlat_dimname', &
+ config_global_ocean_swData_nlat_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_swData_lon_varname', &
+ config_global_ocean_swData_lon_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_swData_nlon_dimname', &
+ config_global_ocean_swData_nlon_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_swData_latlon_degrees', &
+ config_global_ocean_swData_latlon_degrees)
+
+ ! Define stream for depth levels
+ call MPAS_createStream(SWStream, domain % iocontext, config_global_ocean_swData_file, MPAS_IO_NETCDF, &
+ MPAS_IO_READ, ierr=iErr)
+
+ ! Setup tracerLat and tracerLon fields for stream to be read in
+ swDataLat % fieldName = trim(config_global_ocean_swData_lat_varname)
+ swDataLat % dimSizes(1) = nLatSW
+ swDataLat % dimNames(1) = trim(config_global_ocean_swData_nlat_dimname)
+ swDataLat % isVarArray = .false.
+ swDataLat % isPersistent = .true.
+ swDataLat % isActive = .true.
+ swDataLat % hasTimeDimension = .false.
+ swDataLat % block => domain % blocklist
+ allocate(swDataLat % attLists(1))
+ allocate(swDataLat % array(nLatSW))
+
+ swDataLon % fieldName = trim(config_global_ocean_swData_lon_varname)
+ swDataLon % dimSizes(1) = nLonSW
+ swDataLon % dimNames(1) = trim(config_global_ocean_swData_nlon_dimname)
+ swDataLon % isVarArray = .false.
+ swDataLon % isPersistent = .true.
+ swDataLon % isActive = .true.
+ swDataLon % hasTimeDimension = .false.
+ swDataLon % block => domain % blocklist
+ allocate(swDataLon % attLists(1))
+ allocate(swDataLon % array(nLonSW))
+
+ ! Add tracerLat and tracerLon fields to stream
+ call MPAS_streamAddField(SWStream, swDataLat, iErr)
+ call MPAS_streamAddField(SWStream, swDataLon, iErr)
+
+ ! Read stream
+ call MPAS_readStream(SWStream, 1, iErr)
+
+ ! Close stream
+ call MPAS_closeStream(SWStream)
+
+ if (config_global_ocean_swData_latlon_degrees) then
+ do iLat = 1, nLatSW
+ swDataLat % array(iLat) = swDataLat % array(iLat) * pii / 180.0_RKIND
+ end do
+
+ do iLon = 1, nLonSW
+ swDataLon % array(iLon) = swDataLon % array(iLon) * pii / 180.0_RKIND
+ end do
+ end if
+
+ end subroutine ocn_init_setup_global_ocean_read_swData_lat_lon!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_setup_global_ocean_read_temperature
+!
+!> \brief Read temperature ICs for global ocean test case
+!> \author Doug Jacobsen
+!> \date 03/04/2014
+!> \details
+!> This routine reads the temperature field from the temperature IC file.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_global_ocean_read_temperature(domain, iErr)!{{{
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+
+ type (MPAS_Stream_type) :: temperatureStream
+
+ character (len=StrKIND), pointer :: config_global_ocean_temperature_file, config_global_ocean_temperature_varname, &
+ config_global_ocean_tracer_nlon_dimname, config_global_ocean_tracer_nlat_dimname, &
+ config_global_ocean_depth_dimname
+
+ integer :: k
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_temperature_file', config_global_ocean_temperature_file)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_temperature_varname', &
+ config_global_ocean_temperature_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_tracer_nlon_dimname', &
+ config_global_ocean_tracer_nlon_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_tracer_nlat_dimname', &
+ config_global_ocean_tracer_nlat_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_depth_dimname', config_global_ocean_depth_dimname)
+
+ ! Define stream for temperature IC
+ call MPAS_createStream(temperatureStream, domain % iocontext, config_global_ocean_temperature_file, MPAS_IO_NETCDF, &
+ MPAS_IO_READ, ierr=iErr)
+
+ ! Setup temperature field for stream to be read in
+ temperatureIC % fieldName = trim(config_global_ocean_temperature_varname)
+ temperatureIC % dimSizes(1) = nLonTracer
+ temperatureIC % dimSizes(2) = nLatTracer
+ temperatureIC % dimSizes(3) = nDepth
+ temperatureIC % dimNames(1) = trim(config_global_ocean_tracer_nlon_dimname)
+ temperatureIC % dimNames(2) = trim(config_global_ocean_tracer_nlat_dimname)
+ temperatureIC % dimNames(3) = trim(config_global_ocean_depth_dimname)
+ temperatureIC % isVarArray = .false.
+ temperatureIC % isPersistent = .true.
+ temperatureIC % isActive = .true.
+ temperatureIC % hasTimeDimension = .false.
+ temperatureIC % block => domain % blocklist
+ allocate(temperatureIC % attLists(1))
+ allocate(temperatureIC % array(nLonTracer, nLatTracer, nDepth))
+
+ ! Add temperature field to stream
+ call MPAS_streamAddField(temperatureStream, temperatureIC, iErr)
+
+ ! Read stream
+ call MPAS_readStream(temperatureStream, 1, iErr)
+
+ ! Close stream
+ call MPAS_closeStream(temperatureStream)
+
+ end subroutine ocn_init_setup_global_ocean_read_temperature!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_setup_global_ocean_read_salinity
+!
+!> \brief Read salinity ICs for global ocean test case
+!> \author Doug Jacobsen
+!> \date 03/04/2014
+!> \details
+!> This routine reads the salinity field from the salinity IC file.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_global_ocean_read_salinity(domain, iErr)!{{{
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+
+ type (MPAS_Stream_type) :: salinityStream
+
+ character (len=StrKIND), pointer :: config_global_ocean_salinity_file, config_global_ocean_salinity_varname, &
+ config_global_ocean_tracer_nlon_dimname, config_global_ocean_tracer_nlat_dimname, &
+ config_global_ocean_depth_dimname
+
+ integer :: k
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_salinity_file', config_global_ocean_salinity_file)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_salinity_varname', config_global_ocean_salinity_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_tracer_nlon_dimname', &
+ config_global_ocean_tracer_nlon_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_tracer_nlat_dimname', &
+ config_global_ocean_tracer_nlat_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_depth_dimname', config_global_ocean_depth_dimname)
+
+ ! Define stream for salinity IC
+ call MPAS_createStream(salinityStream, domain % iocontext, config_global_ocean_salinity_file, MPAS_IO_NETCDF, &
+ MPAS_IO_READ, ierr=iErr)
+
+ ! Setup salinity field for stream to be read in
+ salinityIC % fieldName = trim(config_global_ocean_salinity_varname)
+ salinityIC % dimSizes(1) = nLonTracer
+ salinityIC % dimSizes(2) = nLatTracer
+ salinityIC % dimSizes(3) = nDepth
+ salinityIC % dimNames(1) = trim(config_global_ocean_tracer_nlon_dimname)
+ salinityIC % dimNames(2) = trim(config_global_ocean_tracer_nlat_dimname)
+ salinityIC % dimNames(3) = trim(config_global_ocean_depth_dimname)
+ salinityIC % isVarArray = .false.
+ salinityIC % isPersistent = .true.
+ salinityIC % isActive = .true.
+ salinityIC % hasTimeDimension = .false.
+ salinityIC % block => domain % blocklist
+ allocate(salinityIC % attLists(1))
+ allocate(salinityIC % array(nLonTracer, nLatTracer, nDepth))
+
+ ! Add salinity field to stream
+ call MPAS_streamAddField(salinityStream, salinityIC, iErr)
+
+ ! Read stream
+ call MPAS_readStream(salinityStream, 1, iErr)
+
+ ! Close stream
+ call MPAS_closeStream(salinityStream)
+
+ end subroutine ocn_init_setup_global_ocean_read_salinity!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_setup_global_ocean_interoplate_tracers
+!
+!> \brief Interpolate tracer quantities to MPAS grid
+!> \author Doug Jacobsen, Xylar Asay-Davis
+!> \date 03/05/2014
+!> \details
+!> This routine interpolates the temperature/salinity data read in from the
+!> initial condition file to the MPAS grid.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_global_ocean_interpolate_tracers(domain, iErr)!{{{
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+ type (mpas_pool_type), pointer :: meshPool, statePool, scratchPool, tracersPool, forcingPool, &
+ diagnosticsPool, verticalMeshPool
+
+ real (kind=RKIND) :: counter
+ real (kind=RKIND) :: x, x1, x2, y, y1, y2, coef, coef11, coef12, coef21, coef22
+ real (kind=RKIND) :: zMidPBC
+ integer :: iLat, iLon, iSmooth, j, coc
+ integer :: iCell, k, km1
+ integer :: xInd1, xInd2, yInd1, yInd2
+ integer, pointer :: idxSalinity, idxTemperature, nCells, nVertLevels, nCellsSolve, idxTracer1
+
+ type (field2DReal), pointer :: smoothedTemperatureField, smoothedSalinityField, interpTracerField
+ type (field3DReal), pointer :: activeTracersField
+
+ integer, dimension(:), pointer :: maxLevelCell, nEdgesOnCell
+ integer, dimension(:, :), pointer :: cellsOnCell
+
+ real (kind=RKIND), dimension(:), pointer :: latCell, lonCell
+ real (kind=RKIND), dimension(:, :), pointer :: smoothedTemperature, smoothedSalinity
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers, debugTracers
+
+ character (len=StrKIND), pointer :: config_global_ocean_tracer_method
+ integer, pointer :: config_global_ocean_smooth_TS_iterations
+
+ real (kind=RKIND), dimension(:), pointer :: refZMid, inTracerColumn, outTracerColumn
+ real (kind=RKIND), dimension(:,:), pointer :: zMid
+ type (mpas_pool_iterator_type) :: groupItr
+ real (kind=RKIND), dimension(:,:,:), pointer :: tracersGroup
+ integer :: inKMax, outKMax, iTracer, nTracers
+
+ integer, dimension(:), pointer :: scratchMaxLevelCell
+ type (field1DInteger), pointer :: scratchMaxLevelCellField
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_tracer_method', &
+ config_global_ocean_tracer_method)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_smooth_TS_iterations', &
+ config_global_ocean_smooth_TS_iterations)
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', idxTemperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', idxSalinity)
+ call mpas_pool_get_dimension(tracersPool, 'index_tracer1', idxTracer1)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+
+ call mpas_pool_get_array(meshPool, 'latCell', latCell)
+ call mpas_pool_get_array(meshPool, 'lonCell', lonCell)
+
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+ call mpas_pool_get_array(tracersPool, 'debugTracers', debugTracers, 1)
+
+
+
+ if(associated(debugTracers)) then
+ debugTracers(idxTracer1,:,:) = 1.0_RKIND
+ end if
+
+ if ( associated(activeTracers) ) then
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+ call mpas_pool_get_field(scratchPool, 'interpTracer', interpTracerField)
+ call mpas_allocate_scratch_field(interpTracerField, .true.)
+ if (config_global_ocean_tracer_method .eq. "nearest_neighbor") then
+ call ocn_init_interpolation_nearest_horiz(tracerLon % array, tracerLat % array, &
+ temperatureIC % array, nLonTracer, nLatTracer, &
+ lonCell, latCell, interpTracerField % array, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+ activeTracers(idxTemperature,:,:) = interpTracerField % array(:,:)
+
+ call ocn_init_interpolation_nearest_horiz(tracerLon % array, tracerLat % array, &
+ salinityIC % array, nLonTracer, nLatTracer, &
+ lonCell, latCell, interpTracerField % array, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+ activeTracers(idxSalinity,:,:) = interpTracerField % array(:,:)
+
+ elseif (config_global_ocean_tracer_method .eq. "bilinear_interpolation") then
+ call ocn_init_interpolation_bilinear_horiz(tracerLon % array, tracerLat % array, &
+ temperatureIC % array, nLonTracer, nLatTracer, &
+ lonCell, latCell, interpTracerField % array, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+ activeTracers(idxTemperature,:,:) = interpTracerField % array(:,:)
+
+ call ocn_init_interpolation_bilinear_horiz(tracerLon % array, tracerLat % array, &
+ salinityIC % array, nLonTracer, nLatTracer, &
+ lonCell, latCell, interpTracerField % array, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+ activeTracers(idxSalinity,:,:) = interpTracerField % array(:,:)
+
+ else
+ write(stderrUnit,*) 'ERROR: Invalid choice of config_global_ocean_tracer_method.'
+ iErr = 1
+ call mpas_dmpar_finalize(domain % dminfo)
+ endif
+ call mpas_deallocate_scratch_field(interpTracerField, .true.)
+ end if
+
+ block_ptr => block_ptr % next
+ end do
+
+ ! Smooth temperature and salinity.
+ if (config_global_ocean_smooth_TS_iterations .gt. 0) then
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'scratch', scratchPool)
+
+ call mpas_pool_get_field(scratchPool, 'smoothedTemperature', smoothedTemperatureField)
+ call mpas_pool_get_field(scratchPool, 'smoothedSalinity', smoothedSalinityField)
+
+ call mpas_allocate_scratch_field(smoothedTemperatureField, .false.)
+ call mpas_allocate_scratch_field(smoothedSalinityField, .false.)
+
+ do iSmooth = 1,config_global_ocean_smooth_TS_iterations
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', idxTemperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', idxSalinity)
+
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell)
+ call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell)
+
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+
+ call mpas_pool_get_array(scratchPool, 'smoothedTemperature', smoothedTemperature)
+ call mpas_pool_get_array(scratchPool, 'smoothedSalinity', smoothedSalinity)
+ call mpas_pool_get_array(scratchPool, 'scratchMaxLevelCell', scratchMaxLevelCell)
+
+ maxLevelCell(nCells+1) = -1
+
+ do iCell = 1, nCells
+ if(maxLevelCell(iCell) <= 0) cycle
+ if(scratchMaxLevelCell(iCell) <= 0) cycle
+
+ do k = 1, scratchMaxLevelCell(iCell)
+ if ( associated(activeTracers) ) then
+ smoothedTemperature(k, iCell) = activeTracers(idxTemperature, k, iCell)
+ smoothedSalinity(k, iCell) = activeTracers(idxSalinity, k, iCell)
+ end if
+ counter = 1
+
+ do j = 1, nEdgesOnCell(iCell)
+ coc = cellsOnCell(j, iCell)
+ ! check if coc not 0 (or nCells+1)?
+ if (k > scratchMaxLevelCell(coc)) cycle
+
+ if (.not. associated(activeTracers) ) cycle
+
+ smoothedTemperature(k, iCell) = smoothedTemperature(k, iCell) &
+ + activeTracers (idxTemperature, k, coc)
+ smoothedSalinity(k, iCell) = smoothedSalinity(k, iCell) + activeTracers(idxSalinity, k, coc)
+ counter = counter + 1
+
+ end do ! edgesOnCell
+
+ smoothedTemperature(k, iCell) = smoothedTemperature(k, iCell) / counter
+ smoothedSalinity(k, iCell) = smoothedSalinity(k, iCell) / counter
+
+ end do ! k level
+
+ end do ! iCell
+
+ if ( associated(activeTracers) ) then
+ activeTracers(idxTemperature, :, :) = smoothedTemperature(:,:)
+ activeTracers(idxSalinity, :, :) = smoothedSalinity(:,:)
+ end if
+
+ block_ptr => block_ptr % next
+ end do
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_field(tracersPool, 'activeTracers', activeTracersField,1)
+
+ if ( activeTracersField % isActive ) then
+ call mpas_dmpar_exch_halo_field(activeTracersField)
+ end if
+
+ end do ! iSmooth
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'scratch', scratchPool)
+ call mpas_pool_get_field(scratchPool, 'smoothedTemperature', smoothedTemperatureField)
+ call mpas_pool_get_field(scratchPool, 'smoothedSalinity', smoothedSalinityField)
+ call mpas_deallocate_scratch_field(smoothedTemperatureField, .false.)
+ call mpas_deallocate_scratch_field(smoothedSalinityField, .false.)
+ endif
+
+ ! reinterpolate tracers from refZMid to zMid for PBCs or other modified vertical coordinates
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
+ call mpas_pool_get_array(verticalMeshPool, 'refZMid', refZMid)
+ call mpas_pool_get_array(scratchPool, 'scratchMaxLevelCell', scratchMaxLevelCell)
+
+ allocate(inTracerColumn(nVertLevels),outTracerColumn(nVertLevels))
+
+ call mpas_pool_begin_iteration(tracersPool)
+ do while ( mpas_pool_get_next_member(tracersPool, groupItr) )
+ if ( groupItr % memberType .ne. MPAS_POOL_FIELD ) cycle
+
+ call mpas_pool_get_array(tracersPool, groupItr % memberName, tracersGroup, 1)
+
+ if ( .not. associated(tracersGroup) ) cycle
+
+ nTracers = size(tracersGroup, dim=1)
+ do iCell = 1, nCells
+ outKMax = maxLevelCell(iCell)
+ if(outKMax < 1) cycle ! nothing to interpolate
+
+ inKMax = scratchMaxLevelCell(iCell)
+
+ do iTracer = 1, nTracers
+ inTracerColumn(:) = tracersGroup(iTracer,:,iCell)
+ outTracerColumn(:) = 9.969209968386869e+36_RKIND
+ call ocn_init_interpolation_linear_vert(refZMid(1:inKMax), &
+ inTracerColumn(1:inKMax), &
+ inKMax, &
+ zMid(1:outKMax,iCell), &
+ outTracerColumn(1:outKMax), &
+ outKMax, &
+ extrapolate=.false.)
+ tracersGroup(iTracer,:,iCell) = outTracerColumn(:)
+ end do
+ end do
+ end do
+
+ deallocate(inTracerColumn,outTracerColumn)
+
+ block_ptr => block_ptr % next
+ end do
+
+ call mpas_pool_get_field(scratchPool, 'scratchMaxLevelCell', scratchMaxLevelCellField)
+ call mpas_deallocate_scratch_field(scratchMaxLevelCellField, .false.)
+
+ end subroutine ocn_init_setup_global_ocean_interpolate_tracers!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_setup_global_ocean_interoplate_restoring
+!
+!> \brief Copy tracer quantities for restoring
+!> \author Doug Jacobsen, Xylar Asay-Davis
+!> \date 03/05/2014
+!> \details
+!> This routine copies temperature/salinity into surface and interior restoring fields.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_global_ocean_interpolate_restoring(domain, iErr)!{{{
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+ type (mpas_pool_type), pointer :: meshPool, statePool, tracersPool, forcingPool
+ type (mpas_pool_type), pointer :: tracersSurfaceRestoringFieldsPool, tracersInteriorRestoringFieldsPool
+
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
+ real (kind=RKIND), dimension(:, :), pointer :: activeTracersPistonVelocity, activeTracersSurfaceRestoringValue
+ real (kind=RKIND), dimension(:, :, :), pointer :: activeTracersInteriorRestoringValue, activeTracersInteriorRestoringRate
+
+ character (len=StrKIND), pointer :: config_global_ocean_tracer_method
+ integer, pointer :: config_global_ocean_smooth_TS_iterations
+ real (kind=RKIND), pointer :: config_global_ocean_piston_velocity
+ real (kind=RKIND), pointer :: config_global_ocean_interior_restore_rate
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_piston_velocity', config_global_ocean_piston_velocity)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_interior_restore_rate', &
+ config_global_ocean_interior_restore_rate)
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool)
+
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+
+ call mpas_pool_get_subpool(forcingPool, 'tracersSurfaceRestoringFields', tracersSurfaceRestoringFieldsPool)
+ call mpas_pool_get_subpool(forcingPool, 'tracersInteriorRestoringFields', tracersInteriorRestoringFieldsPool)
+ call mpas_pool_get_array(tracersSurfaceRestoringFieldsPool, 'activeTracersSurfaceRestoringValue', &
+ activeTracersSurfaceRestoringValue, 1)
+ call mpas_pool_get_array(tracersSurfaceRestoringFieldsPool, 'activeTracersPistonVelocity', &
+ activeTracersPistonVelocity, 1)
+ call mpas_pool_get_array(tracersInteriorRestoringFieldsPool, 'activeTracersInteriorRestoringValue', &
+ activeTracersInteriorRestoringValue, 1)
+ call mpas_pool_get_array(tracersInteriorRestoringFieldsPool, 'activeTracersInteriorRestoringRate', &
+ activeTracersInteriorRestoringRate, 1)
+
+ ! set interior restoring values and rate
+ if ( associated(activeTracersInteriorRestoringValue) .and. associated(activeTracers) ) then
+ activeTracersInteriorRestoringValue(:, :, :) = activeTracers(:, :, :)
+ end if
+
+ if ( associated(activeTracersInteriorRestoringRate) ) then
+ activeTracersInteriorRestoringRate(:, :, :) = config_global_ocean_interior_restore_rate
+ end if
+
+ ! set surface restoring values and rate
+ if ( associated(activeTracersSurfaceRestoringValue) .and. associated(activeTracers) ) then
+ activeTracersSurfaceRestoringValue(:, :) = activeTracers(:, 1, :)
+ end if
+
+ if ( associated(activeTracersPistonVelocity) ) then
+ activeTracersPistonVelocity(:, :) = config_global_ocean_piston_velocity
+ end if
+
+ block_ptr => block_ptr % next
+ end do
+
+
+ end subroutine ocn_init_setup_global_ocean_interpolate_restoring!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_setup_global_ocean_interoplate_swData
+!
+!> \brief Interpolate penetrating shortwave radiation quantities to MPAS grid
+!> \author Luke Van Roekel, Xylar Asay-Davis
+!> \date 11/11/2015
+!> \details
+!> This routine interpolates the penetrating swData data read in from the
+!> initial condition file to the MPAS grid. Currently it uses a nearest neighbor interpolation.
+!
+!-----------------------------------------------------------------------
+
+subroutine ocn_init_setup_global_ocean_interpolate_swData(domain, iErr)!{{{
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+ type (MPAS_Stream_type) :: zenithStream, chlorophyllStream, clearSkyStream
+ type (mpas_pool_type), pointer :: meshPool, statePool, scratchPool, shortwavePool, diagnosticsPool
+
+ type(MPAS_TimeInterval_type) :: timeStep ! time step interval
+ type(MPAS_Time_Type) :: currentTime
+ character(len=STRKIND) :: currentTimeStamp
+
+ real (kind=RKIND) :: counter
+ real (kind=RKIND) :: dt
+ real (kind=RKIND) :: x, x1, x2, y, y1, y2, coef, coef11, coef12, coef21, coef22
+
+ integer :: iLat, iLon, j, coc
+ integer :: iCell, monIndex
+ integer :: xInd1, xInd2, yInd1, yInd2
+ integer, pointer :: nCells, nCellsSolve, maxLevelCell
+
+ integer, dimension(12), parameter :: daysInMonth = (/31,28,31,30,31,30,31,31,30,31,30,31/)
+ integer, dimension(:), pointer :: nEdgesOnCell
+ integer, dimension(:, :), pointer :: cellsOnCell
+
+ real (kind=RKIND), dimension(:), pointer :: chlorophyllData, zenithAngle, clearSkyRadiation
+ real (kind=RKIND), dimension(:), pointer :: latCell, lonCell
+
+ character (len=StrKIND), pointer :: config_global_ocean_swData_method, xtime
+ character (len=StrKIND), pointer :: config_global_ocean_swData_file, config_global_ocean_zenithAngle_varname, &
+ config_global_ocean_swData_nlon_dimname, config_global_ocean_swData_nlat_dimname, &
+ config_global_ocean_chlorophyll_varname, config_global_ocean_clearSky_varname
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_swData_method', config_global_ocean_swData_method)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_swData_file', config_global_ocean_swData_file)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_zenithAngle_varname', config_global_ocean_zenithAngle_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_chlorophyll_varname', config_global_ocean_chlorophyll_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_clearSky_varname', config_global_ocean_clearSky_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_swData_nlon_dimname', config_global_ocean_swData_nlon_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_swData_nlat_dimname', config_global_ocean_swData_nlat_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_swData_method', config_global_ocean_swData_method)
+ ! Define stream for zenithAngle IC
+ call MPAS_createStream(zenithStream, domain % iocontext, config_global_ocean_swData_file, MPAS_IO_NETCDF, MPAS_IO_READ, &
+ ierr=iErr)
+ call MPAS_createStream(chlorophyllStream, domain % iocontext, config_global_ocean_swData_file, MPAS_IO_NETCDF, MPAS_IO_READ, &
+ ierr=iErr)
+ call MPAS_createStream(clearSkyStream, domain % iocontext, config_global_ocean_swData_file, MPAS_IO_NETCDF, MPAS_IO_READ, &
+ ierr=iErr)
+
+
+ ! Setup zenithAngle field for stream to be read in
+
+ zenithAngleIC % fieldName = trim(config_global_ocean_zenithAngle_varname)
+ zenithAngleIC % dimSizes(1) = nLonSW
+ zenithAngleIC % dimSizes(2) = nLatSW
+ zenithAngleIC % dimNames(1) = trim(config_global_ocean_swData_nlon_dimname)
+ zenithAngleIC % dimNames(2) = trim(config_global_ocean_swData_nlat_dimname)
+
+ zenithAngleIC % isVarArray = .false.
+ zenithAngleIC % isPersistent = .true.
+ zenithAngleIC % isActive = .true.
+ zenithAngleIC % hasTimeDimension = .false.
+ zenithAngleIC % block => domain % blocklist
+ allocate(zenithAngleIC % attLists(1))
+ allocate(zenithAngleIC % array(nLonSW, nLatSW))
+
+ ! Setup zenithAngle field for stream to be read in
+ chlorophyllIC % fieldName = trim(config_global_ocean_chlorophyll_varname)
+ chlorophyllIC % dimSizes(1) = nLonSW
+ chlorophyllIC % dimSizes(2) = nLatSW
+ chlorophyllIC % dimNames(1) = trim(config_global_ocean_swData_nlon_dimname)
+ chlorophyllIC % dimNames(2) = trim(config_global_ocean_swData_nlat_dimname)
+ chlorophyllIC % isVarArray = .false.
+ chlorophyllIC % isPersistent = .true.
+ chlorophyllIC % isActive = .true.
+ chlorophyllIC % hasTimeDimension = .false.
+ chlorophyllIC % block => domain % blocklist
+ allocate(chlorophyllIC % attLists(1))
+ allocate(chlorophyllIC % array(nLonSW, nLatSW))
+
+ ! Setup zenithAngle field for stream to be read in
+ clearSKYIC % fieldName = trim(config_global_ocean_clearSky_varname)
+ clearSKYIC % dimSizes(1) = nLonSW
+ clearSKYIC % dimSizes(2) = nLatSW
+ clearSKYIC % dimNames(1) = trim(config_global_ocean_swData_nlon_dimname)
+ clearSKYIC % dimNames(2) = trim(config_global_ocean_swData_nlat_dimname)
+ clearSKYIC % isVarArray = .false.
+ clearSKYIC % isPersistent = .true.
+ clearSKYIC % isActive = .true.
+ clearSKYIC % hasTimeDimension = .false.
+ clearSKYIC % block => domain % blocklist
+ allocate(clearSKYIC % attLists(1))
+ allocate(clearSKYIC % array(nLonSW, nLatSW))
+ ! Add chlorophyll field to stream
+
+ call MPAS_streamAddField(zenithStream, zenithAngleIC, iErr)
+ call MPAS_streamAddField(chlorophyllStream, chlorophyllIC, iErr)
+ call MPAS_streamAddField(clearSkyStream, clearSKYIC, iErr)
+
+ do monIndex=1,12
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'shortwave', shortwavePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+
+ call mpas_pool_get_array(diagnosticsPool, 'xtime', xtime)
+ call mpas_pool_get_array(meshPool, 'latCell', latCell)
+ call mpas_pool_get_array(meshPool, 'lonCell', lonCell)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+
+ call mpas_pool_get_array(shortwavePool, 'chlorophyllData', chlorophyllData)
+ call mpas_pool_get_array(shortWavePool, 'zenithAngle', zenithAngle)
+ call mpas_pool_get_array(shortWavePool, 'clearSkyRadiation', clearSkyRadiation)
+
+ ! Read stream
+
+ call MPAS_readStream(zenithStream, monIndex, iErr)
+ call MPAS_readStream(chlorophyllStream, monIndex, iErr)
+ call MPAS_readStream(clearSkyStream, monIndex, iErr)
+
+
+ if (config_global_ocean_swData_method .eq. "nearest_neighbor") then
+ call ocn_init_interpolation_nearest_horiz(swDataLon % array, swDataLat % array, &
+ chlorophyllIC % array, nLonSW, nLatSW, &
+ lonCell, latCell, chlorophyllData, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+
+ call ocn_init_interpolation_nearest_horiz(swDataLon % array, swDataLat % array, &
+ zenithAngleIC % array, nLonSW, nLatSW, &
+ lonCell, latCell, zenithAngle, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+
+ call ocn_init_interpolation_nearest_horiz(swDataLon % array, swDataLat % array, &
+ clearSKYIC % array, nLonSW, nLatSW, &
+ lonCell, latCell, clearSkyRadiation, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+
+ elseif (config_global_ocean_swData_method .eq. "bilinear_interpolation") then
+ call ocn_init_interpolation_bilinear_horiz(swDataLon % array, swDataLat % array, &
+ chlorophyllIC % array, nLonSW, nLatSW, &
+ lonCell, latCell, chlorophyllData, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+
+ call ocn_init_interpolation_bilinear_horiz(swDataLon % array, swDataLat % array, &
+ zenithAngleIC % array, nLonSW, nLatSW, &
+ lonCell, latCell, zenithAngle, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+
+ call ocn_init_interpolation_bilinear_horiz(swDataLon % array, swDataLat % array, &
+ clearSKYIC % array, nLonSW, nLatSW, &
+ lonCell, latCell, clearSkyRadiation, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+ else
+ write(stderrUnit,*) 'ERROR: Invalid choice of config_global_ocean_swData_method.'
+ iErr = 1
+ call mpas_dmpar_finalize(domain % dminfo)
+ endif
+
+ block_ptr => block_ptr % next
+ end do !loop on blocks
+
+ ! increment clock with month string
+
+ currentTime = mpas_get_clock_time(domain % clock, MPAS_NOW, iErr)
+ call mpas_get_time(currentTime, dateTimeString=currentTimeStamp)
+
+ xtime=currentTimeStamp
+ call mpas_stream_mgr_write(domain % streamManager, streamID='shortwave_forcing_data_init', &
+ forceWriteNow=.true., ierr=ierr)
+ call mpas_set_timeInterval(timeStep, dt=real(daysInMonth(monIndex),RKIND)*86400.0_RKIND)
+ call mpas_advance_clock(domain % clock, timeStep)
+
+ enddo !ends loop over months
+
+
+ ! Close stream
+ call MPAS_closeStream(zenithStream)
+ call MPAS_closeStream(chlorophyllStream)
+ call MPAS_closeStream(clearSkyStream)
+
+! reset mpas clock for other streams and final write
+
+ currentTime = mpas_get_clock_time(domain % clock, MPAS_START_TIME, iErr)
+ call mpas_set_clock_time(domain%clock, currentTime , MPAS_NOW,iErr)
+ currentTime = mpas_get_clock_time(domain % clock, MPAS_NOW, iErr)
+ call mpas_get_time(currentTime, dateTimeString=currentTimeStamp)
+
+ xtime=currentTimeStamp
+ call mpas_stream_mgr_reset_alarms(domain%streamManager, streamID='shortwave_forcing_data_init', &
+ direction=MPAS_STREAM_OUTPUT, ierr=ierr)
+
+end subroutine ocn_init_setup_global_ocean_interpolate_swData!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_setup_global_ocean_read_windstress
+!
+!> \brief Read the windstress IC file
+!> \author Doug Jacobsen
+!> \date 03/07/2014
+!> \details
+!> This routine reads the windstress IC file, including latitude and longitude
+!> information for windstress data.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_global_ocean_read_windstress(domain, iErr)!{{{
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+
+ type (MPAS_Stream_type) :: windstressStream
+
+ integer :: iLat, iLon
+
+ character (len=StrKIND), pointer :: config_global_ocean_windstress_file, config_global_ocean_windstress_lat_varname, &
+ config_global_ocean_windstress_nlat_dimname, &
+ config_global_ocean_windstress_lon_varname, &
+ config_global_ocean_windstress_nlon_dimname, &
+ config_global_ocean_windstress_zonal_varname, &
+ config_global_ocean_windstress_meridional_varname
+
+ logical, pointer :: config_global_ocean_windstress_latlon_degrees
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_windstress_file', config_global_ocean_windstress_file)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_windstress_lat_varname', &
+ config_global_ocean_windstress_lat_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_windstress_nlat_dimname', &
+ config_global_ocean_windstress_nlat_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_windstress_lon_varname', &
+ config_global_ocean_windstress_lon_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_windstress_nlon_dimname', &
+ config_global_ocean_windstress_nlon_dimname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_windstress_zonal_varname', &
+ config_global_ocean_windstress_zonal_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_windstress_meridional_varname', &
+ config_global_ocean_windstress_meridional_varname)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_windstress_latlon_degrees', &
+ config_global_ocean_windstress_latlon_degrees)
+
+ ! Define stream for depth levels
+ call MPAS_createStream(windstressStream, domain % iocontext, config_global_ocean_windstress_file, MPAS_IO_NETCDF, &
+ MPAS_IO_READ, ierr=iErr)
+
+ ! Setup windLat, windLon, and windIC fields for stream to be read in
+ windLat % fieldName = trim(config_global_ocean_windstress_lat_varname)
+ windLat % dimSizes(1) = nLatWind
+ windLat % dimNames(1) = trim(config_global_ocean_windstress_nlat_dimname)
+ windLat % isVarArray = .false.
+ windLat % isPersistent = .true.
+ windLat % isActive = .true.
+ windLat % hasTimeDimension = .false.
+ windLat % block => domain % blocklist
+ allocate(windLat % attLists(1))
+ allocate(windLat % array(nLatWind))
+
+ windLon % fieldName = trim(config_global_ocean_windstress_lon_varname)
+ windLon % dimSizes(1) = nLonWind
+ windLon % dimNames(1) = trim(config_global_ocean_windstress_nlon_dimname)
+ windLon % isVarArray = .false.
+ windLon % isPersistent = .true.
+ windLon % isActive = .true.
+ windLon % hasTimeDimension = .false.
+ windLon % block => domain % blocklist
+ allocate(windLon % attLists(1))
+ allocate(windLon % array(nLonWind))
+
+ zonalWindIC % fieldName = trim(config_global_ocean_windstress_zonal_varname)
+ zonalWindIC % dimSizes(1) = nLonWind
+ zonalWindIC % dimSizes(2) = nLatWind
+ zonalWindIC % dimNames(1) = trim(config_global_ocean_windstress_nlon_dimname)
+ zonalWindIC % dimNames(2) = trim(config_global_ocean_windstress_nlat_dimname)
+ zonalWindIC % isVarArray = .false.
+ zonalWindIC % isPersistent = .true.
+ zonalWindIC % isActive = .true.
+ zonalWindIC % hasTimeDimension = .false.
+ zonalWindIC % block => domain % blocklist
+ allocate(zonalWindIC % attLists(1))
+ allocate(zonalWindIC % array(nLonWind, nLatWind))
+
+ meridionalWindIC % fieldName = trim(config_global_ocean_windstress_meridional_varname)
+ meridionalWindIC % dimSizes(1) = nLonWind
+ meridionalWindIC % dimSizes(2) = nLatWind
+ meridionalWindIC % dimNames(1) = trim(config_global_ocean_windstress_nlon_dimname)
+ meridionalWindIC % dimNames(2) = trim(config_global_ocean_windstress_nlat_dimname)
+ meridionalWindIC % isVarArray = .false.
+ meridionalWindIC % isPersistent = .true.
+ meridionalWindIC % isActive = .true.
+ meridionalWindIC % hasTimeDimension = .false.
+ meridionalWindIC % block => domain % blocklist
+ allocate(meridionalWindIC % attLists(1))
+ allocate(meridionalWindIC % array(nLonWind, nLatWind))
+
+ ! Add windLat, windLon, and windIC fields to stream
+ call MPAS_streamAddField(windstressStream, windLat, iErr)
+ call MPAS_streamAddField(windstressStream, windLon, iErr)
+ call MPAS_streamAddField(windstressStream, zonalWindIC, iErr)
+ call MPAS_streamAddField(windstressStream, meridionalWindIC, iErr)
+
+ ! Read stream
+ call MPAS_readStream(windstressStream, 1, iErr)
+
+ ! Close stream
+ call MPAS_closeStream(windstressStream)
+
+ if (config_global_ocean_windstress_latlon_degrees) then
+ windLat % array(:) = windLat % array(:) * pii / 180.0_RKIND
+ windLon % array(:) = windLon % array(:) * pii / 180.0_RKIND
+ end if
+
+ end subroutine ocn_init_setup_global_ocean_read_windstress!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_setup_global_ocean_interpolate_windstress
+!
+!> \brief Interpolate the windstress IC to MPAS mesh
+!> \author Doug Jacobsen
+!> \date 03/07/2014
+!> \details
+!> This routine interpolates windstress data to the MPAS mesh. Currently it
+!> uses a bilinear interpolation
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_global_ocean_interpolate_windstress(domain, iErr)!{{{
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool, forcingPool
+
+ real (kind=RKIND), dimension(:), pointer :: latCell, lonCell, windStressZonal, windStressMeridional
+
+ integer, pointer :: nCells
+
+ logical, pointer :: config_use_bulk_wind_stress
+ character (len=StrKIND), pointer :: config_global_ocean_windstress_method
+ real (kind=RKIND), pointer :: config_global_ocean_windstress_conversion_factor
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_use_bulk_wind_stress', config_use_bulk_wind_stress)
+ if (.not.config_use_bulk_wind_stress) then
+ write(stderrUnit,'(A)') ' WARNING: wind stress not initialized because config_use_bulk_wind_stress = .false.'
+ return
+ endif
+
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_windstress_method', config_global_ocean_windstress_method)
+ call mpas_pool_get_config(domain % configs, 'config_global_ocean_windstress_conversion_factor', &
+ config_global_ocean_windstress_conversion_factor)
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_array(meshPool, 'latCell', latCell)
+ call mpas_pool_get_array(meshPool, 'lonCell', lonCell)
+
+ call mpas_pool_get_array(forcingPool, 'windStressZonal', windStressZonal)
+ call mpas_pool_get_array(forcingPool, 'windStressMeridional', windStressMeridional)
+
+ if (config_global_ocean_windstress_method .eq. "nearest_neighbor") then
+ call ocn_init_interpolation_nearest_horiz(windLon % array, windLat % array, &
+ zonalWindIC % array, nLonWind, nLatWind, &
+ lonCell, latCell, windStressZonal, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+
+ call ocn_init_interpolation_nearest_horiz(windLon % array, windLat % array, &
+ meridionalWindIC % array, nLonWind, nLatWind, &
+ lonCell, latCell, windStressMeridional, nCells, &
+ inXPeriod = 2.0_RKIND * pii)
+
+ elseif (config_global_ocean_windstress_method .eq. "bilinear_interpolation") then
+ call ocn_init_interpolation_bilinear_horiz(windLon % array, windLat % array, &
+ zonalWindIC % array, nLonWind, nLatWind, &
+ lonCell, latCell, windStressZonal, nCells, &
+ inXPeriod = 2.0_RKIND*pii)
+
+ call ocn_init_interpolation_bilinear_horiz(windLon % array, windLat % array, &
+ meridionalWindIC % array, nLonWind, nLatWind, &
+ lonCell, latCell, windStressMeridional, nCells, &
+ inXPeriod = 2.0_RKIND*pii)
+
+ else
+ write(stderrUnit,*) 'ERROR: Invalid choice of config_global_ocean_windstress_method.'
+ iErr = 1
+ call mpas_dmpar_finalize(domain % dminfo)
+ endif
+
+ windStressZonal(:) = windStressZonal(:) * config_global_ocean_windstress_conversion_factor
+ windStressMeridional(:) = windStressMeridional(:) * config_global_ocean_windstress_conversion_factor
+
+ block_ptr => block_ptr % next
+ end do
+
+ end subroutine ocn_init_setup_global_ocean_interpolate_windstress!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_global_ocean_destroy_tracer_fields
+!
+!> \brief Tracer field cleanup routine
+!> \author Doug Jacobsen
+!> \date 03/04/2014
+!> \details
+!> This routine destroys the fields that were created to hold tracer
+!> initial condition information
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_global_ocean_destroy_tracer_fields()!{{{
+ deallocate(temperatureIC % array)
+ deallocate(salinityIC % array)
+ deallocate(tracerLat % array)
+ deallocate(tracerLon % array)
+ end subroutine ocn_init_global_ocean_destroy_tracer_fields!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_global_ocean_destroy_topo_fields
+!
+!> \brief Topography field cleanup routine
+!> \author Doug Jacobsen
+!> \date 03/07/2014
+!> \details
+!> This routine destroys the fields that were created to hold topography
+!> initial condition information
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_global_ocean_destroy_topo_fields()!{{{
+ deallocate(topoIC % array)
+ if(associated(oceanFracIC % array)) deallocate(oceanFracIC % array)
+ deallocate(topoLat % array)
+ deallocate(topoLon % array)
+ end subroutine ocn_init_global_ocean_destroy_topo_fields!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_global_ocean_destroy_land_ice_topography_fields
+!
+!> \brief Topography field cleanup routine
+!> \author Jeremy Fyke, Xylar Asay-Davis, Mark Petersen
+!> \date 06/23/2015
+!> \details
+!> This routine destroys the fields created to hold land ice topography
+!> initial condition information
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_global_ocean_destroy_land_ice_topography_fields()!{{{
+ deallocate(landIceThkIC % array)
+ deallocate(landIceDraftIC % array)
+ deallocate(landIceThkLat % array)
+ deallocate(landIceThkLon % array)
+ end subroutine ocn_init_global_ocean_destroy_land_ice_topography_fields!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_global_ocean_destroy_windstress_fields
+!
+!> \brief Windstress field cleanup routine
+!> \author Doug Jacobsen
+!> \date 03/07/2014
+!> \details
+!> This routine destroys the fields that were created to hold windstress
+!> initial condition information
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_global_ocean_destroy_windstress_fields()!{{{
+ deallocate(zonalWindIC % array)
+ deallocate(meridionalWindIC % array)
+ deallocate(windLat % array)
+ deallocate(windLon % array)
+ end subroutine ocn_init_global_ocean_destroy_windstress_fields!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_global_ocean_destroy_swData_fields
+!
+!> \brief penetrating shortwave data fields cleanup routine
+!> \author Luke Van Roekel
+!> \date 11/11/2015
+!> \details
+!> This routine destroys the fields that were created to hold penetrating sw radiation data
+!> initial condition information
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_global_ocean_destroy_swData_fields()!{{{
+ deallocate(chlorophyllIC % array)
+ deallocate(zenithAngleIC % array)
+ deallocate(clearSKYIC % array)
+ end subroutine ocn_init_global_ocean_destroy_swData_fields!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_validate_global_ocean
+!
+!> \brief Validation for global ocean test case
+!> \author Doug Jacobsen
+!> \date 03/04/2014
+!> \details
+!> This routine validates the configuration options for the global ocean test case.
+!
+!-----------------------------------------------------------------------
+
+
+ subroutine ocn_init_validate_global_ocean(configPool, packagePool, iocontext, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (mpas_pool_type), intent(inout) :: configPool, packagePool
+ type (mpas_io_context_type), intent(inout), target :: iocontext
+ integer, intent(out) :: iErr
+
+ type (mpas_io_context_type), pointer :: iocontext_ptr
+ type (MPAS_IO_Handle_type) :: inputFile
+ character (len=StrKIND), pointer :: config_init_configuration, &
+ config_global_ocean_depth_file, &
+ config_global_ocean_depth_dimname, &
+ config_global_ocean_temperature_file, &
+ config_global_ocean_salinity_file, &
+ config_global_ocean_tracer_nlat_dimname, &
+ config_global_ocean_tracer_nlon_dimname, &
+ config_global_ocean_topography_file, &
+ config_global_ocean_topography_nlat_dimname, &
+ config_global_ocean_topography_nlon_dimname, &
+ config_global_ocean_windstress_file, &
+ config_global_ocean_windstress_nlat_dimname, &
+ config_global_ocean_windstress_nlon_dimname, &
+ config_global_ocean_land_ice_topo_file, &
+ config_global_ocean_land_ice_topo_nlat_dimname, &
+ config_global_ocean_land_ice_topo_nlon_dimname, &
+ config_global_ocean_swData_file, &
+ config_global_ocean_swData_nlon_dimname, &
+ config_global_ocean_swData_nlat_dimname
+
+ integer, pointer :: config_vert_levels
+ logical, pointer :: landIceInitActive, config_global_ocean_depress_by_land_ice
+
+ iocontext_ptr => iocontext
+ iErr = 0
+
+ call mpas_pool_get_config(configPool, 'config_init_configuration', config_init_configuration)
+
+ if(config_init_configuration .ne. trim('global_ocean')) return
+
+ call mpas_pool_get_config(configPool, 'config_vert_levels', config_vert_levels)
+
+ call mpas_pool_get_config(configPool, 'config_global_ocean_depth_file', &
+ config_global_ocean_depth_file)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_depth_dimname', &
+ config_global_ocean_depth_dimname)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_temperature_file', &
+ config_global_ocean_temperature_file)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_salinity_file', &
+ config_global_ocean_salinity_file)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_tracer_nlat_dimname', &
+ config_global_ocean_tracer_nlat_dimname)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_tracer_nlon_dimname', &
+ config_global_ocean_tracer_nlon_dimname)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_topography_file', &
+ config_global_ocean_topography_file)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_topography_nlat_dimname', &
+ config_global_ocean_topography_nlat_dimname)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_topography_nlon_dimname', &
+ config_global_ocean_topography_nlon_dimname)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_depress_by_land_ice', &
+ config_global_ocean_depress_by_land_ice)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_land_ice_topo_file', &
+ config_global_ocean_land_ice_topo_file)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_land_ice_topo_nlat_dimname', &
+ config_global_ocean_land_ice_topo_nlat_dimname)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_land_ice_topo_nlon_dimname', &
+ config_global_ocean_land_ice_topo_nlon_dimname)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_windstress_file', &
+ config_global_ocean_windstress_file)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_windstress_nlat_dimname', &
+ config_global_ocean_windstress_nlat_dimname)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_windstress_nlon_dimname', &
+ config_global_ocean_windstress_nlon_dimname)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_swData_file', &
+ config_global_ocean_swData_file)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_swData_nlat_dimname', &
+ config_global_ocean_swData_nlat_dimname)
+ call mpas_pool_get_config(configPool, 'config_global_ocean_swData_nlon_dimname', &
+ config_global_ocean_swData_nlon_dimname)
+
+
+ call mpas_pool_get_package(packagePool, 'landIceInitActive', landIceInitActive)
+ if ( config_global_ocean_depress_by_land_ice) then
+ landIceInitActive = .true.
+ end if
+
+ if (trim(config_global_ocean_depth_file) == 'none') then
+ write(stderrUnit,*) 'ERROR: Validation failed for global ocean. Invalid filename for config_global_ocean_depth_file'
+ iErr = 1
+ return
+ end if
+
+ inputFile = MPAS_io_open(config_global_ocean_depth_file, MPAS_IO_READ, MPAS_IO_NETCDF, iocontext_ptr, ierr=iErr)
+ if (iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: could not open file ', trim(config_global_ocean_depth_file)
+ return
+ end if
+
+ call MPAS_io_inq_dim(inputFile, config_global_ocean_depth_dimname, nDepth, iErr)
+
+ call MPAS_io_close(inputFile, iErr)
+
+ if (trim(config_global_ocean_temperature_file) == 'none') then
+ write(stderrUnit,*) 'ERROR: Validation failed for global ocean. Invalid filename for config_global_ocean_temperature_file'
+ iErr = 1
+ return
+ end if
+
+ if (trim(config_global_ocean_salinity_file) == 'none') then
+ write(stderrUnit,*) 'ERROR: Validation failed for global ocean. Invalid filename for config_global_ocean_salinity_file'
+ iErr = 1
+ return
+ end if
+
+ inputFile = MPAS_io_open(config_global_ocean_temperature_file, MPAS_IO_READ, MPAS_IO_NETCDF, iocontext_ptr, ierr=iErr)
+ if (iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: could not open file ', trim(config_global_ocean_temperature_file)
+ return
+ end if
+
+ call MPAS_io_inq_dim(inputFile, config_global_ocean_tracer_nlat_dimname, nLatTracer, iErr)
+ call MPAS_io_inq_dim(inputFile, config_global_ocean_tracer_nlon_dimname, nLonTracer, iErr)
+
+ call MPAS_io_close(inputFile, iErr)
+
+ if (trim(config_global_ocean_windstress_file) == 'none') then
+ write(stderrUnit,*) 'ERROR: Validation failed for global ocean. Invalid filename for config_global_ocean_windstress_file'
+ iErr = 1
+ return
+ end if
+
+ inputFile = MPAS_io_open(config_global_ocean_swData_file, MPAS_IO_READ, MPAS_IO_NETCDF, iocontext_ptr, ierr=iErr)
+
+ call MPAS_io_inq_dim(inputFile, config_global_ocean_swData_nlat_dimname, nLatSW, iErr)
+ call MPAS_io_inq_dim(inputFile, config_global_ocean_swData_nlon_dimname, nLonSW, iErr)
+
+ call MPAS_io_close(inputFile, iErr)
+
+ if (trim(config_global_ocean_topography_file) == 'none') then
+ write(stderrUnit,*) 'ERROR: Validation failed for global ocean. Invalid filename for config_global_ocean_topography_file'
+ iErr = 1
+ return
+ end if
+
+ inputFile = MPAS_io_open(config_global_ocean_topography_file, MPAS_IO_READ, MPAS_IO_NETCDF, iocontext_ptr, ierr=iErr)
+ if (iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: could not open file ', trim(config_global_ocean_topography_file)
+ return
+ end if
+
+ call MPAS_io_inq_dim(inputFile, config_global_ocean_topography_nlat_dimname, nLatTopo, iErr)
+ call MPAS_io_inq_dim(inputFile, config_global_ocean_topography_nlon_dimname, nLonTopo, iErr)
+
+ call MPAS_io_close(inputFile, iErr)
+
+ inputFile = MPAS_io_open(config_global_ocean_windstress_file, MPAS_IO_READ, MPAS_IO_NETCDF, iocontext_ptr, ierr=iErr)
+ if (iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: could not open file ', trim(config_global_ocean_windstress_file)
+ return
+ end if
+
+ call MPAS_io_inq_dim(inputFile, config_global_ocean_windstress_nlat_dimname, nLatWind, iErr)
+ call MPAS_io_inq_dim(inputFile, config_global_ocean_windstress_nlon_dimname, nLonWind, iErr)
+
+ call MPAS_io_close(inputFile, iErr)
+
+ if (config_vert_levels <= 0 .and. nDepth > 0) then
+ config_vert_levels = nDepth
+ else if(config_vert_levels <= 0) then
+ write(stderrUnit,*) 'ERROR: Validation failed for global ocean. Not given a usable value for vertical levels.'
+ iErr = 1
+ end if
+
+ if ( config_global_ocean_depress_by_land_ice) then
+ if (trim(config_global_ocean_land_ice_topo_file) == 'none') then
+ write(stderrUnit,*) 'ERROR: Validation failed for global ocean. ', &
+ 'Invalid filename for config_global_ocean_land_ice_topo_file'
+ iErr = 1
+ return
+ end if
+
+ inputFile = MPAS_io_open(config_global_ocean_land_ice_topo_file, MPAS_IO_READ, MPAS_IO_NETCDF, iocontext_ptr, ierr=iErr)
+ if (iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: could not open file ', trim(config_global_ocean_land_ice_topo_file)
+ return
+ end if
+
+ call MPAS_io_inq_dim(inputFile, config_global_ocean_land_ice_topo_nlat_dimname, nLatLandIceThk, iErr)
+ call MPAS_io_inq_dim(inputFile, config_global_ocean_land_ice_topo_nlon_dimname, nLonLandIceThk, iErr)
+
+ call MPAS_io_close(inputFile, iErr)
+ end if
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_validate_global_ocean!}}}
+
+!***********************************************************************
+
+end module ocn_init_global_ocean
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_internal_waves.F b/src/core_ocean/mode_init/mpas_ocn_init_internal_waves.F
new file mode 100644
index 0000000000..ef62acfacd
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_internal_waves.F
@@ -0,0 +1,387 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_internal_waves
+!
+!> \brief MPAS ocean initialize case -- Internal waves
+!> \author Doug Jacobsen
+!> \date 02/18/2014
+!> \details
+!> This module contains the routines for initializing the
+!> the internal waves test case
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_internal_waves
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+ use mpas_dmpar
+
+ use ocn_init_vertical_grids
+ use ocn_init_cell_markers
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_setup_internal_waves, &
+ ocn_init_validate_internal_waves
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_setup_internal_waves
+!
+!> \brief Setup for internal waves test case
+!> \author Doug Jacobsen
+!> \date 02/19/2014
+!> \details
+!> This routine sets up the initial conditions for the internal waves test case.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_internal_waves(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ ! Define pool pointers
+ type (mpas_pool_type), pointer :: meshPool, verticalMeshPool, statePool, tracersPool
+
+ ! Define dimension pointers
+ integer, pointer :: nVertLevels, nVertLevelsP1, nCells, nEdges, nVertices
+ integer, pointer :: nCellsSolve, nEdgesSolve, index_temperature, index_salinity, index_tracer1
+
+ ! Define array pointers
+ integer, dimension(:), pointer :: maxLevelCell
+
+ real (kind=RKIND), dimension(:), pointer :: xCell, yCell, bottomDepth, dcEdge
+ real (kind=RKIND), dimension(:), pointer :: refBottomDepth, refZMid, vertCoordMovementWeights
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness, restingThickness
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers, debugTracers
+
+ real (kind=RKIND) :: yMin, yMax, xMin, xMax, dcEdgeMin
+ real (kind=RKIND) :: yMinGlobal, yMaxGlobal, yMidGlobal, xMinGlobal, xMaxGlobal, dcEdgeMinGlobal
+ real (kind=RKIND) :: temperature, yOffset, perturbationWidth
+
+ ! Define config pointers
+ character (len=StrKIND), pointer :: config_init_configuration, config_vertical_grid, config_internal_waves_layer_type
+ logical, pointer :: config_internal_waves_use_distances
+ real (kind=RKIND), pointer :: config_internal_waves_amplitude_width_frac, config_internal_waves_amplitude_width_dist
+ real (kind=RKIND), pointer :: config_internal_waves_bottom_depth, config_internal_waves_bottom_temperature
+ real (kind=RKIND), pointer :: config_internal_waves_surface_temperature, config_internal_waves_temperature_difference
+ real (kind=RKIND), pointer :: config_internal_waves_salinity, config_internal_waves_isopycnal_displacement
+
+ type (block_type), pointer :: block_ptr
+
+ integer :: iCell, k
+
+ real (kind=RKIND) :: deltaTemperature
+ real (kind=RKIND), dimension(:), pointer :: zTop, refTemperature, refTemperatureTop, refZTop
+ real (kind=RKIND), dimension(:), pointer :: interfaceLocations
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_init_configuration', config_init_configuration)
+
+ if(config_init_configuration .ne. trim('internal_waves')) return
+
+ ! Initalize min/max values to large positive and negative values
+ yMin = 1.0E10_RKIND
+ yMax = -1.0E10_RKIND
+ xMin = 1.0E10_RKIND
+ xMax = -1.0E10_RKIND
+ dcEdgEMin = 1.0E10_RKIND
+
+ ! Define locations of layer interfaces
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevelsP1', nVertLevelsP1)
+ call mpas_pool_get_config(domain % configs, 'config_vertical_grid', config_vertical_grid)
+ allocate( interfaceLocations( nVertLevelsP1 ) )
+
+ call ocn_generate_vertical_grid( config_vertical_grid, interfaceLocations )
+
+ call mpas_pool_get_config(domain % configs, 'config_internal_waves_use_distances', config_internal_waves_use_distances)
+ call mpas_pool_get_config(domain % configs, 'config_internal_waves_amplitude_width_frac', &
+ config_internal_waves_amplitude_width_frac)
+ call mpas_pool_get_config(domain % configs, 'config_internal_waves_amplitude_width_dist', &
+ config_internal_waves_amplitude_width_dist)
+ call mpas_pool_get_config(domain % configs, 'config_internal_waves_bottom_depth', config_internal_waves_bottom_depth)
+ call mpas_pool_get_config(domain % configs, 'config_internal_waves_bottom_temperature', &
+ config_internal_waves_bottom_temperature)
+ call mpas_pool_get_config(domain % configs, 'config_internal_waves_surface_temperature', &
+ config_internal_waves_surface_temperature)
+ call mpas_pool_get_config(domain % configs, 'config_internal_waves_temperature_difference', &
+ config_internal_waves_temperature_difference)
+ call mpas_pool_get_config(domain % configs, 'config_internal_waves_salinity', config_internal_waves_salinity)
+ call mpas_pool_get_config(domain % configs, 'config_internal_waves_isopycnal_displacement', &
+ config_internal_waves_isopycnal_displacement)
+ call mpas_pool_get_config(domain % configs, 'config_internal_waves_layer_type', config_internal_waves_layer_type)
+
+ ! Determine local min and max values.
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
+
+ xMin = min( xMin, minval(xCell(1:nCellssolve)))
+ xMax = max( xMax, maxval(xCell(1:nCellssolve)))
+ yMin = min( yMin, minval(yCell(1:nCellssolve)))
+ yMax = max( yMax, maxval(yCell(1:nCellssolve)))
+ dcEdgeMin = min( dcEdgeMin, minval(dcEdge(1:nEdgesSolve)))
+
+ block_ptr => block_ptr % next
+ end do
+
+ ! Determine global min and max values.
+ call mpas_dmpar_min_real(domain % dminfo, yMin, yMinGlobal)
+ call mpas_dmpar_max_real(domain % dminfo, yMax, yMaxGlobal)
+ call mpas_dmpar_min_real(domain % dminfo, xMin, xMinGlobal)
+ call mpas_dmpar_max_real(domain % dminfo, xMax, xMaxGlobal)
+ call mpas_dmpar_min_real(domain % dminfo, dcEdgEMin, dcEdgeMinGlobal)
+
+ yMidGlobal = (yMinGlobal + yMaxGlobal) * 0.5_RKIND
+ if(config_internal_waves_use_distances) then
+ perturbationWidth = config_internal_waves_amplitude_width_dist
+ else
+ perturbationWidth = (yMaxGlobal - yMinGlobal) * config_internal_waves_amplitude_width_frac
+ end if
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_array(meshPool, 'vertCoordMovementWeights', vertCoordMovementWeights)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+
+ call mpas_pool_get_array(verticalMeshPool, 'refZMid', refZMid)
+ call mpas_pool_get_array(verticalMeshPool, 'restingThickness', restingThickness)
+
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', index_temperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', index_salinity)
+ call mpas_pool_get_dimension(tracersPool, 'index_tracer1', index_tracer1)
+
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+ call mpas_pool_get_array(tracersPool, 'debugTracers', debugTracers, 1)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+
+ call ocn_mark_north_boundary(meshPool, yMaxGlobal, dcEdgeMinGlobal, iErr)
+ call ocn_mark_south_boundary(meshPool, yMinGlobal, dcEdgeMinGlobal, iErr)
+ call ocn_mark_east_boundary(meshPool, xMaxGlobal, dcEdgeMinGlobal, iErr)
+ call ocn_mark_west_boundary(meshPool, xMinGlobal, dcEdgeMinGlobal, iErr)
+
+ allocate(zTop(nVertLevels+1), refTemperature(nVertLevels), refTemperatureTop(nVertLevels+1), refZTop(nVertLevels+1))
+
+ ! Set refBottomDepth and refBottomDepthTopOfCell
+ do k = 1, nVertLevels
+ refBottomDepth(k) = config_internal_waves_bottom_depth * interfaceLocations(k+1)
+ refZMid(k) = -0.5_RKIND * config_internal_waves_bottom_depth * (interfaceLocations(k) + interfaceLocations(k+1))
+ end do
+
+ if ( trim(config_internal_waves_layer_type) == 'isopycnal' ) then
+
+ refTemperatureTop(1) = config_internal_waves_surface_temperature
+ refTemperatureTop(nVertLevels+1) = config_internal_waves_bottom_temperature
+ deltaTemperature = (config_internal_waves_surface_temperature - config_internal_waves_bottom_temperature)/nVertLevels
+ refTemperature(1) = config_internal_waves_surface_temperature - deltaTemperature/2.0_RKIND
+ refZTop(1) = 0.0_RKIND
+ do k = 2, nVertLevels
+ refTemperatureTop(k) = refTemperatureTop(1) - (k-1)*deltaTemperature
+ refTemperature(k) = refTemperature(1) - (k-1)*deltaTemperature
+ refZTop(k) = refZTop(k-1) - config_internal_waves_bottom_depth / nVertLevels
+ end do
+
+ endif
+
+ ! Set vertCoordMovementWeights
+ vertCoordMovementWeights(:) = 1.0_RKIND
+
+ do iCell = 1, nCellsSolve
+
+ ! Set debug tracer
+ if ( associated(debugTracers) ) then
+ do k = 1, nVertLevels
+ debugTracers(index_tracer1, k, iCell) = 1.0_RKIND
+ enddo
+ end if
+
+ if ( trim(config_internal_waves_layer_type) == 'z-level' ) then
+
+ ! Set stratified temperature
+ if ( associated(activeTracers) ) then
+ do k = nVertLevels, 1, -1
+ temperature = config_internal_waves_bottom_temperature &
+ + (config_internal_waves_surface_temperature - config_internal_waves_bottom_temperature) &
+ * ( (refZMid(k) - refZMid(nVertLevels)) / (-refZMid(nVertLevels) ))
+ activeTracers(index_temperature, k, iCell) = temperature
+ end do
+
+ if ( abs(yCell(iCell) - yMidGlobal) < perturbationWidth ) then
+ ! If cell is in the southern half, outside the sin width, subtract temperature difference
+ do k = 2, nVertLevels
+ temperature = -config_internal_waves_temperature_difference * cos(0.5_RKIND * pii * (yCell(iCell) &
+ - yMidGlobal) / perturbationWidth) * sin ( pii * refBottomDepth(k-1) &
+ / refBottomDepth(nVertLevels-1) )
+
+ activeTracers(index_temperature, k, iCell) = activeTracers(index_temperature, k, iCell) + temperature
+ end do
+ end if
+ end if
+
+ ! Set layerThickness
+ layerThickness(:, iCell) = refBottomDepth(:)
+ restingThickness(:, iCell) = layerThickness(:, iCell)
+
+ else if ( trim(config_internal_waves_layer_type) == 'isopycnal' ) then
+
+ ! Set stratified temperature
+ if ( associated(activeTracers) ) then
+ activeTracers(index_temperature, :, iCell) = refTemperature(:)
+ end if
+
+ ! Set layerThickness
+ if ( abs(yCell(iCell) - yMidGlobal) < perturbationWidth) then
+ ! If cell is in the southern half, outside the sin width, subtract temperature difference
+ zTop(1) = 0.0_RKIND
+ do k = 2, nVertLevels
+ zTop(k) = refZTop(k) + &
+ config_internal_waves_isopycnal_displacement * sin(pii * (k-1) / (nVertLevels+4)) &
+ * cos(0.5_RKIND * pii * (yCell(iCell) - yMidGlobal) / perturbationWidth)
+ end do
+ zTop(nVertLevels+1) = -config_internal_waves_bottom_depth
+
+ do k = 1, nVertLevels
+ layerThickness(k, iCell) = zTop(k) - zTop(k+1)
+ restingThickness(k, iCell) = layerThickness(k, iCell)
+ end do
+ else
+ layerThickness(:, iCell) = config_internal_waves_bottom_depth / nVertLevels
+ restingThickness(:, iCell) = layerThickness(:, iCell)
+ end if
+ else
+ call mpas_dmpar_global_abort('MPAS-ocean: Error: wrong choice of config_internal_waves_layer_type')
+ endif
+
+ ! Set salinity
+ if ( associated(activeTracers) ) then
+ activeTracers(index_salinity, :, iCell) = config_internal_waves_salinity
+ end if
+
+ ! Set bottomDepth
+ bottomDepth(iCell) = config_internal_waves_bottom_depth
+
+ ! Set maxLevelCell
+ maxLevelCell(iCell) = nVertLevels
+ end do
+
+ deallocate(zTop, refTemperature, refTemperatureTop, refZTop)
+
+ block_ptr => block_ptr % next
+ end do
+
+
+
+ deallocate(interfaceLocations)
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_setup_internal_waves!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_validate_internal_waves
+!
+!> \brief Validation for internal waves test case
+!> \author Doug Jacobsen
+!> \date 02/20/2014
+!> \details
+!> This routine validates the configuration options for the internal waves test case.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_validate_internal_waves(configPool, packagePool, iocontext, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (mpas_pool_type), intent(inout) :: configPool
+ type (mpas_pool_type), intent(inout) :: packagePool
+ type (mpas_io_context_type), intent(inout) :: iocontext
+
+ integer, intent(out) :: iErr
+
+ character (len=StrKIND), pointer :: config_init_configuration
+ integer, pointer :: config_vert_levels, config_internal_waves_vert_levels
+
+ iErr = 0
+
+ call mpas_pool_get_config(configPool, 'config_init_configuration', config_init_configuration)
+
+ if(config_init_configuration .ne. trim('internal_waves')) return
+
+ call mpas_pool_get_config(configPool, 'config_vert_levels', config_vert_levels)
+ call mpas_pool_get_config(configPool, 'config_internal_waves_vert_levels', config_internal_waves_vert_levels)
+
+ if(config_vert_levels <= 0 .and. config_internal_waves_vert_levels > 0) then
+ config_vert_levels = config_internal_waves_vert_levels
+ else if(config_vert_levels <= 0) then
+ write(stderrUnit,*) 'ERROR: Validation failed for internal waves. Not given a usable value for vertical levels.'
+ iErr = 1
+ end if
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_validate_internal_waves!}}}
+
+!***********************************************************************
+
+end module ocn_init_internal_waves
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_interpolation.F b/src/core_ocean/mode_init/mpas_ocn_init_interpolation.F
new file mode 100644
index 0000000000..1b8b4a5f97
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_interpolation.F
@@ -0,0 +1,534 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_vertical_grids
+!
+!> \brief MPAS ocean vertical grid generator
+!> \author Xylar Asay-Davis
+!> \date 10/30/2015
+!> \details
+!> This module contains the routines for generating
+!> vertical grids.
+!
+!-----------------------------------------------------------------------
+module ocn_init_interpolation
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+ use mpas_timer
+
+ use ocn_constants
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_interpolation_linear_vert, &
+ ocn_init_interpolation_nearest_horiz, &
+ ocn_init_interpolation_bilinear_horiz
+
+ interface ocn_init_interpolation_nearest_horiz
+ module procedure ocn_init_interpolation_nearest_horiz_2D
+ module procedure ocn_init_interpolation_nearest_horiz_3D
+ end interface
+
+ interface ocn_init_interpolation_bilinear_horiz
+ module procedure ocn_init_interpolation_bilinear_horiz_2D
+ module procedure ocn_init_interpolation_bilinear_horiz_3D
+ end interface
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_interpolation_linear_vert
+!
+!> \brief linearly interpolate a field in the vertical
+!> \author Xylar Asay-Davis
+!> \date 10/12/2015
+!> \details
+!> Perform vertical linear interpolation of a field from a reference field
+!> with data located at inZ to new locations outZ. Bu default, out-of-range values of
+!> outZ are clamped to the nearest in-range value. That is, wherever
+!> outZ > inZ(1), outField = inField(1); wherever outZ < inZ(inNVertLevels),
+!> outFiled = inField(inNVertLevels). If the optional extrapolate argument
+!> is present and set to .true., linear extrapolation is perfored outside the
+!> bounds of inZ.
+
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_interpolation_linear_vert(inZ, inField, inNVertLevels, outZ, outField, outNVertLevels, extrapolate)!{{{
+
+ !--------------------------------------------------------------------
+
+ integer, intent(in) :: inNVertLevels, outNVertLevels
+ real (kind=RKIND), dimension(inNVertLevels), intent(in) :: inZ, inField
+ real (kind=RKIND), dimension(outNVertLevels), intent(in) :: outZ
+ real (kind=RKIND), dimension(outNVertLevels), intent(out) :: outField
+ logical, optional, intent(in) :: extrapolate
+
+ ! Define variable pointers
+ integer :: outK, inK
+ real (kind=RKIND) :: z, frac
+
+ logical :: doExtrapolate
+
+ if(outNVertLevels <= 0) return
+
+ ! handle single level of input data as a special case
+ if(inNVertLevels == 1) then
+ outField(1:outNVertLevels) = inField(1)
+ return
+ end if
+
+ doExtrapolate = .false.
+ if(present(extrapolate)) then
+ doExtrapolate = extrapolate
+ end if
+
+ if(doExtrapolate) then
+ do outK=1,outNVertLevels
+ z = outZ(outK)
+ if(z >= inZ(1)) then
+ inK = 1
+ else if(z <= inZ(inNVertLevels)) then
+ inK = inNVertLevels-1
+ else
+ do inK = 1, inNVertLevels-1
+ if(z >= inZ(inK+1)) exit
+ end do
+ end if
+ ! frac can be outside [0,1) if we're extrapolating
+ frac = (z - inZ(inK))/(inZ(inK+1) - inZ(inK))
+ outField(outK) = (1.0_RKIND - frac)*inField(inK) + frac*inField(inK+1)
+ end do
+ else ! not extrapolating
+ do outK=1,outNVertLevels
+ z = outZ(outK)
+ if(z >= inZ(1)) then
+ inK = 1
+ frac = 0.0_RKIND
+ else if(z <= inZ(inNVertLevels)) then
+ inK = inNVertLevels-1
+ frac = 1.0_RKIND
+ else
+ do inK = 1, inNVertLevels-1
+ if(z >= inZ(inK+1)) exit
+ end do
+ ! frac should always be inside [0,1)
+ frac = (z - inZ(inK))/(inZ(inK+1) - inZ(inK))
+ end if
+ outField(outK) = (1.0_RKIND - frac)*inField(inK) + frac*inField(inK+1)
+ end do
+ end if
+
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_interpolation_linear_vert!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_interpolation_nearest_horiz_2D
+!
+!> \brief nearest-neighbor interpolation in horiz.
+!> \author Xylar Asay-Davis
+!> \date 10/30/2015
+!> \details
+!> Perform horizontal nearest-neighbor interpolation of a field from
+!> values on a logically rectangular grid.
+
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_interpolation_nearest_horiz_2D(inX, inY, inField, inNx, inNy, &
+ outX, outY, outField, outN, &
+ inXPeriod, inYPeriod)!{{{
+
+ !--------------------------------------------------------------------
+
+ integer, intent(in) :: inNx, inNy, outN
+ real (kind=RKIND), dimension(inNx), intent(in) :: inX
+ real (kind=RKIND), dimension(inNy), intent(in) :: inY
+ real (kind=RKIND), dimension(inNx,inNy), intent(in) :: inField
+ real (kind=RKIND), dimension(outN), intent(in) :: outX, outY
+ real (kind=RKIND), dimension(outN), intent(out) :: outField
+ real (kind=RKIND), intent(in), optional :: inXPeriod, inYPeriod
+
+ ! Define variable pointers
+ integer :: outIndex, xSearch, ySearch, searchIdx
+ real (kind=RKIND) :: currentX, currentY, minDist, dist
+
+ do outIndex = 1, outN
+ currentX = outX(outIndex)
+ if(present(inXPeriod)) then
+ ! put currentX in the range of [inX(1),inX(1)+inXPeriod)
+ currentX = mod(currentX-inX(1),inXPeriod) + inX(1)
+ end if
+ currentY = outY(outIndex)
+ if(present(inYPeriod)) then
+ ! put currentY in the range of [inY(1),inY(1)+inYPeriod)
+ currentY = mod(currentY-inY(1),inYPeriod) + inY(1)
+ end if
+
+ xSearch = 1
+ minDist = 1e34
+ do searchIdx = 1, inNx
+ dist = abs(currentX - inX(searchIdx))
+ if (dist < minDist) then
+ minDist = dist
+ xSearch = searchIdx
+ end if
+ end do
+
+ ySearch = 1
+ minDist = 1e34
+ do searchIdx = 1, inNy
+ dist = abs(currentY - inY(searchIdx))
+ if (dist < minDist) then
+ minDist = dist
+ ySearch = searchIdx
+ end if
+ end do
+
+ outField(outIndex) = inField(xSearch, ySearch)
+
+ end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_interpolation_nearest_horiz_2D!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_interpolation_nearest_horiz_3D
+!
+!> \brief nearest-neighbor interpolation in horiz.
+!> \author Xylar Asay-Davis
+!> \date 10/30/2015
+!> \details
+!> Perform horizontal nearest-neighbor interpolation of a field from
+!> values on a logically rectangular grid.
+
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_interpolation_nearest_horiz_3D(inX, inY, inField, inNx, inNy, &
+ outX, outY, outField, outN, &
+ inXPeriod, inYPeriod)!{{{
+
+ !--------------------------------------------------------------------
+
+ integer, intent(in) :: inNx, inNy, outN
+ real (kind=RKIND), dimension(inNx), intent(in) :: inX
+ real (kind=RKIND), dimension(inNy), intent(in) :: inY
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: inField
+ real (kind=RKIND), dimension(outN), intent(in) :: outX, outY
+ real (kind=RKIND), dimension(:,:), intent(out) :: outField
+ real (kind=RKIND), intent(in), optional :: inXPeriod, inYPeriod
+
+ ! Define variable pointers
+ integer :: outIndex, xSearch, ySearch, searchIdx
+ real (kind=RKIND) :: currentX, currentY, minDist, dist
+
+ do outIndex = 1, outN
+ currentX = outX(outIndex)
+ if(present(inXPeriod)) then
+ ! put currentX in the range of [inX(1),inX(1)+inXPeriod)
+ currentX = mod(currentX-inX(1),inXPeriod) + inX(1)
+ end if
+ currentY = outY(outIndex)
+ if(present(inYPeriod)) then
+ ! put currentY in the range of [inY(1),inY(1)+inYPeriod)
+ currentY = mod(currentY-inY(1),inYPeriod) + inY(1)
+ end if
+
+ xSearch = 1
+ minDist = 1e34
+ do searchIdx = 1, inNx
+ dist = abs(currentX - inX(searchIdx))
+ if (dist < minDist) then
+ minDist = dist
+ xSearch = searchIdx
+ end if
+ end do
+
+ ySearch = 1
+ minDist = 1e34
+ do searchIdx = 1, inNy
+ dist = abs(currentY - inY(searchIdx))
+ if (dist < minDist) then
+ minDist = dist
+ ySearch = searchIdx
+ end if
+ end do
+
+ outField(:,outIndex) = inField(xSearch, ySearch,:)
+
+ end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_interpolation_nearest_horiz_3D!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_interpolation_bilinear_horiz_2D
+!
+!> \brief bilinear interpolation in horiz.
+!> \author Xylar Asay-Davis
+!> \date 10/30/2015
+!> \details
+!> Perform horizontal bilinear interpolation of a field from
+!> values on a logically rectangular grid. Optional parameters
+!> inXPeriod and inYPeriod are used to specify the period of the
+!> input grid. If either or both are omitted, the grid is not
+!> treated as being periodic in either or both dimensions.
+
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_interpolation_bilinear_horiz_2D(inX, inY, inField, inNx, inNy, &
+ outX, outY, outField, outN, &
+ inXPeriod, inYPeriod, extrapX, extrapY)!{{{
+
+ !--------------------------------------------------------------------
+
+ integer, intent(in) :: inNx, inNy, outN
+ real (kind=RKIND), dimension(inNx), intent(in) :: inX
+ real (kind=RKIND), dimension(inNy), intent(in) :: inY
+ real (kind=RKIND), dimension(inNx,inNy), intent(in) :: inField
+ real (kind=RKIND), dimension(outN), intent(in) :: outX, outY
+ real (kind=RKIND), dimension(outN), intent(out) :: outField
+ real (kind=RKIND), intent(in), optional :: inXPeriod, inYPeriod
+ logical, intent(in), optional :: extrapX, extrapY
+
+ ! Define variable pointers
+ integer :: outIndex, xInd1, xInd2, yInd1, yInd2, k
+ real (kind=RKIND) :: x, y, xFrac, yFrac
+
+ do outIndex = 1, outN
+ x = outX(outIndex)
+ y = outY(outIndex)
+
+ if(present(inXPeriod)) then
+ call getLinearCoeffs(x, inX, inNx, xInd1, xInd2, xFrac, inXPeriod)
+ else
+ call getLinearCoeffs(x, inX, inNx, xInd1, xInd2, xFrac)
+ end if
+
+ ! if we're not extrapolating, limit xFrac
+ if(present(extrapX)) then
+ if(.not. extrapX) then
+ xFrac = min(1.0_RKIND,max(0.0_RKIND,xFrac))
+ end if
+ else
+ ! by default, we don't extrapolate
+ xFrac = min(1.0_RKIND,max(0.0_RKIND,xFrac))
+ end if
+
+ if(present(inYPeriod)) then
+ call getLinearCoeffs(y, inY, inNy, yInd1, yInd2, yFrac, inYPeriod)
+ else
+ call getLinearCoeffs(y, inY, inNy, yInd1, yInd2, yFrac)
+ end if
+
+ ! if we're not extrapolating, limit yFrac
+ if(present(extrapY)) then
+ if(.not. extrapY) then
+ yFrac = min(1.0_RKIND,max(0.0_RKIND,yFrac))
+ end if
+ else
+ ! by default, we don't extrapolate
+ yFrac = min(1.0_RKIND,max(0.0_RKIND,yFrac))
+ end if
+
+ outField(outIndex) = &
+ (1.0_RKIND-xFrac)*(1.0_RKIND-yFrac)*inField(xInd1,yInd1) &
+ + xFrac*(1.0_RKIND-yFrac)*inField(xInd2,yInd1) &
+ + (1.0_RKIND-xFrac)*yFrac*inField(xInd1,yInd2) &
+ + xFrac*yFrac*inField(xInd2,yInd2)
+ end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_interpolation_bilinear_horiz_2D!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_interpolation_bilinear_horiz_3D
+!
+!> \brief bilinear interpolation in horiz.
+!> \author Xylar Asay-Davis
+!> \date 10/30/2015
+!> \details
+!> Perform horizontal bilinear interpolation of a field from
+!> values on a logically rectangular grid. Optional parameters
+!> inXPeriod and inYPeriod are used to specify the period of the
+!> input grid. If either or both are omitted, the grid is not
+!> treated as being periodic in either or both dimensions.
+
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_interpolation_bilinear_horiz_3D(inX, inY, inField, inNx, inNy, &
+ outX, outY, outField, outN, &
+ inXPeriod, inYPeriod, extrapX, extrapY)!{{{
+
+ !--------------------------------------------------------------------
+
+ integer, intent(in) :: inNx, inNy, outN
+ real (kind=RKIND), dimension(inNx), intent(in) :: inX
+ real (kind=RKIND), dimension(inNy), intent(in) :: inY
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: inField
+ real (kind=RKIND), dimension(outN), intent(in) :: outX, outY
+ real (kind=RKIND), dimension(:,:), intent(out) :: outField
+ real (kind=RKIND), intent(in), optional :: inXPeriod, inYPeriod
+ logical, intent(in), optional :: extrapX, extrapY
+
+ ! Define variable pointers
+ integer :: outIndex, xInd1, xInd2, yInd1, yInd2, k
+ real (kind=RKIND) :: x, y, xFrac, yFrac
+
+ do outIndex = 1, outN
+ x = outX(outIndex)
+ y = outY(outIndex)
+
+ if(present(inXPeriod)) then
+ call getLinearCoeffs(x, inX, inNx, xInd1, xInd2, xFrac, inXPeriod)
+ else
+ call getLinearCoeffs(x, inX, inNx, xInd1, xInd2, xFrac)
+ end if
+
+ ! if we're not extrapolating, limit xFrac
+ if(present(extrapX)) then
+ if(.not. extrapX) then
+ xFrac = min(1.0_RKIND,max(0.0_RKIND,xFrac))
+ end if
+ else
+ ! by default, we don't extrapolate
+ xFrac = min(1.0_RKIND,max(0.0_RKIND,xFrac))
+ end if
+
+ if(present(inYPeriod)) then
+ call getLinearCoeffs(y, inY, inNy, yInd1, yInd2, yFrac, inYPeriod)
+ else
+ call getLinearCoeffs(y, inY, inNy, yInd1, yInd2, yFrac)
+ end if
+
+ ! if we're not extrapolating, limit yFrac
+ if(present(extrapY)) then
+ if(.not. extrapY) then
+ yFrac = min(1.0_RKIND,max(0.0_RKIND,yFrac))
+ end if
+ else
+ ! by default, we don't extrapolate
+ yFrac = min(1.0_RKIND,max(0.0_RKIND,yFrac))
+ end if
+
+ outField(:,outIndex) = &
+ (1.0_RKIND-xFrac)*(1.0_RKIND-yFrac)*inField(xInd1,yInd1,:) &
+ + xFrac*(1.0_RKIND-yFrac)*inField(xInd2,yInd1,:) &
+ + (1.0_RKIND-xFrac)*yFrac*inField(xInd1,yInd2,:) &
+ + xFrac*yFrac*inField(xInd2,yInd2,:)
+ end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_interpolation_bilinear_horiz_3D!}}}
+
+!***********************************************************************
+!
+! routine getLinearCoeffs
+!
+!> \brief compute coefficients for linear interpolation
+!> \author Xylar Asay-Davis
+!> \date 10/30/2015
+!> \details
+!> Given a point and an array of locations, returns the indices
+!> the point is bounded by, as a fraction, where the point lies
+!> between the nearest two points in array of locations.
+!> Optional parameter period is used to indicate that the array
+!> of locations is periodic with the given period.
+
+!-----------------------------------------------------------------------
+
+ subroutine getLinearCoeffs(xValue, xArray, nx, index1, index2, frac, period)!{{{
+
+ integer, intent(in) :: nx
+ real (kind=RKIND), intent(in) :: xValue
+ real (kind=RKIND), dimension(nx), intent(in) :: xArray
+ integer, intent(out) :: index1, index2
+ real (kind=RKIND), intent(out) :: frac
+ real (kind=RKIND), intent(in), optional :: period
+
+ integer :: xIndex
+ real (kind=RKIND) :: x
+
+ x = xValue
+
+ if(present(period)) then
+ ! Set up bilinear interpolation indices in x, watching for periodic boundary
+ ! shift x to be within the range of [xArray(1),xArray(1)+period)
+ x = modulo(x-xArray(1),period) + xArray(1)
+ if (x >= xArray(nx)) then
+ ! at the periodic boundary so treat as special case
+ index1 = nx
+ index2 = 1
+ frac = (x-xArray(index1))/(xArray(index2)+period-xArray(index1))
+ else
+ do xIndex = 1, nx-1
+ if (x .le. xArray(xIndex+1)) then
+ index1 = xIndex
+ index2 = xIndex+1
+ frac = (x-xArray(index1))/(xArray(index2)-xArray(index1))
+ exit
+ end if
+ end do
+ end if
+ else
+ ! not periodic
+ index1 = nx-1
+ do xIndex = 1, nx-2
+ if (x .le. xArray(xIndex+1)) then
+ index1 = xIndex
+ exit
+ end if
+ end do
+ index2 = index1+1
+ frac = (x-xArray(index1))/(xArray(index2)-xArray(index1))
+ end if
+
+ end subroutine getLinearCoeffs!}}}
+
+
+!***********************************************************************
+
+end module ocn_init_interpolation
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_iso.F b/src/core_ocean/mode_init/mpas_ocn_init_iso.F
new file mode 100644
index 0000000000..50c43d4ba9
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_iso.F
@@ -0,0 +1,905 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_iso
+!
+!> \brief MPAS ocean initialize case -- Idealized Southern Ocean (ISO)
+!> \author Juan A. Saenz, based on idealized_acc and others
+!> \date 12/08/2014
+!> \details
+!> This module contains the routines for initializing the
+!> the idealized Southern Ocean (ISO) test case
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_iso
+
+ use mpas_kind_types
+ use mpas_io_units
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+
+ use ocn_constants
+ use ocn_init_vertical_grids
+ use ocn_init_cell_markers
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_setup_iso, &
+ ocn_init_validate_iso
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_setup_iso
+!
+!> \brief Setup for ISO test case
+!> \author Juan A. Saenz
+!> \date 02/26/2014
+!> \details
+!> This routine sets up the initial conditions for the
+!> Idealized Southern Ocean configuration.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_iso(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ ! local work variables
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool, verticalMeshPool, statePool, forcingPool, tracersPool
+ type (mpas_pool_type), pointer :: tracersSurfaceRestoringFieldsPool, tracersInteriorRestoringFieldsPool
+
+ integer :: iCell, k, idx
+
+ real (kind=RKIND) :: distance, xDistance, yDistance, zMid, sphereRadius
+ real (kind=RKIND) :: currentLon, currentLat
+ real (kind=RKIND) :: location, amplitude
+ real (kind=RKIND) :: Tbottom, Tmin, TminGlobal
+ real (kind=RKIND) :: depth, contSlopeWidthRad, widthWindASFRad, windStress
+ real (kind=RKIND) :: widthQSouth, widthQMiddle, widthQNorth, heatFluxZonal, heatFlux1, heatFlux2
+ real (kind=RKIND) :: temperature
+ real (kind=RKIND), dimension(30) :: featureDepth
+
+ real (kind=RKIND), dimension(:), pointer :: interfaceLocations
+
+
+ ! Define config variable pointers
+ character (len=StrKIND), pointer :: config_init_configuration, config_vertical_grid
+
+ integer, pointer :: config_iso_vert_levels
+ real (kind=RKIND), pointer :: config_iso_main_channel_depth
+ real (kind=RKIND), pointer :: config_iso_north_wall_lat
+ real (kind=RKIND), pointer :: config_iso_south_wall_lat
+ logical, pointer :: config_iso_ridge_flag
+ real (kind=RKIND), pointer :: config_iso_ridge_center_lon
+ real (kind=RKIND), pointer :: config_iso_ridge_height
+ real (kind=RKIND), pointer :: config_iso_ridge_width
+ logical, pointer :: config_iso_plateau_flag
+ real (kind=RKIND), pointer :: config_iso_plateau_center_lon
+ real (kind=RKIND), pointer :: config_iso_plateau_center_lat
+ real (kind=RKIND), pointer :: config_iso_plateau_height
+ real (kind=RKIND), pointer :: config_iso_plateau_radius
+ real (kind=RKIND), pointer :: config_iso_plateau_slope_width
+ logical, pointer :: config_iso_shelf_flag
+ real (kind=RKIND), pointer :: config_iso_shelf_depth
+ real (kind=RKIND), pointer :: config_iso_shelf_width
+ logical, pointer :: config_iso_cont_slope_flag
+ real (kind=RKIND), pointer :: config_iso_max_cont_slope
+ logical, pointer :: config_iso_embayment_flag
+ real (kind=RKIND), pointer :: config_iso_embayment_radius
+ real (kind=RKIND), pointer :: config_iso_embayment_depth
+ real (kind=RKIND), pointer :: config_iso_embayment_center_lon
+ real (kind=RKIND), pointer :: config_iso_embayment_center_lat
+ logical, pointer :: config_iso_depression_flag
+ real (kind=RKIND), pointer :: config_iso_depression_width
+ real (kind=RKIND), pointer :: config_iso_depression_depth
+ real (kind=RKIND), pointer :: config_iso_depression_center_lon
+ real (kind=RKIND), pointer :: config_iso_depression_south_lat
+ real (kind=RKIND), pointer :: config_iso_depression_north_lat
+ real (kind=RKIND), pointer :: config_iso_salinity
+ real (kind=RKIND), pointer :: config_iso_wind_stress_max
+ real (kind=RKIND), pointer :: config_iso_asf_wind
+ real (kind=RKIND), pointer :: config_iso_acc_wind
+ real (kind=RKIND), pointer :: config_iso_wind_trans
+ real (kind=RKIND), pointer :: config_iso_heat_flux_south
+ real (kind=RKIND), pointer :: config_iso_heat_flux_middle
+ real (kind=RKIND), pointer :: config_iso_heat_flux_north
+ real (kind=RKIND), pointer :: config_iso_heat_flux_lat_ss
+ real (kind=RKIND), pointer :: config_iso_heat_flux_lat_sm
+ real (kind=RKIND), pointer :: config_iso_heat_flux_lat_mn
+ real (kind=RKIND), pointer :: config_iso_surface_temperature_piston_velocity
+ real (kind=RKIND), pointer :: config_iso_initial_temp_t1
+ real (kind=RKIND), pointer :: config_iso_initial_temp_t2
+ real (kind=RKIND), pointer :: config_iso_initial_temp_h0
+ real (kind=RKIND), pointer :: config_iso_initial_temp_h1
+ real (kind=RKIND), pointer :: config_iso_initial_temp_mt
+ real (kind=RKIND), pointer :: config_iso_initial_temp_latS
+ real (kind=RKIND), pointer :: config_iso_initial_temp_latN
+ real (kind=RKIND), pointer :: config_iso_region1_center_lon
+ real (kind=RKIND), pointer :: config_iso_region1_center_lat
+ real (kind=RKIND), pointer :: config_iso_region2_center_lon
+ real (kind=RKIND), pointer :: config_iso_region2_center_lat
+ real (kind=RKIND), pointer :: config_iso_region3_center_lon
+ real (kind=RKIND), pointer :: config_iso_region3_center_lat
+ real (kind=RKIND), pointer :: config_iso_region4_center_lon
+ real (kind=RKIND), pointer :: config_iso_region4_center_lat
+ logical, pointer :: config_iso_heat_flux_region1_flag
+ real (kind=RKIND), pointer :: config_iso_heat_flux_region1
+ real (kind=RKIND), pointer :: config_iso_heat_flux_region1_radius
+ logical, pointer :: config_iso_heat_flux_region2_flag
+ real (kind=RKIND), pointer :: config_iso_heat_flux_region2
+ real (kind=RKIND), pointer :: config_iso_heat_flux_region2_radius
+ real (kind=RKIND), pointer :: config_iso_temperature_sponge_t1
+ real (kind=RKIND), pointer :: config_iso_temperature_sponge_h1
+ real (kind=RKIND), pointer :: config_iso_temperature_sponge_l1
+ real (kind=RKIND), pointer :: config_iso_temperature_sponge_tau1
+
+ logical, pointer :: config_iso_temperature_restore_region1_flag
+ real (kind=RKIND), pointer :: config_iso_temperature_restore_t1
+ real (kind=RKIND), pointer :: config_iso_temperature_restore_lcx1
+ real (kind=RKIND), pointer :: config_iso_temperature_restore_lcy1
+ logical, pointer :: config_iso_temperature_restore_region2_flag
+ real (kind=RKIND), pointer :: config_iso_temperature_restore_t2
+ real (kind=RKIND), pointer :: config_iso_temperature_restore_lcx2
+ real (kind=RKIND), pointer :: config_iso_temperature_restore_lcy2
+ logical, pointer :: config_iso_temperature_restore_region3_flag
+ real (kind=RKIND), pointer :: config_iso_temperature_restore_t3
+ real (kind=RKIND), pointer :: config_iso_temperature_restore_lcx3
+ real (kind=RKIND), pointer :: config_iso_temperature_restore_lcy3
+ logical, pointer :: config_iso_temperature_restore_region4_flag
+ real (kind=RKIND), pointer :: config_iso_temperature_restore_t4
+ real (kind=RKIND), pointer :: config_iso_temperature_restore_lcx4
+ real (kind=RKIND), pointer :: config_iso_temperature_restore_lcy4
+
+ ! Define dimension pointers
+ integer, pointer :: nVertLevels, nCells, nVertLevelsP1
+ integer, pointer :: index_temperature, index_salinity, index_tracer1
+
+ ! Define variable pointers
+ logical, pointer :: on_a_sphere
+ integer, dimension(:), pointer :: maxLevelCell
+ real (kind=RKIND), dimension(:), pointer :: refBottomDepth, bottomCell, refZMid
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness, restingThickness
+ real (kind=RKIND), pointer :: sphere_radius
+ real (kind=RKIND), dimension(:), pointer :: lonCell, latCell, bottomDepth
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers, debugTracers
+ real (kind=RKIND), dimension(:), pointer :: sensibleHeatFlux
+ real (kind=RKIND), dimension(:), pointer :: windStressZonal, windStressMeridional
+ real (kind=RKIND), dimension(:, :), pointer :: activeTracersPistonVelocity, activeTracersSurfaceRestoringValue
+ real (kind=RKIND), dimension(:, :, :), pointer :: activeTracersInteriorRestoringValue, activeTracersInteriorRestoringRate
+
+ ! Define variables for the config_iso_ variables
+ real (kind=RKIND) :: mainChannelDepth, northWallLat, southWallLat
+ logical :: ridgeFlag
+ real (kind=RKIND) :: ridgeCenterLon, ridgeHeight, ridgeWidth
+ logical :: plateauFlag
+ real (kind=RKIND) :: plateauCenterLon, plateauCenterLat
+ real (kind=RKIND) :: plateauHeight, plateauRadius, plateauSlopeWidth
+ logical :: shelfFlag
+ real (kind=RKIND) :: shelfDepth, shelfWidth
+ logical :: contSlopeFlag
+ real (kind=RKIND) :: maxContSlope
+ logical :: embaymentFlag
+ real (kind=RKIND) :: embaymentRadius, embaymentDepth, embaymentCenterLon, embaymentCenterLat
+ logical :: depressionFlag
+ real (kind=RKIND) :: depressionWidth, depressionDepth
+ real (kind=RKIND) :: depressionCenterLon, depressionSouthLat, depressionNorthLat
+ real (kind=RKIND) :: salinity0
+ real (kind=RKIND) :: windStressMax, windASF, windACC, latWindTrans
+ real (kind=RKIND) :: QSouth, QNorth, QMiddle, transSS, transSM, transMN
+ real (kind=RKIND) :: tempPistonVel, tempT1, tempT2, temph1, tempmT, temph0, tempLatS, tempLatN
+ real (kind=RKIND) :: regionCenterLat1, regionCenterLon1, regionCenterLat2, regionCenterLon2
+ real (kind=RKIND) :: regionCenterLat3, regionCenterLon3, regionCenterLat4, regionCenterLon4
+ logical :: heatRegionFlag1
+ real (kind=RKIND) :: heatRegion1flux, heatRegion1Radius
+ logical :: heatRegionFlag2
+ real (kind=RKIND) :: heatRegion2flux, heatRegion2Radius
+ real (kind=RKIND) :: tempSpongeT1, tempSpongeh1, tempSpongeWeightL1, tempSpongeTau1
+ logical :: tempRestoreFlag1
+ real (kind=RKIND) :: tempRestoreT1, tempRestoreLcx1, tempRestoreLcy1
+ logical :: tempRestoreFlag2
+ real (kind=RKIND) :: tempRestoreT2, tempRestoreLcx2, tempRestoreLcy2
+ logical :: tempRestoreFlag3
+ real (kind=RKIND) :: tempRestoreT3, tempRestoreLcx3, tempRestoreLcy3
+ logical :: tempRestoreFlag4
+ real (kind=RKIND) :: tempRestoreT4, tempRestoreLcx4, tempRestoreLcy4
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_init_configuration', config_init_configuration)
+ if(config_init_configuration .ne. trim('iso')) return
+
+ ! get config variables
+ call mpas_pool_get_config(domain % configs, 'config_vertical_grid', config_vertical_grid)
+ call mpas_pool_get_config(domain % configs, 'config_iso_vert_levels', config_iso_vert_levels)
+ call mpas_pool_get_config(domain % configs, 'config_iso_main_channel_depth', config_iso_main_channel_depth)
+ call mpas_pool_get_config(domain % configs, 'config_iso_north_wall_lat', config_iso_north_wall_lat)
+ call mpas_pool_get_config(domain % configs, 'config_iso_south_wall_lat', config_iso_south_wall_lat)
+ call mpas_pool_get_config(domain % configs, 'config_iso_ridge_flag', config_iso_ridge_flag)
+ call mpas_pool_get_config(domain % configs, 'config_iso_ridge_center_lon', config_iso_ridge_center_lon)
+ call mpas_pool_get_config(domain % configs, 'config_iso_ridge_height', config_iso_ridge_height)
+ call mpas_pool_get_config(domain % configs, 'config_iso_ridge_width', config_iso_ridge_width)
+ call mpas_pool_get_config(domain % configs, 'config_iso_plateau_flag', config_iso_plateau_flag)
+ call mpas_pool_get_config(domain % configs, 'config_iso_plateau_center_lon', config_iso_plateau_center_lon)
+ call mpas_pool_get_config(domain % configs, 'config_iso_plateau_center_lat', config_iso_plateau_center_lat)
+ call mpas_pool_get_config(domain % configs, 'config_iso_plateau_height', config_iso_plateau_height)
+ call mpas_pool_get_config(domain % configs, 'config_iso_plateau_radius', config_iso_plateau_radius)
+ call mpas_pool_get_config(domain % configs, 'config_iso_plateau_slope_width', config_iso_plateau_slope_width)
+ call mpas_pool_get_config(domain % configs, 'config_iso_shelf_flag', config_iso_shelf_flag)
+ call mpas_pool_get_config(domain % configs, 'config_iso_shelf_depth', config_iso_shelf_depth)
+ call mpas_pool_get_config(domain % configs, 'config_iso_shelf_width', config_iso_shelf_width)
+ call mpas_pool_get_config(domain % configs, 'config_iso_cont_slope_flag', config_iso_cont_slope_flag)
+ call mpas_pool_get_config(domain % configs, 'config_iso_max_cont_slope', config_iso_max_cont_slope)
+ call mpas_pool_get_config(domain % configs, 'config_iso_embayment_flag', config_iso_embayment_flag)
+ call mpas_pool_get_config(domain % configs, 'config_iso_embayment_radius', config_iso_embayment_radius)
+ call mpas_pool_get_config(domain % configs, 'config_iso_embayment_depth', config_iso_embayment_depth)
+ call mpas_pool_get_config(domain % configs, 'config_iso_embayment_center_lon', config_iso_embayment_center_lon)
+ call mpas_pool_get_config(domain % configs, 'config_iso_embayment_center_lat', config_iso_embayment_center_lat)
+ call mpas_pool_get_config(domain % configs, 'config_iso_depression_flag', config_iso_depression_flag)
+ call mpas_pool_get_config(domain % configs, 'config_iso_depression_width', config_iso_depression_width)
+ call mpas_pool_get_config(domain % configs, 'config_iso_depression_depth', config_iso_depression_depth)
+ call mpas_pool_get_config(domain % configs, 'config_iso_depression_center_lon', config_iso_depression_center_lon)
+ call mpas_pool_get_config(domain % configs, 'config_iso_depression_south_lat', config_iso_depression_south_lat)
+ call mpas_pool_get_config(domain % configs, 'config_iso_depression_north_lat', config_iso_depression_north_lat)
+ call mpas_pool_get_config(domain % configs, 'config_iso_salinity', config_iso_salinity)
+ call mpas_pool_get_config(domain % configs, 'config_iso_wind_stress_max', config_iso_wind_stress_max)
+ call mpas_pool_get_config(domain % configs, 'config_iso_asf_wind', config_iso_asf_wind)
+ call mpas_pool_get_config(domain % configs, 'config_iso_acc_wind', config_iso_acc_wind)
+ call mpas_pool_get_config(domain % configs, 'config_iso_wind_trans', config_iso_wind_trans)
+ call mpas_pool_get_config(domain % configs, 'config_iso_heat_flux_south', config_iso_heat_flux_south)
+ call mpas_pool_get_config(domain % configs, 'config_iso_heat_flux_middle', config_iso_heat_flux_middle)
+ call mpas_pool_get_config(domain % configs, 'config_iso_heat_flux_north', config_iso_heat_flux_north)
+ call mpas_pool_get_config(domain % configs, 'config_iso_heat_flux_lat_ss', config_iso_heat_flux_lat_ss)
+ call mpas_pool_get_config(domain % configs, 'config_iso_heat_flux_lat_sm', config_iso_heat_flux_lat_sm)
+ call mpas_pool_get_config(domain % configs, 'config_iso_heat_flux_lat_mn', config_iso_heat_flux_lat_mn)
+ call mpas_pool_get_config(domain % configs, 'config_iso_surface_temperature_piston_velocity', &
+ config_iso_surface_temperature_piston_velocity)
+ call mpas_pool_get_config(domain % configs, 'config_iso_initial_temp_t1', config_iso_initial_temp_t1)
+ call mpas_pool_get_config(domain % configs, 'config_iso_initial_temp_t2', config_iso_initial_temp_t2)
+ call mpas_pool_get_config(domain % configs, 'config_iso_initial_temp_h0', config_iso_initial_temp_h0)
+ call mpas_pool_get_config(domain % configs, 'config_iso_initial_temp_h1', config_iso_initial_temp_h1)
+ call mpas_pool_get_config(domain % configs, 'config_iso_initial_temp_mt', config_iso_initial_temp_mt)
+ call mpas_pool_get_config(domain % configs, 'config_iso_initial_temp_latS', config_iso_initial_temp_latS)
+ call mpas_pool_get_config(domain % configs, 'config_iso_initial_temp_latN', config_iso_initial_temp_latN)
+ call mpas_pool_get_config(domain % configs, 'config_iso_region1_center_lon', config_iso_region1_center_lon)
+ call mpas_pool_get_config(domain % configs, 'config_iso_region1_center_lat', config_iso_region1_center_lat)
+ call mpas_pool_get_config(domain % configs, 'config_iso_region2_center_lon', config_iso_region2_center_lon)
+ call mpas_pool_get_config(domain % configs, 'config_iso_region2_center_lat', config_iso_region2_center_lat)
+ call mpas_pool_get_config(domain % configs, 'config_iso_region3_center_lon', config_iso_region3_center_lon)
+ call mpas_pool_get_config(domain % configs, 'config_iso_region3_center_lat', config_iso_region3_center_lat)
+ call mpas_pool_get_config(domain % configs, 'config_iso_region4_center_lon', config_iso_region4_center_lon)
+ call mpas_pool_get_config(domain % configs, 'config_iso_region4_center_lat', config_iso_region4_center_lat)
+ call mpas_pool_get_config(domain % configs, 'config_iso_heat_flux_region1_flag', config_iso_heat_flux_region1_flag)
+ call mpas_pool_get_config(domain % configs, 'config_iso_heat_flux_region1', config_iso_heat_flux_region1)
+ call mpas_pool_get_config(domain % configs, 'config_iso_heat_flux_region1_radius', config_iso_heat_flux_region1_radius)
+ call mpas_pool_get_config(domain % configs, 'config_iso_heat_flux_region2_flag', config_iso_heat_flux_region2_flag)
+ call mpas_pool_get_config(domain % configs, 'config_iso_heat_flux_region2', config_iso_heat_flux_region2)
+ call mpas_pool_get_config(domain % configs, 'config_iso_heat_flux_region2_radius', config_iso_heat_flux_region2_radius)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_sponge_t1', config_iso_temperature_sponge_t1)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_sponge_h1', config_iso_temperature_sponge_h1)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_sponge_l1', config_iso_temperature_sponge_l1)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_sponge_tau1', config_iso_temperature_sponge_tau1)
+
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_restore_region1_flag', &
+ config_iso_temperature_restore_region1_flag)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_restore_t1', config_iso_temperature_restore_t1)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_restore_lcx1', config_iso_temperature_restore_lcx1)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_restore_lcy1', config_iso_temperature_restore_lcy1)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_restore_region2_flag', &
+ config_iso_temperature_restore_region2_flag)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_restore_t2', config_iso_temperature_restore_t2)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_restore_lcx2', config_iso_temperature_restore_lcx2)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_restore_lcy2', config_iso_temperature_restore_lcy2)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_restore_region3_flag', &
+ config_iso_temperature_restore_region3_flag)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_restore_t3', config_iso_temperature_restore_t3)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_restore_lcx3', config_iso_temperature_restore_lcx3)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_restore_lcy3', config_iso_temperature_restore_lcy3)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_restore_region4_flag', &
+ config_iso_temperature_restore_region4_flag)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_restore_t4', config_iso_temperature_restore_t4)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_restore_lcx4', config_iso_temperature_restore_lcx4)
+ call mpas_pool_get_config(domain % configs, 'config_iso_temperature_restore_lcy4', config_iso_temperature_restore_lcy4)
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevelsP1', nVertLevelsP1)
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+ call mpas_pool_get_config(meshPool, 'sphere_radius', sphere_radius)
+ sphereRadius = sphere_radius
+
+
+ if(.not. on_a_sphere) then
+ write(stderrUnit, *) 'ERROR: ISO test case can only be defined on a spherical mesh.'
+ iErr = 1
+ return
+ else
+ write(stderrUnit, *) 'ISO test case using spherical radius of size: ', sphereRadius
+ end if
+
+ ! Define interface locations
+ allocate( interfaceLocations( nVertLevelsP1 ) )
+ call ocn_generate_vertical_grid( config_vertical_grid, interfaceLocations, domain % configs )
+
+ ! assign config variables
+ nVertLevels = config_iso_vert_levels
+ mainChannelDepth = config_iso_main_channel_depth
+ northWallLat = config_iso_north_wall_lat * pii/180.0_RKIND
+ southWallLat = config_iso_south_wall_lat * pii/180.0_RKIND
+ ridgeFlag = config_iso_ridge_flag
+ ridgeCenterLon = config_iso_ridge_center_lon * pii/180.0_RKIND
+ ridgeHeight = config_iso_ridge_height
+ ridgeWidth = config_iso_ridge_width
+ plateauFlag = config_iso_plateau_flag
+ plateauCenterLon = config_iso_plateau_center_lon * pii/180.0_RKIND
+ plateauCenterLat = config_iso_plateau_center_lat * pii/180.0_RKIND
+ plateauHeight = config_iso_plateau_height
+ plateauRadius = config_iso_plateau_radius
+ plateauSlopeWidth = config_iso_plateau_slope_width
+ shelfFlag = config_iso_shelf_flag
+ shelfDepth = config_iso_shelf_depth
+ shelfWidth = config_iso_shelf_width
+ contSlopeFlag = config_iso_cont_slope_flag
+ maxContSlope = config_iso_max_cont_slope
+ embaymentFlag = config_iso_embayment_flag
+ embaymentRadius = config_iso_embayment_radius
+ embaymentDepth = config_iso_embayment_depth
+ embaymentCenterLon = config_iso_embayment_center_lon * pii/180.0_RKIND
+ embaymentCenterLat = config_iso_embayment_center_lat * pii/180.0_RKIND
+ depressionFlag = config_iso_depression_flag
+ depressionWidth = config_iso_depression_width
+ depressionDepth = config_iso_depression_depth
+ depressionCenterLon = config_iso_depression_center_lon * pii/180.0_RKIND
+ depressionSouthLat = config_iso_depression_south_lat * pii/180.0_RKIND
+ depressionNorthLat = config_iso_depression_north_lat * pii/180.0_RKIND
+ salinity0 = config_iso_salinity
+ windStressMax = config_iso_wind_stress_max
+ windASF = config_iso_asf_wind
+ windACC = config_iso_acc_wind
+ latWindTrans = config_iso_wind_trans * pii/180.0_RKIND
+ QSouth = config_iso_heat_flux_south
+ QMiddle = config_iso_heat_flux_middle
+ QNorth = config_iso_heat_flux_north
+ transSS = config_iso_heat_flux_lat_ss * pii/180.0_RKIND
+ transSM = config_iso_heat_flux_lat_sm * pii/180.0_RKIND
+ transMN = config_iso_heat_flux_lat_mn * pii/180.0_RKIND
+ tempPistonVel = config_iso_surface_temperature_piston_velocity
+ tempT1 = config_iso_initial_temp_t1
+ tempT2 = config_iso_initial_temp_t2
+ temph0 = config_iso_initial_temp_h0
+ temph1 = config_iso_initial_temp_h1
+ tempmT = config_iso_initial_temp_mt
+ tempLatS = config_iso_initial_temp_latS * pii/180.0_RKIND
+ tempLatN = config_iso_initial_temp_latN * pii/180.0_RKIND
+ regionCenterLon1 = config_iso_region1_center_lon * pii/180.0_RKIND
+ regionCenterLat1 = config_iso_region1_center_lat * pii/180.0_RKIND
+ regionCenterLon2 = config_iso_region2_center_lon * pii/180.0_RKIND
+ regionCenterLat2 = config_iso_region2_center_lat * pii/180.0_RKIND
+ regionCenterLon3 = config_iso_region3_center_lon * pii/180.0_RKIND
+ regionCenterLat3 = config_iso_region3_center_lat * pii/180.0_RKIND
+ regionCenterLon4 = config_iso_region4_center_lon * pii/180.0_RKIND
+ regionCenterLat4 = config_iso_region4_center_lat * pii/180.0_RKIND
+ heatRegionFlag1 = config_iso_heat_flux_region1_flag
+ heatRegion1flux = config_iso_heat_flux_region1
+ heatRegion1Radius = config_iso_heat_flux_region1_radius
+ heatRegionFlag2 = config_iso_heat_flux_region2_flag
+ heatRegion2flux = config_iso_heat_flux_region2
+ heatRegion2Radius = config_iso_heat_flux_region2_radius
+ tempSpongeT1 = config_iso_temperature_sponge_t1
+ tempSpongeh1 = config_iso_temperature_sponge_h1
+ tempSpongeWeightL1 = config_iso_temperature_sponge_l1
+ tempSpongeTau1 = config_iso_temperature_sponge_tau1
+
+ tempRestoreFlag1 = config_iso_temperature_restore_region1_flag
+ tempRestoreT1 = config_iso_temperature_restore_t1
+ tempRestoreLcx1 = config_iso_temperature_restore_lcx1
+ tempRestoreLcy1 = config_iso_temperature_restore_lcy1
+ tempRestoreFlag2 = config_iso_temperature_restore_region2_flag
+ tempRestoreT2 = config_iso_temperature_restore_t2
+ tempRestoreLcx2 = config_iso_temperature_restore_lcx2
+ tempRestoreLcy2 = config_iso_temperature_restore_lcy2
+ tempRestoreFlag3 = config_iso_temperature_restore_region3_flag
+ tempRestoreT3 = config_iso_temperature_restore_t3
+ tempRestoreLcx3 = config_iso_temperature_restore_lcx3
+ tempRestoreLcy3 = config_iso_temperature_restore_lcy3
+ tempRestoreFlag4 = config_iso_temperature_restore_region4_flag
+ tempRestoreT4 = config_iso_temperature_restore_t4
+ tempRestoreLcx4 = config_iso_temperature_restore_lcx4
+ tempRestoreLcy4 = config_iso_temperature_restore_lcy4
+
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Setup the vertical grid
+ !!!!!!!!!!!!!!!!!!!!!!!!!
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_array(verticalMeshPool, 'restingThickness', restingThickness)
+ call mpas_pool_get_array(verticalMeshPool, 'refZMid', refZMid)
+
+ ! Set layerThickness and restingThickness
+ do k = 1, nVertLevels
+ layerThickness(k, :) = config_iso_main_channel_depth * ( interfaceLocations(k+1) - interfaceLocations(k) )
+ restingThickness(k, :) = layerThickness(k, :)
+ end do
+
+ ! Set refBottomDepth
+ do k = 1, nVertLevels
+ refBottomDepth(k) = config_iso_main_channel_depth * interfaceLocations(k+1)
+ refZMid(k) = -config_iso_main_channel_depth * (interfaceLocations(k)+interfaceLocations(k+1))/2.0_RKIND
+ end do
+
+ block_ptr => block_ptr % next
+
+ end do
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Set Topography
+ !!!!!!!!!!!!!!!!!!!!!!!!!
+ write(*,*) 'setting up topography'
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_array(meshPool, 'lonCell', lonCell)
+ call mpas_pool_get_array(meshPool, 'latCell', latCell)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+
+ ! calculate the width of the continental slope,
+ ! based on the specified max value of the slope of the continental slope, maxContSlope
+ contSlopeWidthRad = &
+ pii * 0.5_RKIND * (-shelfDepth + mainChannelDepth) / maxContSlope / sphereRadius
+
+ do iCell = 1, nCells
+ currentLon = lonCell(iCell)
+ currentLat = latCell(iCell)
+
+ bottomDepth(iCell) = 0.0_RKIND
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Main channel
+ if (currentLat <= northWallLat .and. currentLat >= southWallLat) then
+ bottomDepth(iCell) = mainChannelDepth
+ endif
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!
+ ! set up fill-in features
+ featureDepth = 1.0E6_RKIND
+
+ ! feature 1: Add Ridge
+ if (ridgeFlag) then
+ distance = (currentLon - ridgeCenterLon) &
+ *sphereRadius*cos(currentLat)
+ if ( abs(distance) <= 0.6_RKIND * ridgeWidth ) then
+ featureDepth(1) = mainChannelDepth - &
+ ridgeHeight * exp(-2.0_RKIND*(distance / ridgeWidth / 0.4_RKIND)**2)
+ endif
+ endif
+
+ ! feature 2: Add Plateau
+ if (plateauFlag) then
+ distance = sqrt( &
+ ( (currentLon - plateauCenterLon) * sphereRadius*cos(currentLat) )**2 &
+ + ( (currentLat - plateauCenterLat) * sphereRadius )**2 &
+ )
+ if (abs(distance) <= plateauRadius) then
+ featureDepth(2) = mainChannelDepth - plateauHeight
+ else if (abs(distance) > plateauRadius .and. abs(distance) < plateauSlopeWidth) then
+ featureDepth(2) = mainChannelDepth - plateauHeight * &
+ exp( -2 * ( (abs(distance)-plateauRadius) / plateauSlopeWidth / 0.4_RKIND ) **2 )
+ endif
+ endif
+
+ ! feature 3: Add continental slope, or continental shelf break
+ if (contSlopeFlag) then
+ zMid = 0.5_RKIND*(mainChannelDepth+shelfDepth)
+ amplitude = 0.5_RKIND*(-shelfDepth+mainChannelDepth)
+ if (currentLat <= southWallLat + contSlopeWidthRad&
+ .and. currentLat > southWallLat) then
+ featureDepth(3) = zMid - amplitude * sin( 0.5_RKIND*pii + pii/contSlopeWidthRad &
+ *(currentLat-southWallLat) )
+ endif
+ endif
+
+ ! choose the shallowest
+ bottomDepth(iCell) = min(minval(featureDepth), bottomDepth(iCell))
+
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Set up dig-out features
+ featureDepth = 0.0_RKIND
+
+ ! feature 1: Continental shelf
+ if (shelfFlag) then
+ if (currentLat <= southWallLat .and. currentLat >= southWallLat-shelfWidth/sphereRadius) then
+ featureDepth(1) = shelfDepth
+ endif
+ endif
+
+ ! feature 2: Embayment
+ if (embaymentFlag) then
+ distance = sqrt( &
+ ( (currentLon - embaymentCenterLon) * sphereRadius*cos(currentLat) )**2 &
+ + ( (currentLat - embaymentCenterLat) * sphereRadius )**2 &
+ )
+ if(distance <= embaymentRadius .and. currentLat < embaymentCenterLat) then
+ featureDepth(2) = embaymentDepth
+ endif
+ endif
+
+ ! feature 3: depression
+ if (depressionFlag) then
+ distance = (currentLon - depressionCenterLon) * sphereRadius*cos(currentLat)
+ if( abs(distance) <= 0.5_RKIND*depressionWidth &
+ .and. currentLat >= depressionSouthLat .and. currentLat <= depressionNorthLat ) &
+ then
+ featureDepth(3) = depressionDepth
+ endif
+ endif
+
+ ! choose the deepest one
+ bottomDepth(iCell) = max(maxval(featureDepth), bottomDepth(iCell))
+
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Set maxLevelCell to -1 for cells to be culled
+ if (bottomDepth(iCell) > 0.0_RKIND) then
+ maxLevelCell(iCell) = 1
+ else
+ maxLevelCell(iCell) = -1
+ endif
+
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Determine maxLevelCell based on bottomDepth and refBottomDepth
+ ! Also set botomDepth based on refBottomDepth, since
+ ! above bottomDepth was set with continuous analytical functions,
+ ! and needs to be discrete
+ if (maxLevelCell(iCell) > 0) then
+ maxLevelCell(iCell) = nVertLevels
+ if (nVertLevels .gt. 1) then
+ do k = 1, nVertLevels
+ if (bottomDepth(iCell) < refBottomDepth(k) ) then
+ maxLevelCell(iCell) = k-1
+ bottomDepth(iCell) = refBottomDepth(k-1)
+ exit
+ end if
+ end do
+ end if
+ end if
+
+ enddo ! Looping through with iCell
+
+ block_ptr => block_ptr % next
+ enddo ! done setting topography
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! mark cells for culling
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ block_ptr => domain % blocklist
+ do while (associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call ocn_mark_maxlevelcell(meshPool, iErr)
+ block_ptr => block_ptr % next
+ end do
+
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Set forcing boundary conditions and initial conditions
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ write(*,*) 'setting up forcing and boundary conditions'
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_array(meshPool, 'lonCell', lonCell)
+ call mpas_pool_get_array(meshPool, 'latCell', latCell)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', index_temperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', index_salinity)
+ call mpas_pool_get_dimension(tracersPool, 'index_tracer1', index_tracer1)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+ call mpas_pool_get_array(tracersPool, 'debugTracers', debugTracers, 1)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_array(verticalMeshPool, 'refZMid', refZMid)
+ call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool)
+ call mpas_pool_get_array(forcingPool, 'sensibleHeatFlux', sensibleHeatFlux)
+ call mpas_pool_get_array(forcingPool, 'windStressZonal', windStressZonal)
+ call mpas_pool_get_array(forcingPool, 'windStressMeridional', windStressMeridional, 1)
+ call mpas_pool_get_subpool(forcingPool, 'tracersSurfaceRestoringFields', tracersSurfaceRestoringFieldsPool)
+ call mpas_pool_get_subpool(forcingPool, 'tracersInteriorRestoringFields', tracersInteriorRestoringFieldsPool)
+ call mpas_pool_get_array(tracersSurfaceRestoringFieldsPool, 'activeTracersPistonVelocity', activeTracersPistonVelocity, 1)
+ call mpas_pool_get_array(tracersSurfaceRestoringFieldsPool, 'activeTracersSurfaceRestoringValue', &
+ activeTracersSurfaceRestoringValue, 1)
+ call mpas_pool_get_array(tracersInteriorRestoringFieldsPool, 'activeTracersInteriorRestoringRate', &
+ activeTracersInteriorRestoringRate, 1)
+ call mpas_pool_get_array(tracersInteriorRestoringFieldsPool, 'activeTracersInteriorRestoringValue', &
+ activeTracersInteriorRestoringValue, 1)
+
+ activeTracersInteriorRestoringRate(:,:,:) = 0.0_RKIND
+ activeTracersInteriorRestoringValue(:,:,:) = 0.0_RKIND
+ activeTracersPistonVelocity(:,:) = 0.0_RKIND
+ activeTracersSurfaceRestoringValue(:,:) = 0.0_RKIND
+
+ do iCell = 1, nCells
+ currentLon = lonCell(iCell)
+ currentLat = latCell(iCell)
+
+ ! Set initial temperature
+ idx = index_temperature
+ do k = 1, nVertLevels
+ zMid = refZMid(k)
+ !temperature = tempT1 + tempT2*tanh(zMid/temph1) + tempmT * zMid
+ temperature = (tempT1 + tempT2*tanh((zMid+temph0)/temph1) + tempmT * zMid) &
+ * (-tempLatS+currentLat)*( 1.0_RKIND/(-tempLatS+tempLatN) )
+ activeTracers(idx, k, iCell) = temperature
+ enddo
+
+ ! Set initial salinity
+ idx = index_salinity
+ activeTracers(idx, :, iCell) = salinity0
+
+ ! Set up debugging tracers
+ idx = index_tracer1
+ if ( associated(debugTracers) ) then
+ debugTracers(idx, :, iCell) = 1.0_RKIND
+ end if
+
+ ! Heat fluxes
+ heatFluxZonal = 0.0_RKIND
+ heatFlux1 = 0.0_RKIND
+ heatFlux2 = 0.0_RKIND
+
+ ! Setup zonally constant surface heat fluxes
+ widthQSouth = transSM - transSS
+ widthQMiddle = transMN - transSM
+ widthQNorth = northWallLat - transMN
+ if (currentLat > transSS .and. currentLat < transSM) then
+ heatFluxZonal = QSouth*sin(pii*(currentLat-transSM)/widthQSouth)**2
+ elseif (currentLat > transSM .and. currentLat < transMN) then
+ heatFluxZonal = QMiddle*sin(pii*(currentLat-transMN)/widthQMiddle)**2
+ elseif (currentLat > transMN .and. currentLat < northWallLat) then
+ heatFluxZonal = QNorth*sin(pii*(currentLat-northWallLat)/widthQNorth)**2
+ endif
+
+ ! Setup heat flux over localized region 1
+ if (heatRegionFlag1) then
+ distance = sqrt( &
+ ( (currentLon - regionCenterLon1) * sphereRadius*cos(currentLat) )**2 &
+ + ( (currentLat - regionCenterLat1) * sphereRadius )**2 &
+ )
+ if (abs(distance) <= heatRegion1Radius) then
+ heatFlux1 = heatRegion1flux * exp(-2.0_RKIND*(distance / 2.0_RKIND / heatRegion1Radius / 0.4_RKIND)**2)
+ endif
+ endif
+ ! Setup heat flux over localized region 2
+ if (heatRegionFlag2) then
+ distance = sqrt( &
+ ( (currentLon - regionCenterLon2) * sphereRadius*cos(currentLat) )**2 &
+ + ( (currentLat - regionCenterLat2) * sphereRadius )**2 &
+ )
+ if (abs(distance) <= heatRegion2Radius) then
+ heatFlux2 = heatRegion2flux * exp(-2.0_RKIND*(distance / 2.0_RKIND / heatRegion2Radius / 0.4_RKIND)**2)
+ endif
+ endif
+
+ if (currentLat < transSM) then
+ sensibleHeatFlux(iCell) = min(heatFluxZonal, heatFlux1, heatFlux2)
+ else
+ sensibleHeatFlux(iCell) = heatFluxZonal
+ endif
+
+ ! Set interior restoring
+ do k = 1, nVertLevels
+ zMid = refZMid(k)
+
+ !Temperature
+ !Interior restoring along northern wall
+ distance = sphereRadius * ( currentLat - northWallLat)
+ if(abs(distance) <= 3.0_RKIND*tempSpongeWeightL1) then
+ idx = index_temperature
+ temperature = tempSpongeT1 * exp(zMid/tempSpongeh1)
+ activeTracersInteriorRestoringValue(idx, k, iCell) = temperature
+
+ idx = index_temperature
+ activeTracersInteriorRestoringRate(idx, k, iCell) = exp(-abs(distance)/tempSpongeWeightL1) * ( 1.0_RKIND &
+ / (tempSpongeTau1*86400.0_RKIND))
+ endif
+
+ ! Interior restoring at localized region 1
+ if (tempRestoreFlag1) then
+ xDistance = (currentLon - regionCenterLon1) * sphereRadius*cos(currentLat)
+ yDistance = (currentLat - regionCenterLat1) * sphereRadius
+ if (abs(yDistance) <= tempRestoreLcy1 .and. abs(xDistance) <= tempRestoreLcx1) then
+ idx = index_temperature
+ activeTracersInteriorRestoringValue(idx, k, iCell) = TempRestoreT1
+
+ idx = index_temperature
+ activeTracersInteriorRestoringRate(idx, k, iCell) = ( 1.0_RKIND / (tempSpongeTau1*86400.0_RKIND)) * &
+ exp(-(2.0_RKIND*xDistance/tempRestoreLcx1)**2 - (2.0_RKIND*yDistance/tempRestoreLcy1)**2 )
+ endif
+ endif
+
+ ! Interior restoring at localized region 2
+ if (tempRestoreFlag2) then
+ xDistance = (currentLon - regionCenterLon2) * sphereRadius*cos(currentLat)
+ yDistance = (currentLat - regionCenterLat2) * sphereRadius
+ if (abs(yDistance) <= tempRestoreLcy2 .and. abs(xDistance) <= tempRestoreLcx2) then
+ idx = index_temperature
+ activeTracersInteriorRestoringValue(idx, k, iCell) = TempRestoreT2
+
+ idx = index_temperature
+ activeTracersInteriorRestoringRate(idx, k, iCell) = ( 1.0_RKIND / (tempSpongeTau1*86400.0_RKIND)) * &
+ exp(-(2.0_RKIND*xDistance/tempRestoreLcx2)**2 - (2.0_RKIND*yDistance/tempRestoreLcy2)**2 )
+ endif
+ endif
+
+ ! Interior restoring at localized region 3
+ if (tempRestoreFlag3) then
+ xDistance = (currentLon - regionCenterLon3) * sphereRadius*cos(currentLat)
+ yDistance = (currentLat - regionCenterLat3) * sphereRadius
+ if (abs(yDistance) <= tempRestoreLcy3 .and. abs(xDistance) <= tempRestoreLcx3) then
+ idx = index_temperature
+ activeTracersInteriorRestoringValue(idx, k, iCell) = TempRestoreT3
+
+ idx = index_temperature
+ activeTracersInteriorRestoringRate(idx, k, iCell) = ( 1.0_RKIND / (tempSpongeTau1*86400.0_RKIND)) * &
+ exp(-(2.0_RKIND*xDistance/tempRestoreLcx3)**2 - (2.0_RKIND*yDistance/tempRestoreLcy3)**2 )
+ endif
+ endif
+
+ ! Interior restoring at localized region 4
+ if (tempRestoreFlag4) then
+ xDistance = (currentLon - regionCenterLon4) * sphereRadius*cos(currentLat)
+ yDistance = (currentLat - regionCenterLat4) * sphereRadius
+ if (abs(yDistance) <= tempRestoreLcy4 .and. abs(xDistance) <= tempRestoreLcx4) then
+ idx = index_temperature
+ activeTracersInteriorRestoringValue(idx, k, iCell) = TempRestoreT4
+
+ idx = index_temperature
+ activeTracersInteriorRestoringRate(idx, k, iCell) = ( 1.0_RKIND / (tempSpongeTau1*86400.0_RKIND)) * &
+ exp(-(2.0_RKIND*xDistance/tempRestoreLcx4)**2 - (2.0_RKIND*yDistance/tempRestoreLcy4)**2 )
+ endif
+ endif
+
+ ! Salinity
+ idx = index_salinity
+ activeTracersInteriorRestoringValue(idx, k, iCell) = salinity0
+ idx = index_salinity
+ activeTracersInteriorRestoringRate(idx, k, iCell) = 0.0_RKIND
+
+ enddo ! k = 1, nVertLevels, interior restoring loop
+
+
+ end do ! iCell = 1, nCells
+
+ ! fill activeTracersSurfaceRestoringValue surface restoring values
+ ! fill activeTracersPistonVelocity with surface restoring rate
+ activeTracersSurfaceRestoringValue(index_temperature,:) = activeTracers(index_temperature, 1, :)
+ activeTracersPistonVelocity(index_temperature,:) = tempPistonVel
+ activeTracersSurfaceRestoringValue(index_salinity,:) = activeTracers(index_salinity, 1, :)
+ activeTracersPistonVelocity(index_salinity,:) = 0.0_RKIND
+
+ ! Set wind stress
+ widthWindASFRad = 1.1_RKIND*contSlopeWidthRad
+ do iCell = 1, nCells
+ currentLon = lonCell(iCell)
+ currentLat = latCell(iCell)
+ windStress = 0.0_RKIND
+
+ ! Set wind stress over the ACC, or main channel
+ if (currentLat > latWindTrans) then
+ windStress = windACC * &
+ sin( pii * (currentLat - latWindTrans) &
+ / (northWallLat-latWindTrans) )**2
+ ! Set the wind over the continental slope front, over continental slope region
+ else if (currentLat > latWindTrans - widthWindASFRad .and. currentLat < latWindTrans) then
+ windStress = windASF * sin( pii * (latWindTrans-currentLat) / widthWindASFRad )**2
+ endif
+ windStressZonal(iCell) = windStress
+ windStressMeridional(iCell) = 0.0_RKIND
+ end do
+
+
+ block_ptr => block_ptr % next
+ end do
+
+ write(*,*) 'exiting ocn_init_setup_iso'
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_setup_iso!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_validate_iso
+!
+!> \brief Validation for ISO test case
+!> \author Juan A. Saenz
+!> \date 02/26/2014
+!> \details
+!> This routine validates the configuration options for the ISO test case.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_validate_iso(configPool, packagePool, iocontext, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (mpas_pool_type), intent(inout) :: configPool, packagePool
+ type (mpas_io_context_type), intent(inout) :: iocontext
+ integer, intent(out) :: iErr
+
+ character (len=StrKIND), pointer :: config_init_configuration
+ integer, pointer :: config_vert_levels, config_iso_vert_levels
+
+ iErr = 0
+
+ call mpas_pool_get_config(configPool, 'config_init_configuration', config_init_configuration)
+ if(config_init_configuration .ne. trim('iso')) return
+
+ call mpas_pool_get_config(configPool, 'config_vert_levels', config_vert_levels)
+ call mpas_pool_get_config(configPool, 'config_iso_vert_levels', config_iso_vert_levels)
+
+ if(config_vert_levels <= 0 .and. config_iso_vert_levels > 0) then
+ config_vert_levels = config_iso_vert_levels
+ else if (config_vert_levels <= 0) then
+ write(stderrUnit,*) 'ERROR: Validation failed for ISO. Not given a usable value for vertical levels.'
+ iErr = 1
+ end if
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_validate_iso!}}}
+
+end module ocn_init_iso
+
+
+
+
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_isomip.F b/src/core_ocean/mode_init/mpas_ocn_init_isomip.F
new file mode 100644
index 0000000000..2e91126dae
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_isomip.F
@@ -0,0 +1,491 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_isomip
+!
+!> \brief MPAS ocean initialize case -- isomip
+!> \author Xylar Asay-Davis
+!> \date 06/01/2015
+!> \details
+!> This module contains the routines for initializing the
+!> the Ice Shelf/Ocean Model Intercomparision Project (ISOMIP) test cases
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_isomip
+
+ use mpas_kind_types
+ use mpas_io_units
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+ use mpas_dmpar
+
+ use ocn_constants
+ use ocn_init_vertical_grids
+ use ocn_init_cell_markers
+
+ use ocn_init_ssh_and_ssp
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_setup_isomip, &
+ ocn_init_validate_isomip
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_setup_isomip
+!
+!> \brief Setup for ISoMIP test cases
+!> \author Xylar Asay-Davis
+!> \date 06/01/2015
+!> \details
+!> This routine sets up the initial conditions for the ISOMIP test cases.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_isomip(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ ! Define config variable pointers
+ character (len=StrKIND), pointer :: config_init_configuration, &
+ config_isomip_vertical_level_distribution, &
+ config_land_ice_flux_mode
+
+ real (kind=RKIND), pointer :: config_isomip_bottom_depth, &
+ config_isomip_temperature, &
+ config_isomip_salinity, &
+ config_isomip_restoring_temperature, &
+ config_isomip_restoring_salinity, &
+ config_isomip_temperature_piston_velocity, &
+ config_isomip_salinity_piston_velocity, &
+ config_isomip_coriolis_parameter, &
+ config_isomip_southern_boundary, &
+ config_isomip_northern_boundary, &
+ config_isomip_western_boundary, &
+ config_isomip_eastern_boundary, &
+ config_isomip_angle, &
+ config_isomip_y1, &
+ config_isomip_z1, &
+ config_isomip_ice_fraction1, &
+ config_isomip_y2, &
+ config_isomip_z2, &
+ config_isomip_ice_fraction2, &
+ config_isomip_y3, &
+ config_isomip_z3, &
+ config_isomip_ice_fraction3, &
+ config_isomip_effective_density
+
+ logical, pointer :: on_a_sphere
+
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: verticalMeshPool
+ type (mpas_pool_type), pointer :: forcingPool
+ type (mpas_pool_type), pointer :: diagnosticsPool
+ type (mpas_pool_type), pointer :: tracersPool
+ type (mpas_pool_type), pointer :: scratchPool
+ type (mpas_pool_type), pointer :: tracersSurfaceRestoringFieldsPool
+
+ type (block_type), pointer :: block_ptr
+
+ ! Define dimension pointers
+ integer, pointer :: nCells, nEdgesSolve, nVertLevels
+ integer, pointer :: index_temperature, index_salinity, index_tracer1
+
+ ! Define variable pointers
+ integer, dimension(:), pointer :: maxLevelCell, modifySSHMask
+ real (kind=RKIND), dimension(:), pointer :: xCell, yCell,refBottomDepth, &
+ vertCoordMovementWeights, bottomDepth, &
+ fCell, fEdge, fVertex, dcEdge, &
+ refSSH, landIceFraction, landIceSurfaceTemperature, &
+ effectiveDensity
+ !real (kind=RKIND), dimension(:), pointer :: temperatureRestore, salinityRestore, maskRestore
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness, restingThickness, zMid
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers, debugTracers
+ real (kind=RKIND), dimension(:, :), pointer :: activeTracersPistonVelocity, activeTracersSurfaceRestoringValue
+
+ integer :: iCell, k, iFit
+
+ real(kind=RKIND) :: x, y, ySouth, yNorth, xWest, xEast, &
+ pressure, dcEdgeMinGlobal, dcEdgeMin
+
+ real(kind=RKIND), parameter :: eps = 1e-3_RKIND
+
+ real(kind=RKIND), dimension(5) :: yFit, zFit, fracFit
+
+ real(kind=RKIND), dimension(:), pointer :: columnThicknessFraction
+
+ iErr = 0
+
+ call mpas_pool_get_config(ocnConfigs, 'config_init_configuration', config_init_configuration)
+
+ if(trim(config_init_configuration) .ne. trim('isomip')) return
+
+ ! Setup configuration
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_mode', config_land_ice_flux_mode)
+
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_vertical_level_distribution', config_isomip_vertical_level_distribution)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_bottom_depth', config_isomip_bottom_depth)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_temperature', config_isomip_temperature)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_salinity', config_isomip_salinity)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_restoring_temperature', config_isomip_restoring_temperature)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_restoring_salinity', config_isomip_restoring_salinity)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_temperature_piston_velocity', config_isomip_temperature_piston_velocity)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_salinity_piston_velocity', config_isomip_salinity_piston_velocity)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_coriolis_parameter', config_isomip_coriolis_parameter)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_southern_boundary', config_isomip_southern_boundary)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_northern_boundary', config_isomip_northern_boundary)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_western_boundary', config_isomip_western_boundary)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_eastern_boundary', config_isomip_eastern_boundary)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_y1', config_isomip_y1)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_z1', config_isomip_z1)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_ice_fraction1', config_isomip_ice_fraction1)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_y2', config_isomip_y2)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_z2', config_isomip_z2)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_ice_fraction2', config_isomip_ice_fraction2)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_y3', config_isomip_y3)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_z3', config_isomip_z3)
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_ice_fraction3', config_isomip_ice_fraction3)
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool)
+
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+
+ if ( on_a_sphere ) call mpas_dmpar_global_abort(&
+ 'MPAS-ocean: ERROR: The ISOMIP configuration can only be applied to a planar mesh. Exiting...')
+
+ ySouth = config_isomip_southern_boundary
+ yNorth = config_isomip_northern_boundary
+ xWest = config_isomip_western_boundary
+ xEast = config_isomip_eastern_boundary
+
+ dcEdgeMin = 1.0E10_RKIND
+ ! Determine local min and max values.
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
+ call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
+ dcEdgeMin = min( dcEdgeMin, minval(dcEdge(1:nEdgesSolve)))
+ block_ptr => block_ptr % next
+ end do
+
+ call mpas_dmpar_min_real(domain % dminfo, dcEdgeMin, dcEdgeMinGlobal)
+
+ yFit(2) = config_isomip_y1
+ yFit(3) = config_isomip_y2
+ yFit(4) = config_isomip_y3
+ zFit(2) = config_isomip_z1
+ zFit(3) = config_isomip_z2
+ zFit(4) = config_isomip_z3
+
+ yFit(1) = min(yFit(2),ySouth)-eps
+ zFit(1) = zFit(2)
+ yFit(5) = max(yFit(4),yNorth)+eps
+ zFit(5) = zFit(4)
+
+ fracFit(2) = config_isomip_ice_fraction1
+ fracFit(3) = config_isomip_ice_fraction2
+ fracFit(4) = config_isomip_ice_fraction3
+ fracFit(1) = fracFit(2)
+ fracFit(5) = fracFit(4)
+
+ allocate(columnThicknessFraction(nVertLevels))
+ if(trim(config_isomip_vertical_level_distribution) == "constant") then
+ columnThicknessFraction(:) = 1.0_RKIND/nVertLevels
+ else if(trim(config_isomip_vertical_level_distribution) == "boundary_layer") then
+ if(mod(nVertLevels,2) == 0) then
+ columnThicknessFraction(nVertLevels/2) = 0.25_RKIND
+ columnThicknessFraction(nVertLevels/2+1) = 0.25_RKIND
+ else
+ columnThicknessFraction(nVertLevels/2) = 0.125_RKIND
+ columnThicknessFraction(nVertLevels/2+1) = 0.5_RKIND
+ columnThicknessFraction(nVertLevels/2+2) = 0.125_RKIND
+ end if
+ do k = nVertLevels/2-1, 2, -1
+ columnThicknessFraction(k) = 0.5_RKIND*columnThicknessFraction(k+1)
+ columnThicknessFraction(nVertLevels-k+1) = 0.5_RKIND*columnThicknessFraction(nvertLevels-k)
+ end do
+ columnThicknessFraction(1) = columnThicknessFraction(2)
+ columnThicknessFraction(nVertLevels) = columnThicknessFraction(nVertLevels-1)
+ end if
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_array(meshPool, 'vertCoordMovementWeights', vertCoordMovementWeights)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'fCell', fCell)
+ call mpas_pool_get_array(meshPool, 'fEdge', fEdge)
+ call mpas_pool_get_array(meshPool, 'fVertex', fVertex)
+
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', index_temperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', index_salinity)
+ call mpas_pool_get_array(tracersPool, 'debugTracers', debugTracers, 1)
+ call mpas_pool_get_dimension(tracersPool, 'index_tracer1', index_tracer1)
+ call mpas_pool_get_array(forcingPool, 'landIceFraction', landIceFraction, 1)
+ call mpas_pool_get_array(forcingPool, 'landIceSurfaceTemperature', landIceSurfaceTemperature, 1)
+
+ call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
+ call mpas_pool_get_array(diagnosticsPool, 'refSSH', refSSH)
+ call mpas_pool_get_array(diagnosticsPool, 'modifySSHMask', modifySSHMask)
+
+ call mpas_pool_get_array(verticalMeshPool, 'restingThickness', restingThickness)
+
+ call mpas_pool_get_subpool(forcingPool, 'tracersSurfaceRestoringFields', tracersSurfaceRestoringFieldsPool)
+ call mpas_pool_get_array(tracersSurfaceRestoringFieldsPool, 'activeTracersPistonVelocity', &
+ activeTracersPistonVelocity, 1)
+ call mpas_pool_get_array(tracersSurfaceRestoringFieldsPool, 'activeTracersSurfaceRestoringValue', &
+ activeTracersSurfaceRestoringValue, 1)
+
+
+ ! flat bottom
+ maxLevelCell(:) = nVertLevels
+ maxLevelCell(nCells+1) = -1
+ bottomDepth(:) = abs(config_isomip_bottom_depth)
+ do iCell = 1, nCells
+ do k = 1, nVertLevels
+ restingThickness(k, iCell) = columnThicknessFraction(k)*bottomDepth(iCell)
+ end do
+ end do
+
+ call ocn_mark_north_boundary(meshPool, yNorth, dcEdgeMinGlobal, iErr)
+ call ocn_mark_south_boundary(meshPool, ySouth, dcEdgeMinGlobal, iErr)
+ call ocn_mark_east_boundary(meshPool, xEast, dcEdgeMinGlobal, iErr)
+ call ocn_mark_west_boundary(meshPool, xWest, dcEdgeMinGlobal, iErr)
+
+ ! Set refBottomDepth
+ refBottomDepth(1) = columnThicknessFraction(1)*abs(config_isomip_bottom_depth)
+ do k = 2, nVertLevels
+ refBottomDepth(k) = refBottomDepth(k-1) + columnThicknessFraction(k)*abs(config_isomip_bottom_depth)
+ end do
+
+ fCell(:) = config_isomip_coriolis_parameter
+ fEdge(:) = config_isomip_coriolis_parameter
+ fVertex(:) = config_isomip_coriolis_parameter
+
+ landIceFraction(:) = 0.0_RKIND
+ landIceSurfaceTemperature(:) = -25.0_RKIND !doesn't matter because ice is insulating
+ modifySSHMask(:) = 0
+
+
+ do iCell = 1, nCells
+ ! tracers computed using restingThickness with no ice shelf
+ x = xCell(iCell)
+ y = yCell(iCell)
+
+ ! Compute iceDraft by linear fit
+ do iFit = 1, 4
+ if((y >= yFit(iFit)) .and. (y <= yFit(iFit+1))) then
+ refSSH(iCell) = (zFit(iFit+1) - zFit(iFit))*(y - yFit(iFit)) &
+ / (yFit(iFit+1) - yFit(iFit)) + zFit(iFit)
+ landIceFraction(iCell) = (fracFit(iFit+1) - fracFit(iFit))*(y - yFit(iFit)) &
+ / (yFit(iFit+1) - yFit(iFit)) + fracFit(iFit)
+ exit
+ end if
+ end do
+ if(landIceFraction(iCell) > 0.0_RKIND) then
+ modifySSHMask(iCell) = 1
+ end if
+
+
+ if(.not. associated(activeTracers)) then
+ write(stderrUnit,*) 'ERROR: isomip test case needs activeTracers package to be active.'
+ return
+ end if
+
+ activeTracers(index_temperature, :, iCell) = config_isomip_temperature
+ activeTracers(index_salinity, :, iCell) = config_isomip_salinity
+ if(associated(debugTracers)) then
+ debugTracers(index_tracer1, :, iCell) = 1.0_RKIND
+ end if
+
+ ! Set surface temperature restoring value and rate
+ ! Value in units of C, piston velocity in units of m/s
+ if ( associated(activeTracersSurfaceRestoringValue) ) then
+ activeTracersSurfaceRestoringValue(index_temperature, iCell) = config_isomip_restoring_temperature
+ end if
+ if ( associated(activeTracersPistonVelocity) ) then
+ ! only restore where there *isn't* land ice
+ activeTracersPistonVelocity(index_temperature, iCell) = (1.0_RKIND - landIceFraction(iCell)) &
+ * config_isomip_temperature_piston_velocity
+ end if
+
+ ! Set surface salinity restoring value and rate
+ ! Value in units of PSU, piston velocity in units of m/s
+ if ( associated(activeTracersSurfaceRestoringValue) ) then
+ activeTracersSurfaceRestoringValue(index_salinity, iCell) = config_isomip_restoring_salinity
+ end if
+ if ( associated(activeTracersPistonVelocity) ) then
+ ! only restore where there *isn't* land ice
+ activeTracersPistonVelocity(index_salinity, iCell) = (1.0_RKIND - landIceFraction(iCell)) &
+ * config_isomip_salinity_piston_velocity
+ end if
+
+ end do
+
+ if(trim(config_land_ice_flux_mode) == 'coupled') then
+ call mpas_pool_get_config(ocnConfigs, 'config_isomip_effective_density', config_isomip_effective_density)
+ call mpas_pool_get_array(statePool, 'effectiveDensityInLandIce', effectiveDensity, 1)
+ effectiveDensity(:) = config_isomip_effective_density
+ end if
+
+ block_ptr => block_ptr % next
+ end do
+
+ deallocate(columnThicknessFraction)
+
+
+ ! compute the vertical grid (layerThickness, restingThickness, maxLevelCell, zMid)
+ ! based on ssh, bottomDepth and refBottomDepth
+ call ocn_init_ssh_and_ssp_vertical_grid(domain, iErr)
+
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: ocn_init_ssh_and_ssp_vertical_grid failed.'
+ return
+ end if
+
+ ! compute or update the SSP (or possibly SSH), also computing density and bottomPressure along the way
+ ! If this is the initial guess, the vertical grid and activeTracers may also be recomputed based on SSH
+ call ocn_init_ssh_and_ssp_balance(domain, iErr)
+
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: ocn_init_ssh_and_ssp_balance failed.'
+ return
+ end if
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+
+ call ocn_compute_Haney_number(domain, iErr)
+
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: ocn_compute_Haney_number failed.'
+ return
+ end if
+
+ block_ptr => block_ptr % next
+ end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_setup_isomip!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_validate_isomip
+!
+!> \brief Validation for ISOMIP test cases
+!> \author Xylar Asay-Davis
+!> \date 06/01/2015
+!> \details
+!> This routine validates the configuration options for the ISOMIP test cases.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_validate_isomip(configPool, packagePool, iocontext, iErr)!{{{
+
+ !--------------------------------------------------------------------
+ type (mpas_pool_type), intent(in) :: configPool, packagePool
+
+ type (mpas_io_context_type), intent(inout) :: iocontext
+
+ integer, intent(out) :: iErr
+
+ character (len=StrKIND), pointer :: config_init_configuration, &
+ config_isomip_vertical_level_distribution
+
+ integer, pointer :: config_vert_levels, config_isomip_vert_levels
+
+ iErr = 0
+
+ call mpas_pool_get_config(configPool, 'config_init_configuration', config_init_configuration)
+
+ if(trim(config_init_configuration) .ne. trim('isomip')) return
+
+ call mpas_pool_get_config(configPool, 'config_vert_levels', config_vert_levels)
+ call mpas_pool_get_config(configPool, 'config_isomip_vert_levels', config_isomip_vert_levels)
+
+ if(config_vert_levels <= 0 .and. config_isomip_vert_levels > 0) then
+ config_vert_levels = config_isomip_vert_levels
+ else if (config_vert_levels <= 0) then
+ write(stderrUnit,*) 'ERROR: Validation failed for isomip. Not given a usable value for vertical levels.'
+ iErr = 1
+ end if
+
+ call mpas_pool_get_config(configPool, 'config_isomip_vertical_level_distribution', config_isomip_vertical_level_distribution)
+
+ if((trim(config_isomip_vertical_level_distribution) .ne. "constant") &
+ .and. (trim(config_isomip_vertical_level_distribution) .ne. "boundary_layer")) then
+ write(stderrUnit,*) 'ERROR: Validation failed for isomip. Bad vertical level distribution.'
+ iErr = 1
+ return
+ end if
+
+
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_validate_isomip!}}}
+
+
+!***********************************************************************
+
+end module ocn_init_isomip
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_lock_exchange.F b/src/core_ocean/mode_init/mpas_ocn_init_lock_exchange.F
new file mode 100644
index 0000000000..42e339857e
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_lock_exchange.F
@@ -0,0 +1,352 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_lock_exchange
+!
+!> \brief MPAS ocean initialize case -- Lock Exchange
+!> \author Doug Jacobsen
+!> \date 02/18/2014
+!> \details
+!> This module contains the routines for initializing the
+!> the lock exchange test case
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_lock_exchange
+
+ use mpas_kind_types
+ use mpas_io_units
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_dmpar
+
+ use ocn_constants
+ use ocn_init_vertical_grids
+ use ocn_init_cell_markers
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_setup_lock_exchange, &
+ ocn_init_validate_lock_exchange
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_setup_lock_exchange
+!
+!> \brief Setup for lock exchange test case
+!> \author Doug Jacobsen
+!> \date 02/18/2014
+!> \details
+!> This routine sets up the initial conditions for the lock exchange test case.
+!> It is setup in the y direction, such that everything in the southern half of
+!> the domain has a temperature of 5.0C and the northern half has a value of
+!> 30.0C. Salinity is setup as a constant 35PSU.
+!> No windstress is specified, and layerThickness is constant depending on the input parameter
+!> config_lock_exchange_bottom_depth.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_lock_exchange(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+ real (kind=RKIND) :: yMin, yMax, xMin, xMax, dcEdgeMin
+ real (kind=RKIND) :: yMinGlobal, yMaxGlobal, xMinGlobal, xMaxGlobal, dcEdgeMinGlobal
+
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool, statePool, verticalMeshPool, tracersPool
+
+ character (len=StrKIND), pointer :: config_init_configuration, config_vertical_grid, config_lock_exchange_layer_type, &
+ config_lock_exchange_direction
+
+ integer, pointer :: nCellsSolve, nEdgesSolve, nVertLevels, nVertLevelsP1, index_temperature, index_salinity, index_tracer1
+
+ integer, dimension(:), pointer :: maxLevelCell
+
+ real (kind=RKIND), pointer :: config_lock_exchange_cold_temperature, config_lock_exchange_warm_temperature, &
+ config_lock_exchange_salinity, config_lock_exchange_bottom_depth, &
+ config_lock_exchange_isopycnal_min_thickness
+
+ real (kind=RKIND), dimension(:), pointer :: xCell, yCell, bottomDepth, refBottomDepthTopOfCell, refBottomDepth, &
+ vertCoordMovementWeights, dcEdge
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness, restingThickness
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers, debugTracers
+
+ real (kind=RKIND), dimension(:), pointer :: interfaceLocations
+
+ logical, pointer :: on_a_sphere
+
+ integer :: iCell, k
+
+ iErr = 0
+
+ call mpas_pool_get_config(ocnConfigs, 'config_init_configuration', config_init_configuration)
+
+ if (config_init_configuration .ne. trim('lock_exchange')) return
+
+ call mpas_pool_get_config(ocnConfigs, 'config_vertical_grid', config_vertical_grid)
+
+ call mpas_pool_get_config(ocnConfigs, 'config_lock_exchange_cold_temperature', config_lock_exchange_cold_temperature)
+ call mpas_pool_get_config(ocnConfigs, 'config_lock_exchange_warm_temperature', config_lock_exchange_warm_temperature)
+ call mpas_pool_get_config(ocnConfigs, 'config_lock_exchange_salinity', config_lock_exchange_salinity)
+ call mpas_pool_get_config(ocnConfigs, 'config_lock_exchange_bottom_depth', config_lock_exchange_bottom_depth)
+ call mpas_pool_get_config(ocnConfigs, 'config_lock_exchange_direction', config_lock_exchange_direction)
+ call mpas_pool_get_config(ocnConfigs, 'config_lock_exchange_isopycnal_min_thickness', &
+ config_lock_exchange_isopycnal_min_thickness)
+ call mpas_pool_get_config(ocnConfigs, 'config_lock_exchange_layer_type', config_lock_exchange_layer_type)
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevelsP1', nVertLevelsP1)
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+
+ if ( on_a_sphere ) call mpas_dmpar_global_abort('MPAS-ocean: ERROR: The lock exchange configuration can not be ' &
+ // 'applied to spherical meshes')
+
+ ! Define interface locations
+ allocate( interfaceLocations( nVertLevelsP1 ) )
+ call ocn_generate_vertical_grid( config_vertical_grid, interfaceLocations )
+
+ ! Initalize y values to large positive and negative values
+ yMin = 1.0E10_RKIND
+ yMax = -1.0E10_RKIND
+ xMin = 1.0E10_RKIND
+ xMax = -1.0E10_RKIND
+ dcEdgeMin = 1.0E10_RKIND
+
+ ! Determine local min and max y value.
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
+
+ xMin = min( xMin, minval(xCell(1:nCellssolve)))
+ xMax = max( xMax, maxval(xCell(1:nCellssolve)))
+ yMin = min( yMin, minval(yCell(1:nCellssolve)))
+ yMax = max( yMax, maxval(yCell(1:nCellssolve)))
+ dcEdgeMin = min( dcEdgeMin, minval(dcEdge(1:nEdgessolve)))
+
+ block_ptr => block_ptr % next
+ end do
+
+ ! Determine global min and max y value. This is so the domain
+ ! can be split into north and south.
+ call mpas_dmpar_min_real(domain % dminfo, xMin, xMinGlobal)
+ call mpas_dmpar_max_real(domain % dminfo, xMax, xMaxGlobal)
+ call mpas_dmpar_min_real(domain % dminfo, yMin, yMinGlobal)
+ call mpas_dmpar_max_real(domain % dminfo, yMax, yMaxGlobal)
+ call mpas_dmpar_min_real(domain % dminfo, dcEdgeMin, dcEdgeMinGlobal)
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', index_temperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', index_salinity)
+ call mpas_pool_get_dimension(tracersPool, 'index_tracer1', index_tracer1)
+
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_array(meshPool, 'refBottomDepthTopOfCell', refBottomDepthTopOfCell)
+ call mpas_pool_get_array(meshPool, 'vertCoordMovementWeights', vertCoordMovementWeights)
+
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+ call mpas_pool_get_array(tracersPool, 'debugTracers', debugTracers, 1)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+
+ call mpas_pool_get_array(verticalMeshPool, 'restingThickness', restingThickness)
+
+ call ocn_mark_north_boundary(meshPool, yMaxGlobal, dcEdgeMinGlobal, iErr)
+ call ocn_mark_south_boundary(meshPool, yMinGlobal, dcEdgeMinGlobal, iErr)
+
+ do iCell = 1, nCellsSolve
+ ! Set layerThickness, and restingThickness
+
+ if ( trim(config_lock_exchange_layer_type) == 'z-level' ) then
+ ! Set layerThickness and restingThickness
+ do k = 1, nVertLevels
+ layerThickness(k, iCell) = config_lock_exchange_bottom_depth * ( interfaceLocations(k+1) &
+ - interfaceLocations(k) )
+ restingThickness(k, iCell) = layerThickness(k, iCell)
+ end do
+
+ ! Set temperature
+ if ( associated(activeTracers) ) then
+ if ( trim(config_lock_exchange_direction) == 'x' ) then
+ if(xCell(iCell) < xMinGlobal + (xMaxGlobal - xMinGlobal) * 0.5_RKIND) then
+ activeTracers(index_temperature, :, iCell) = config_lock_exchange_cold_temperature
+ else
+ activeTracers(index_temperature, :, iCell) = config_lock_exchange_warm_temperature
+ end if
+
+ elseif ( trim(config_lock_exchange_direction) == 'y' ) then
+ if(yCell(iCell) < yMinGlobal + (yMaxGlobal - yMinGlobal) * 0.5_RKIND) then
+ activeTracers(index_temperature, :, iCell) = config_lock_exchange_cold_temperature
+ else
+ activeTracers(index_temperature, :, iCell) = config_lock_exchange_warm_temperature
+ end if
+
+ elseif ( trim(config_lock_exchange_direction) == 'z' ) then
+ activeTracers(index_temperature, 1:nVertLevels/2, iCell) = config_lock_exchange_warm_temperature
+ activeTracers(index_temperature, nVertLevels/2+1:nVertLevels, iCell) = &
+ config_lock_exchange_cold_temperature
+ else
+ call mpas_dmpar_global_abort('MPAS-ocean: Error: wrong choice of config_lock_exchange_direction')
+ end if
+ end if
+
+ else if ( trim(config_lock_exchange_layer_type) == 'isopycnal' ) then
+ if ( associated(activeTracers) ) then
+ activeTracers(index_temperature, 1, iCell) = config_lock_exchange_warm_temperature
+ activeTracers(index_temperature, 2:nVertLevels, iCell) = config_lock_exchange_cold_temperature
+ end if
+
+ if(yCell(iCell) < (yMaxGlobal - yMinGlobal) * 0.5_RKIND) then
+ layerThickness(1, iCell) = config_lock_exchange_isopycnal_min_thickness
+ layerThickness(2:nVertLevels, iCell) = config_lock_exchange_bottom_depth &
+ - config_lock_exchange_isopycnal_min_thickness
+ else
+ layerThickness(1, iCell) = config_lock_exchange_bottom_depth - config_lock_exchange_isopycnal_min_thickness
+ layerThickness(2:nVertLevels, iCell) = config_lock_exchange_isopycnal_min_thickness
+ end if
+ else
+ call mpas_dmpar_global_abort('MPAS-ocean: Error: wrong choice of config_lock_exchange_layer_type')
+ end if
+
+ ! Set salinity
+ if ( associated(activeTracers) ) then
+ activeTracers(index_salinity, :, iCell) = config_lock_exchange_salinity
+ end if
+
+ ! Set debugging tracer
+ if ( associated(debugTracers) ) then
+ do k = 1, nVertLevels
+ debugTracers(index_tracer1, k, iCell) = 1.0_RKIND
+ enddo
+ end if
+
+ ! Set bottomDepth
+ bottomDepth(iCell) = config_lock_exchange_bottom_depth
+
+ ! Set maxLevelCell
+ maxLevelCell(iCell) = nVertLevels
+ end do
+
+ ! Set refBottomDepth and refBottomDepthTopOfCell
+ do k = 1, nVertLevels
+ refBottomDepth(k) = config_lock_exchange_bottom_depth * interfaceLocations(k+1)
+ refBottomDepthTopOfCell(k) = config_lock_exchange_bottom_depth * interfaceLocations(k)
+ end do
+
+ refBottomDepthTopOfCell(nVertLevels+1) = interfaceLocations(nVertLevels+1) * config_lock_exchange_bottom_depth
+
+ ! Set vertCoordMovementWeights
+ vertCoordMovementWeights(:) = 1.0_RKIND
+
+ block_ptr => block_ptr % next
+ end do
+
+ deallocate(interfaceLocations)
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_setup_lock_exchange!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_validate_lock_exchange
+!
+!> \brief Validation for lock exchange test case
+!> \author Doug Jacobsen
+!> \date 02/20/2014
+!> \details
+!> This routine validates the configuration options for the lock exchange test case.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_validate_lock_exchange(configPool, packagePool, iocontext, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (mpas_pool_type), intent(inout) :: configPool
+ type (mpas_pool_type), intent(inout) :: packagePool
+ type (mpas_io_context_type), intent(inout) :: iocontext
+
+ integer, intent(out) :: iErr
+
+ integer, pointer :: config_vert_levels, config_lock_exchange_vert_levels
+ character (len=StrKIND), pointer :: config_init_configuration
+
+ iErr = 0
+
+ call mpas_pool_get_config(configPool, 'config_init_configuration', config_init_configuration)
+
+ if(config_init_configuration .ne. trim('lock_exchange')) return
+
+
+ call mpas_pool_get_config(configPool, 'config_vert_levels', config_vert_levels)
+ call mpas_pool_get_config(configPool, 'config_lock_exchange_vert_levels', config_lock_exchange_vert_levels)
+
+ if(config_vert_levels <= 0 .and. config_lock_exchange_vert_levels > 0) then
+ config_vert_levels = config_lock_exchange_vert_levels
+ else if(config_vert_levels <= 0) then
+ write(stderrUnit,*) 'ERROR: Validation failed for lock exchange test case. Not given a usable value for vertical levels.'
+ iErr = 1
+ end if
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_validate_lock_exchange!}}}
+
+!***********************************************************************
+
+end module ocn_init_lock_exchange
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_mode.F b/src/core_ocean/mode_init/mpas_ocn_init_mode.F
new file mode 100644
index 0000000000..8cd1eafc8f
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_mode.F
@@ -0,0 +1,392 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_mode
+!
+!> \brief Main driver for MPAS ocean core
+!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
+!> \date September 2011
+!> \details
+!> This module contains initialization and timestep drivers for
+!> the MPAS ocean core.
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_mode
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_stream_manager
+ use mpas_timekeeping
+ use mpas_dmpar
+ use mpas_timer
+ use mpas_io_units
+ use mpas_constants
+ use mpas_decomp
+
+ use ocn_init_routines
+
+ use ocn_equation_of_state
+
+ use ocn_constants
+
+ use ocn_init_spherical_utils
+
+ !use ocn_init_TEMPLATE
+ use ocn_init_baroclinic_channel
+ use ocn_init_lock_exchange
+ use ocn_init_internal_waves
+ use ocn_init_overflow
+ use ocn_init_global_ocean
+ use ocn_init_cvmix_WSwSBF
+ use ocn_init_iso
+ use ocn_init_soma
+ use ocn_init_ziso
+ use ocn_init_sub_ice_shelf_2D
+ use ocn_init_periodic_planar
+ use ocn_init_ecosys_column
+ use ocn_init_sea_mount
+ use ocn_init_isomip
+
+ implicit none
+ private
+
+ public :: ocn_init_mode_init, ocn_init_mode_run, ocn_init_mode_finalize
+ public :: ocn_init_mode_setup_clock, ocn_init_mode_validate_configuration
+
+ contains
+
+!***********************************************************************
+!
+! function ocn_init_mode_init
+!
+!> \brief Initialize MPAS-Ocean core in init mode
+!> \author Doug Jacobsen
+!> \date 06/15/2015
+!> \details
+!> This function calls all initializations required to start MPAS-Ocean in
+!> init mode.
+!
+!-----------------------------------------------------------------------
+
+ function ocn_init_mode_init(domain, startTimeStamp) result(ierr)!{{{
+
+ type (domain_type), intent(inout) :: domain
+ character(len=*), intent(out) :: startTimeStamp
+ integer :: ierr
+
+ real (kind=RKIND) :: dt
+ type (block_type), pointer :: block
+
+ integer :: err_tmp
+ integer, pointer :: nVertLevels
+ real (kind=RKIND) :: maxDensity, maxDensity_global
+ real (kind=RKIND), dimension(:), pointer :: meshDensity
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: diagnosticsPool
+
+ character (len=StrKIND), pointer :: xtime
+ type (MPAS_Time_Type) :: startTime
+ type (MPAS_TimeInterval_type) :: timeStep
+
+ logical, pointer :: config_do_restart, config_filter_btr_mode, config_conduct_tests
+ logical, pointer :: config_write_stats_on_startup
+ character (len=StrKIND), pointer :: config_vert_coord_movement, config_pressure_gradient_type
+ real (kind=RKIND), pointer :: config_maxMeshDensity
+
+ ierr = 0
+
+ !
+ ! Set startTimeStamp based on the start time of the simulation clock
+ !
+ startTime = mpas_get_clock_time(domain % clock, MPAS_START_TIME, err_tmp)
+ call mpas_get_time(startTime, dateTimeString=startTimeStamp)
+ ierr = ior(ierr, err_tmp)
+
+ ! Setup ocean config pool
+ call ocn_constants_init(domain % configs, domain % packages)
+
+ if ( ierr /= 0 ) then
+ call mpas_dmpar_global_abort("MPAS-ocean: ERROR: Failed validation...")
+ end if
+
+ !
+ ! Read input data for model
+ !
+ call mpas_timer_start('io_read', .false.)
+ call MPAS_stream_mgr_read(domain % streamManager, streamID='input_init', ierr=err_tmp)
+ call mpas_timer_stop('io_read')
+
+ call mpas_timer_start('reset_io_alarms', .false.)
+ call mpas_stream_mgr_reset_alarms(domain % streamManager, streamID='input_init', ierr=err_tmp)
+ ! call mpas_stream_mgr_reset_alarms(domain % streamManager, direction=MPAS_STREAM_OUTPUT, ierr=err_tmp)
+ call mpas_timer_stop('reset_io_alarms')
+
+ ! Read the remaining input streams
+ call mpas_timer_start('io_read', .false.)
+ call mpas_stream_mgr_read(domain % streamManager, ierr=err_tmp)
+ ierr = ior(ierr, err_tmp)
+ call mpas_timer_stop('io_read')
+ call mpas_timer_start('reset_io_alarms', .false.)
+ call mpas_stream_mgr_reset_alarms(domain % streamManager, direction=MPAS_STREAM_INPUT, ierr=err_tmp)
+ ierr = ior(ierr, err_tmp)
+ call mpas_timer_stop('reset_io_alarms')
+
+ ! Initialize submodules before initializing blocks.
+ call ocn_equation_of_state_init(err_tmp)
+ ierr = ior(ierr, err_tmp)
+ if(ierr.eq.1) then
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: An error was encountered while initializing the MPAS-Ocean init mode')
+ endif
+
+ !
+ ! Initialize core
+ !
+ timeStep = mpas_get_clock_timestep(domain % clock, ierr=err_tmp)
+ call mpas_get_timeInterval(timeStep, dt=dt)
+
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_array(diagnosticsPool, 'xtime', xtime)
+ xtime = startTimeStamp
+ block => block % next
+ end do
+
+ ! Expand sphere if it needs to be expanded
+ call ocn_init_expand_sphere(domain, domain % streamManager, a, ierr)
+
+ end function ocn_init_mode_init!}}}
+
+!***********************************************************************
+!
+! function ocn_init_mode_setup_clock
+!
+!> \brief Setup MPAS-Ocean clock
+!> \author Doug Jacobsen
+!> \date 06/15/2015
+!> \details
+!> This function initializes the MPAS-Ocean clock for the init mode.
+!
+!-----------------------------------------------------------------------
+ function ocn_init_mode_setup_clock(core_clock, configs) result(ierr)!{{{
+
+ implicit none
+
+ type (MPAS_Clock_type), intent(inout) :: core_clock
+ type (mpas_pool_type), intent(inout) :: configs
+ integer :: ierr
+
+ type (MPAS_Time_Type) :: startTime, stopTime, alarmStartTime
+ type (MPAS_TimeInterval_type) :: runDuration, timeStep, alarmTimeStep
+ character(len=StrKIND) :: restartTimeStamp
+ character(len=StrKIND), pointer :: config_start_time, config_stop_time, config_run_duration
+ character(len=StrKIND), pointer :: config_dt, config_restart_timestamp_name
+ integer :: err_tmp
+
+ ierr = 0
+
+ call mpas_pool_get_config(configs, 'config_dt', config_dt)
+ call mpas_pool_get_config(configs, 'config_start_time', config_start_time)
+ call mpas_pool_get_config(configs, 'config_stop_time', config_stop_time)
+ call mpas_pool_get_config(configs, 'config_run_duration', config_run_duration)
+ call mpas_pool_get_config(configs, 'config_restart_timestamp_name', config_restart_timestamp_name)
+
+ call mpas_set_time(startTime, dateTimeString=config_start_time, ierr=err_tmp)
+ call mpas_set_timeInterval(timeStep, timeString=config_dt, ierr=err_tmp)
+ if (trim(config_run_duration) /= "none") then
+ call mpas_set_timeInterval(runDuration, timeString=config_run_duration, ierr=err_tmp)
+ call mpas_create_clock(core_clock, startTime=startTime, timeStep=timeStep, runDuration=runDuration, ierr=err_tmp)
+
+ if (trim(config_stop_time) /= "none") then
+ call mpas_set_time(curr_time=stopTime, dateTimeString=config_stop_time, ierr=err_tmp)
+ if(startTime + runduration /= stopTime) then
+ write(stderrUnit,*) 'Warning: config_run_duration and config_stop_time are inconsitent: using config_run_duration.'
+ end if
+ end if
+ else if (trim(config_stop_time) /= "none") then
+ call mpas_set_time(curr_time=stopTime, dateTimeString=config_stop_time, ierr=err_tmp)
+ call mpas_create_clock(core_clock, startTime=startTime, timeStep=timeStep, stopTime=stopTime, ierr=err_tmp)
+ else
+ write(stderrUnit, *) ' Warning: config_run_duration and config_start_time were "none", setting run duration to 1 second.'
+ call mpas_set_timeInterval(runDuration, timeString="0000_00:00:01", ierr=err_tmp)
+ call mpas_create_clock(core_clock, startTime=startTime, timeStep=timeStep, runDuration=runDuration, ierr=err_tmp)
+ end if
+
+ end function ocn_init_mode_setup_clock!}}}
+
+!***********************************************************************
+!
+! function ocn_init_mode_run
+!
+!> \brief MPAS-Ocean init mode run step
+!> \author Doug Jacobsen
+!> \date 06/15/2015
+!> \details
+!> This function sets up the initial configuration using the MPAS-Ocean init
+!> mode.
+!
+!-----------------------------------------------------------------------
+
+ function ocn_init_mode_run(domain) result(iErr)!{{{
+
+ type (domain_type), intent(inout) :: domain
+ integer :: iErr
+
+ integer :: itimestep
+ real (kind=RKIND) :: dt
+ type (block_type), pointer :: block_ptr
+
+ type (MPAS_Time_Type) :: currTime
+ character(len=StrKIND) :: timeStamp
+
+ type (mpas_pool_type), pointer :: averagePool
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: forcingPool
+
+ type (MPAS_timeInterval_type) :: timeStep
+
+ character (len=StrKIND), pointer :: config_init_configuration
+
+ ierr = 0
+
+ ! Eventually, dt should be domain specific
+ timeStep = mpas_get_clock_timestep(domain % clock, ierr=ierr)
+ call mpas_get_timeInterval(timeStep, dt=dt)
+
+ currTime = mpas_get_clock_time(domain % clock, MPAS_NOW, ierr)
+ call mpas_get_time(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr)
+
+ call mpas_pool_get_config(domain % configs, 'config_init_configuration', config_init_configuration)
+ write(stderrUnit, *) ' Generating configuration: ' // trim(config_init_configuration)
+
+ call ocn_init_setup_baroclinic_channel(domain, ierr)
+ call ocn_init_setup_lock_exchange(domain, ierr)
+ call ocn_init_setup_internal_waves(domain, ierr)
+ call ocn_init_setup_overflow(domain, ierr)
+ call ocn_init_setup_global_ocean(domain, ierr)
+ call ocn_init_setup_cvmix_WSwSBF(domain, ierr)
+ call ocn_init_setup_iso(domain, ierr)
+ call ocn_init_setup_soma(domain, ierr)
+ call ocn_init_setup_ziso(domain, ierr)
+ call ocn_init_setup_sub_ice_shelf_2D(domain, ierr)
+ call ocn_init_setup_periodic_planar(domain, ierr)
+ call ocn_init_setup_ecosys_column(domain, ierr)
+ call ocn_init_setup_sea_mount(domain, ierr)
+ call ocn_init_setup_isomip(domain, ierr)
+ !call ocn_init_setup_TEMPLATE(domain, ierr)
+
+ write(stderrUnit, *) ' Completed setup of: ' // trim(config_init_configuration)
+ call mpas_timer_start('io_write', .false.)
+ call mpas_stream_mgr_write(domain % streamManager, ierr=ierr)
+ call mpas_timer_stop('io_write')
+ call mpas_timer_start('reset_io_alarms', .false.)
+ call mpas_stream_mgr_reset_alarms(domain % streamManager, direction=MPAS_STREAM_OUTPUT, ierr=ierr)
+ call mpas_timer_stop('reset_io_alarms')
+
+ end function ocn_init_mode_run!}}}
+
+!***********************************************************************
+!
+! function ocn_init_mode_finalize
+!
+!> \brief MPAS-Ocean init mode run step
+!> \author Doug Jacobsen
+!> \date 06/15/2015
+!> \details
+!> This function sets up the initial configuration using the MPAS-Ocean init
+!> mode.
+!
+!-----------------------------------------------------------------------
+
+ function ocn_init_mode_finalize(domain) result(iErr)!{{{
+
+ type (domain_type), intent(inout) :: domain
+ integer :: ierr
+
+ iErr = 0
+
+ call mpas_destroy_clock(domain % clock, ierr)
+
+ call mpas_decomp_destroy_decomp_list(domain % decompositions)
+
+ end function ocn_init_mode_finalize!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_validate_configuration
+!
+!> \brief Configuration validation routine
+!> \author Doug Jacobsen
+!> \date 03/20/2015
+!> \details
+!> This routine is used to validate the namelist options against the
+!> configuration definition. It will call the validate routines for each of the
+!> configurations to ensure namelist options are set in a valid way.
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_init_mode_validate_configuration(configPool, packagePool, iocontext, iErr)!{{{
+
+ type (mpas_pool_type), intent(inout) :: configPool !< Input: Pool with namelist options
+ type (mpas_pool_type), intent(inout) :: packagePool !< Input: Pool with packages
+ type (mpas_io_context_type), intent(inout) :: iocontext
+ integer, intent(out) :: iErr !< Output: Error core
+
+ logical, pointer :: cullCellsActive
+
+ logical, pointer :: config_write_cull_cell_mask
+
+ integer :: err_tmp
+
+ iErr = 0
+
+ call mpas_pool_get_config(configPool, 'config_write_cull_cell_mask', config_write_cull_cell_mask)
+ call mpas_pool_get_package(packagePool, 'cullCellsActive', cullCellsActive)
+
+ if ( config_write_cull_cell_mask ) then
+ cullCellsActive = .true.
+ end if
+
+ call ocn_init_validate_baroclinic_channel(configPool, packagePool, iocontext, iErr=err_tmp)
+ iErr = ior(iErr, err_tmp)
+ call ocn_init_validate_lock_exchange(configPool, packagePool, iocontext, iErr=err_tmp)
+ iErr = ior(iErr, err_tmp)
+ call ocn_init_validate_internal_waves(configPool, packagePool, iocontext, iErr=err_tmp)
+ iErr = ior(iErr, err_tmp)
+ call ocn_init_validate_overflow(configPool, packagePool, iocontext, iErr=err_tmp)
+ iErr = ior(iErr, err_tmp)
+ call ocn_init_validate_global_ocean(configPool, packagePool, iocontext, iErr=err_tmp)
+ iErr = ior(iErr, err_tmp)
+ call ocn_init_validate_cvmix_WSwSBF(configPool, packagePool, iocontext, iErr=err_tmp)
+ iErr = ior(iErr, err_tmp)
+ call ocn_init_validate_iso(configPool, packagePool, iocontext, iErr=err_tmp)
+ iErr = ior(iErr, err_tmp)
+ call ocn_init_validate_soma(configPool, packagePool, iocontext, iErr=err_tmp)
+ iErr = ior(iErr, err_tmp)
+ call ocn_init_validate_ziso(configPool, packagePool, iErr=err_tmp)
+ iErr = ior(iErr, err_tmp)
+ call ocn_init_validate_sub_ice_shelf_2D(configPool, packagePool,iocontext, iErr=err_tmp)
+ iErr = ior(iErr, err_tmp)
+ call ocn_init_validate_periodic_planar(configPool, packagePool, iocontext, iErr=err_tmp)
+ iErr = ior(iErr, err_tmp)
+ call ocn_init_validate_ecosys_column(configPool, packagePool, iocontext, iErr=err_tmp)
+ iErr = ior(iErr, err_tmp)
+ call ocn_init_validate_sea_mount(configPool, packagePool, iocontext, iErr=err_tmp)
+ iErr = ior(iErr, err_tmp)
+ call ocn_init_validate_isomip(configPool, packagePool, iocontext, iErr=err_tmp)
+ iErr = ior(iErr, err_tmp)
+ ! call ocn_init_validate_TEMPLATE(configPool, packagePool, iocontext, iErr=err_tmp)
+ ! iErr = ior(iErr, err_tmp)
+ end subroutine ocn_init_mode_validate_configuration!}}}
+
+end module ocn_init_mode
+
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_overflow.F b/src/core_ocean/mode_init/mpas_ocn_init_overflow.F
new file mode 100644
index 0000000000..d772fec76c
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_overflow.F
@@ -0,0 +1,358 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_overflow
+!
+!> \brief MPAS ocean initialize case -- Overflow
+!> \author Doug Jacobsen
+!> \date 02/18/2014
+!> \details
+!> This module contains the routines for initializing the
+!> the overflow test case
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_overflow
+
+ use mpas_kind_types
+ use mpas_io_units
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_dmpar
+
+ use ocn_constants
+ use ocn_init_vertical_grids
+ use ocn_init_cell_markers
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_setup_overflow, &
+ ocn_init_validate_overflow
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_setup_overflow
+!
+!> \brief Setup for overflow test case
+!> \author Doug Jacobsen
+!> \date 02/18/2014
+!> \details
+!> This routine sets up the initial conditions for the overflow test case.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_overflow(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+ real (kind=RKIND) :: yMin, yMax, dcEdgeMin
+ real (kind=RKIND) :: yMinGlobal, yMaxGlobal, dcEdgeMinGlobal
+ real (kind=RKIND) :: plugWidth
+ real (kind=RKIND) :: slopeCenter, slopeWidth
+
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: verticalMeshPool
+ type (mpas_pool_type), pointer :: tracersPool
+
+ integer :: iCell, k
+
+ ! Define dimensions
+ integer, pointer :: nCellsSolve, nEdgesSolve, nVertLevels, nVertLevelsP1
+ integer, pointer :: index_temperature, index_salinity, index_tracer1
+
+ ! Define arrays
+ integer, dimension(:), pointer :: maxLevelCell
+ real (kind=RKIND), dimension(:), pointer :: yCell, refBottomDepth, bottomDepth, vertCoordMovementWeights, dcEdge
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness, restingThickness
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers, debugTracers
+
+ ! Define configs
+ character (len=StrKIND), pointer :: config_init_configuration, config_vertical_grid, config_overflow_layer_type
+ logical, pointer :: config_overflow_use_distances
+ real (kind=RKIND), pointer :: config_overflow_plug_width_dist, config_overflow_slope_center_dist, &
+ config_overflow_slope_width_dist, config_overflow_plug_width_frac, &
+ config_overflow_slope_center_frac, config_overflow_slope_width_frac, &
+ config_overflow_bottom_depth, config_overflow_ridge_depth, &
+ config_overflow_plug_temperature, config_overflow_domain_temperature, &
+ config_overflow_salinity, config_overflow_isopycnal_min_thickness
+
+
+ real (kind=RKIND), dimension(:), pointer :: interfaceLocations
+
+ iErr = 0
+
+
+ call mpas_pool_get_config(ocnConfigs, 'config_init_configuration', config_init_configuration)
+
+ if(config_init_configuration .ne. trim('overflow')) return
+
+ call mpas_pool_get_config(ocnConfigs, 'config_vertical_grid', config_vertical_grid)
+
+ call mpas_pool_get_config(ocnConfigs, 'config_overflow_use_distances', config_overflow_use_distances)
+ call mpas_pool_get_config(ocnConfigs, 'config_overflow_plug_width_dist', config_overflow_plug_width_dist)
+ call mpas_pool_get_config(ocnConfigs, 'config_overflow_slope_center_dist', config_overflow_slope_center_dist)
+ call mpas_pool_get_config(ocnConfigs, 'config_overflow_slope_width_dist', config_overflow_slope_width_dist)
+ call mpas_pool_get_config(ocnConfigs, 'config_overflow_plug_width_frac', config_overflow_plug_width_frac)
+ call mpas_pool_get_config(ocnConfigs, 'config_overflow_slope_center_frac', config_overflow_slope_center_frac)
+ call mpas_pool_get_config(ocnConfigs, 'config_overflow_slope_width_frac', config_overflow_slope_width_frac)
+ call mpas_pool_get_config(ocnConfigs, 'config_overflow_bottom_depth', config_overflow_bottom_depth)
+ call mpas_pool_get_config(ocnConfigs, 'config_overflow_ridge_depth', config_overflow_ridge_depth)
+ call mpas_pool_get_config(ocnConfigs, 'config_overflow_plug_temperature', config_overflow_plug_temperature)
+ call mpas_pool_get_config(ocnConfigs, 'config_overflow_domain_temperature', config_overflow_domain_temperature)
+ call mpas_pool_get_config(ocnConfigs, 'config_overflow_salinity', config_overflow_salinity)
+ call mpas_pool_get_config(ocnConfigs, 'config_overflow_layer_type', config_overflow_layer_type)
+ call mpas_pool_get_config(ocnConfigs, 'config_overflow_isopycnal_min_thickness', config_overflow_isopycnal_min_thickness)
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevelsP1', nVertLevelsP1)
+
+ allocate(interfaceLocations(nVertLevelsP1))
+ call ocn_generate_vertical_grid(config_vertical_grid, interfaceLocations)
+
+ ! Initalize y values to large positive and negative values
+ yMin = 1.0E10_RKIND
+ yMax = -1.0E10_RKIND
+ dcEdgeMin = 1.0E10_RKIND
+
+ ! Determine local min and max y value.
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
+
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
+
+ yMin = min( yMin, minval(yCell(1:nCellssolve)))
+ yMax = max( yMax, maxval(yCell(1:nCellssolve)))
+ dcEdgeMin = min( dcEdgeMin, minval(dcEdge(1:nEdgessolve)))
+
+ block_ptr => block_ptr % next
+ end do
+
+ ! Determine global min and max y value. This is so the domain
+ ! can be split into north and south.
+ call mpas_dmpar_min_real(domain % dminfo, yMin, yMinGlobal)
+ call mpas_dmpar_max_real(domain % dminfo, yMax, yMaxGlobal)
+ call mpas_dmpar_min_real(domain % dminfo, dcEdgeMin, dcEdgeMinGlobal)
+
+ if ( config_overflow_use_distances ) then
+ plugWidth = config_overflow_plug_width_dist
+ slopeCenter = yMinGlobal + config_overflow_slope_center_dist
+ slopeWidth = config_overflow_slope_width_dist
+ else
+ plugWidth = (yMaxGlobal - yMinGlobal) * config_overflow_plug_width_frac
+ slopeCenter = yMinGlobal + (yMaxGlobal - yMinGlobal) * config_overflow_slope_center_frac
+ slopeWidth = (yMaxGlobal - yMinGlobal) * config_overflow_slope_width_frac
+ end if
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', index_temperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', index_salinity)
+ call mpas_pool_get_dimension(tracersPool, 'index_tracer1', index_tracer1)
+
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'vertCoordMovementWeights', vertCoordMovementWeights)
+
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+ call mpas_pool_get_array(tracersPool, 'debugTracers', debugTracers, 1)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+
+ call mpas_pool_get_array(verticalMeshPool, 'restingThickness', restingThickness)
+
+ call ocn_mark_north_boundary(meshPool, yMaxGlobal, dcEdgeMinGlobal, iErr)
+ call ocn_mark_south_boundary(meshPool, yMinGlobal, dcEdgeMinGlobal, iErr)
+
+ ! Set refBottomDepth, bottomDepth, and maxLevelCell
+ do k = 1, nVertLevels
+ refBottomDepth(k) = config_overflow_bottom_depth * interfaceLocations(k+1)
+ end do
+
+ do iCell = 1, nCellsSolve
+ ! From Mehmet Ilicak:
+ ! depth=2000
+ ! val1 = 500 is top of ridge
+ ! h(i,j) = val1 + 0.5*(depth-val1) * (1.0+TANH((lon(i,j)-40000.0)/7000.0))
+ bottomDepth(iCell) = config_overflow_ridge_depth &
+ + 0.5_RKIND*(config_overflow_bottom_depth - config_overflow_ridge_depth) &
+ * (1.0_RKIND+tanh((yCell(iCell) - slopeCenter)/slopeWidth))
+
+ if ( trim(config_overflow_layer_type) == 'sigma' .or. trim(config_overflow_layer_type) == 'isopycnal' ) then
+ maxLevelCell(iCell) = nVertLevels
+ else if ( trim(config_overflow_layer_type) == 'z-level' ) then
+ maxLevelCell(iCell) = -1
+ do k = 1, nVertLevels
+ if (bottomDepth(iCell) .le. refBottomDepth(k) .and. &
+ maxLevelCell(iCell) == -1) then
+
+ maxLevelCell(iCell) = k
+ end if
+ end do
+ end if
+ end do
+
+ do iCell = 1, nCellsSolve
+ ! Set temperature
+ if ( associated(activeTracers) ) then
+ if ( trim(config_overflow_layer_type) == 'sigma' .or. trim(config_overflow_layer_type) == 'z-level' ) then
+ do k = 1, maxLevelCell(iCell)
+ if(yCell(iCell) < yMinGlobal + plugWidth) then
+ activeTracers(index_temperature, k, iCell) = config_overflow_plug_temperature
+ else
+ activeTracers(index_temperature, k, iCell) = config_overflow_domain_temperature
+ end if
+ end do
+ else if ( trim(config_overflow_layer_type) == 'isopycnal' ) then
+ activeTracers(index_temperature, 1, :) = config_overflow_domain_temperature
+ activeTracers(index_temperature, 2:nVertLevels, :) = config_overflow_plug_temperature
+ end if
+ end if
+
+ ! Set layerThickness and restingThickness
+ if ( trim(config_overflow_layer_type) == 'z-level' ) then
+ do k = 1, maxLevelCell(iCell)
+ layerThickness(k, iCell) = config_overflow_bottom_depth * (interfaceLocations(k+1) - interfaceLocations(k))
+ restingThickness(k, iCell) = layerThickness(k, iCell)
+ end do
+ else if ( trim(config_overflow_layer_type) == 'sigma' ) then
+ do k = 1, nVertLevels
+ layerThickness(k, iCell) = bottomDepth(iCell) / nVertLevels
+ restingThickness(k, iCell) = layerThickness(k, iCell)
+ end do
+ else if ( trim(config_overflow_layer_type) == 'isopycnal' ) then
+ ! Set layerThickness. Normally isopycnal overflow has only two layers.
+ if ( yCell(iCell) < yMinGlobal + plugWidth) then
+ layerThickness(1, iCell) = config_overflow_isopycnal_min_thickness
+ layerThickness(2:nVertLevels, iCell) = bottomDepth(iCell) - config_overflow_isopycnal_min_thickness
+ restingThickness(:, iCell) = layerThickness(:, iCell)
+ else
+ layerThickness(1, iCell) = bottomDepth(iCell) - config_overflow_isopycnal_min_thickness
+ layerThickness(2:nVertLevels, iCell) = config_overflow_isopycnal_min_thickness
+ restingThickness(:, iCell) = layerThickness(:, iCell)
+ end if
+ end if
+
+ ! Set salinity
+ if ( associated(activeTracers) ) then
+ activeTracers(index_salinity, :, iCell) = config_overflow_salinity
+ end if
+
+ ! Set debug tracer
+ if ( associated(debugTracers) ) then
+ do k = 1, nVertLevels
+ debugTracers(index_tracer1, k, iCell) = 1.0_RKIND
+ end do
+ end if
+
+ end do
+
+ ! Set vertCoordMovementWeights
+ vertCoordMovementWeights(:) = 1.0_RKIND
+
+ block_ptr => block_ptr % next
+ end do
+
+ deallocate(interfaceLocations)
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_setup_overflow!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_validate_overflow
+!
+!> \brief Validation for overflow test case
+!> \author Doug Jacobsen
+!> \date 02/20/2014
+!> \details
+!> This routine validates the configuration options for the overflow test case.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_validate_overflow(configPool, packagePool, iocontext, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (mpas_pool_type), intent(inout) :: configPool, packagePool
+ type (mpas_io_context_type), intent(inout) :: iocontext
+
+ integer, intent(out) :: iErr
+
+ character (len=StrKIND), pointer :: config_init_configuration
+ integer, pointer :: config_overflow_vert_levels, config_vert_levels
+
+ iErr = 0
+
+ call mpas_pool_get_config(configPool, 'config_init_configuration', config_init_configuration)
+
+ if(config_init_configuration .ne. trim('overflow')) return
+
+ call mpas_pool_get_config(configPool, 'config_vert_levels', config_vert_levels)
+ call mpas_pool_get_config(configPool, 'config_overflow_vert_levels', config_overflow_vert_levels)
+
+ if(config_vert_levels <= 0 .and. config_overflow_vert_levels > 0) then
+ config_vert_levels = config_overflow_vert_levels
+ else if(config_vert_levels <= 0) then
+ write(stderrUnit,*) 'ERROR: Validation failed for overflow test case. Not given a usable value for vertical levels.'
+ iErr = 1
+ end if
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_validate_overflow!}}}
+
+!***********************************************************************
+
+end module ocn_init_overflow
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_periodic_planar.F b/src/core_ocean/mode_init/mpas_ocn_init_periodic_planar.F
new file mode 100644
index 0000000000..b37b3f8f33
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_periodic_planar.F
@@ -0,0 +1,412 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_periodic_planar
+!
+!> \brief MPAS ocean initialize case -- periodic_planar
+!> \author Phillip J. Wolfram
+!> \date 10/14/2015
+!> \details
+!> This module contains the routines for initializing the
+!> periodic_planar initial condition, which is a constant
+!> velocity in a periodic domain.
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_periodic_planar
+
+ use mpas_kind_types
+ use mpas_io_units
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+ use mpas_stream_manager
+ use mpas_dmpar
+
+ use ocn_constants
+ use ocn_init_vertical_grids
+ use ocn_init_cell_markers
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_setup_periodic_planar, &
+ ocn_init_validate_periodic_planar
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_setup_periodic_planar
+!
+!> \brief Setup for this initial condition
+!> \author Phillip J. Wolfram
+!> \date 10/14/2015
+!> \details
+!> This routine sets up the initial conditions for this case.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_periodic_planar(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ ! local work variables
+ type (block_type), pointer :: block_ptr
+ type (mpas_pool_type), pointer :: meshPool, verticalMeshPool, statePool, forcingPool, tracersPool, scratchPool
+
+ integer :: iCell, iEdge, iVertex, k, idx
+ real (kind=RKIND), dimension(:), pointer :: interfaceLocations
+
+ ! Define config variable pointers
+ character (len=StrKIND), pointer :: config_init_configuration, config_vertical_grid
+ logical, pointer :: config_write_cull_cell_mask
+
+ ! periodic_planar test case run-time configuration parameters
+ real (kind=RKIND), pointer :: config_periodic_planar_bottom_depth, config_periodic_planar_velocity_strength
+
+ integer, pointer :: config_periodic_planar_vert_levels
+
+
+ ! Define dimension pointers
+ integer, pointer :: nVertLevels, nCellsSolve, nEdgesSolve, nVerticesSolve, nVertLevelsP1
+ integer, pointer :: index_temperature, index_salinity
+
+ ! Define variable pointers
+ logical, pointer :: on_a_sphere
+ integer, dimension(:), pointer :: maxLevelCell
+ integer, dimension(:,:), pointer :: verticesOnEdge
+ real (kind=RKIND), dimension(:), pointer :: xCell, yCell, xEdge, yEdge, xVertex, yVertex, refBottomDepth, refZMid, &
+ vertCoordMovementWeights, bottomDepth, &
+ fCell, fEdge, fVertex, dcEdge, dvEdge
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness, restingThickness, normalVelocity
+ real (kind=RKIND), dimension(:), pointer :: psiVertex
+ type (field1DReal), pointer :: psiVertexField
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
+
+ real (kind=RKIND) :: yMin, yMax, xMin, xMax, dcEdgeMin, dcEdgeMinGlobal
+ real (kind=RKIND) :: yMinGlobal, yMaxGlobal, yMidGlobal, xMinGlobal, xMaxGlobal
+ real(kind=RKIND), pointer :: y_period
+ character (len=StrKIND) :: streamID
+ integer :: directionProperty
+
+ ! assume no error
+ iErr = 0
+
+
+ ! test if periodic_planar is the desired configuration
+ call mpas_pool_get_config(ocnConfigs, 'config_init_configuration', config_init_configuration)
+ if(config_init_configuration .ne. trim('periodic_planar')) return
+
+ write(stderrUnit,*) 'Starting initialization of planar periodic grid'
+
+ ! get config variables !{{{
+ call mpas_pool_get_config(domain % configs, 'config_write_cull_cell_mask', config_write_cull_cell_mask)
+ call mpas_pool_get_config(domain % configs, 'config_periodic_planar_bottom_depth', config_periodic_planar_bottom_depth)
+ call mpas_pool_get_config(domain % configs, 'config_periodic_planar_vert_levels', config_periodic_planar_vert_levels)
+ call mpas_pool_get_config(domain % configs, 'config_periodic_planar_velocity_strength', &
+ config_periodic_planar_velocity_strength)
+ call mpas_pool_get_config(domain % configs, 'config_vertical_grid', config_vertical_grid)
+ !}}}
+
+ ! Determine vertical grid for configuration
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevelsP1', nVertLevelsP1)
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+
+ ! test if configure settings are invalid
+ if ( on_a_sphere ) call mpas_dmpar_global_abort('MPAS-ocean: IERROR: The planar periodic configuration can ' &
+ // 'only be applied to a planar mesh. Exiting...')
+
+ ! Define interface locations
+ allocate(interfaceLocations(nVertLevelsP1))
+ call ocn_generate_vertical_grid( config_vertical_grid, interfaceLocations )
+
+ ! assign config variables
+ nVertLevels = config_periodic_planar_vert_levels
+ nVertLevelsP1 = nVertLevels + 1
+
+ ! keep all cells on planar, periodic mesh (no culling)
+
+ !--------------------------------------------------------------------
+ ! Use this section to make boundaries non-periodic
+ !--------------------------------------------------------------------
+
+ ! Initalize min/max values to large positive and negative values
+ yMin = 1.0E10_RKIND
+ yMax = -1.0E10_RKIND
+ xMin = 1.0E10_RKIND
+ xMax = -1.0E10_RKIND
+ dcEdgeMin = 1.0E10_RKIND
+
+ ! Determine local min and max values.
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
+
+ yMin = min( yMin, minval(yCell(1:nCellsSolve)))
+ yMax = max( yMax, maxval(yCell(1:nCellsSolve)))
+ xMin = min( xMin, minval(xCell(1:nCellsSolve)))
+ xMax = max( xMax, maxval(xCell(1:nCellsSolve)))
+ dcEdgeMin = min( dcEdgeMin, minval(dcEdge(1:nEdgesSolve)))
+
+ block_ptr => block_ptr % next
+ end do ! do while(associated(block_ptr))
+
+
+ !--------------------------------------------------------------------
+ ! Use this section to set initial values
+ !--------------------------------------------------------------------
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'scratch', scratchPool)
+ call mpas_pool_get_field(scratchPool, 'psiVertex', psiVertexField)
+ call mpas_allocate_scratch_field(psiVertexField, .false.)
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
+ call mpas_pool_get_dimension(meshPool, 'nVerticesSolve', nVerticesSolve)
+
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', index_temperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', index_salinity)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'xEdge', xEdge)
+ call mpas_pool_get_array(meshPool, 'yEdge', yEdge)
+ call mpas_pool_get_array(meshPool, 'xVertex', xVertex)
+ call mpas_pool_get_array(meshPool, 'yVertex', yVertex)
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_array(meshPool, 'vertCoordMovementWeights', vertCoordMovementWeights)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'fCell', fCell)
+ call mpas_pool_get_array(meshPool, 'fEdge', fEdge)
+ call mpas_pool_get_array(meshPool, 'fVertex', fVertex)
+
+ call mpas_pool_get_array(scratchPool, 'psiVertex', psiVertex)
+ call mpas_pool_get_array(meshPool, 'verticesOnEdge', verticesOnEdge)
+ call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge)
+ call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, timeLevel=1)
+
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+
+ call mpas_pool_get_array(verticalMeshPool, 'refZMid', refZMid)
+ call mpas_pool_get_array(verticalMeshPool, 'restingThickness', restingThickness)
+
+ ! Determine global min and max values.
+ call mpas_dmpar_min_real(domain % dminfo, yMin, yMinGlobal)
+ call mpas_dmpar_max_real(domain % dminfo, yMax, yMaxGlobal)
+ call mpas_dmpar_min_real(domain % dminfo, xMin, xMinGlobal)
+ call mpas_dmpar_max_real(domain % dminfo, xMax, xMaxGlobal)
+ call mpas_dmpar_min_real(domain % dminfo, dcEdgeMin, dcEdgeMinGlobal)
+
+ ! mark north / south boundaries
+ if(config_write_cull_cell_mask) then
+ call ocn_mark_north_boundary(meshPool, yMaxGlobal, dcEdgeMinGlobal, iErr)
+ call ocn_mark_south_boundary(meshPool, yMinGlobal, dcEdgeMinGlobal, iErr)
+ call mpas_pool_get_config(meshPool, 'y_period', y_period)
+ y_period = 0.0_RKIND
+ endif
+ call mpas_stream_mgr_begin_iteration(domain % streamManager)
+ do while (mpas_stream_mgr_get_next_stream(domain % streamManager, streamID, directionProperty))
+ if ( directionProperty == MPAS_STREAM_OUTPUT .or. directionProperty == MPAS_STREAM_INPUT_OUTPUT ) then
+ call mpas_stream_mgr_add_att(domain % streamManager, 'y_period', 0.0_RKIND, streamID)
+ end if
+ end do
+
+ ! Set refBottomDepth and refZMid
+ do k = 1, nVertLevels
+ refBottomDepth(k) = config_periodic_planar_bottom_depth * interfaceLocations(k+1)
+ refZMid(k) = - 0.5_RKIND * (interfaceLocations(k+1) + interfaceLocations(k)) * config_periodic_planar_bottom_depth
+ end do
+
+ ! set bottomDepth and maxLevelCell !{{{{
+ bottomDepth(:) = 0.0_RKIND
+ do iCell = 1, nCellsSolve
+
+ bottomDepth(iCell) = config_periodic_planar_bottom_depth
+
+ ! Determine maxLevelCell based on bottomDepth and refBottomDepth
+ ! Also set botomDepth based on refBottomDepth, since
+ ! above bottomDepth was set with continuous analytical functions,
+ ! and needs to be discrete
+ maxLevelCell(iCell) = nVertLevels
+ if (nVertLevels > 1) then
+ do k = 1, nVertLevels
+ if (bottomDepth(iCell) < refBottomDepth(k)) then
+ maxLevelCell(iCell) = k-1
+ bottomDepth(iCell) = refBottomDepth(k-1)
+ exit
+ end if
+ end do
+ end if
+
+ enddo ! Looping through with iCell !}}}
+
+ ! Set vertCoordMovementWeights
+ vertCoordMovementWeights(:) = 1.0_RKIND
+
+ do iCell = 1, nCellsSolve
+
+ ! Set initial temperature
+ idx = index_temperature
+ do k = 1, nVertLevels
+ activeTracers(idx, k, iCell) = 0.0_RKIND
+ end do
+
+ ! Set initial salinity
+ idx = index_salinity
+ do k = 1, nVertLevels
+ activeTracers(idx, k, iCell) = 0.0_RKIND
+ end do
+
+ ! Set layerThickness and restingThickness
+ ! Uniform layer thickness
+ do k = 1, nVertLevels
+ layerThickness(k, iCell) = config_periodic_planar_bottom_depth * ( interfaceLocations(k+1) - interfaceLocations(k) )
+ restingThickness(k, iCell) = layerThickness(k, iCell)
+ end do
+
+ ! Set bottomDepth (above)
+
+ ! Set maxLevelCell (above)
+
+ end do ! do iCell
+
+ ! Set Coriolis parameters, if other than zero
+ do iCell = 1, nCellsSolve
+ fCell(iCell) = 0.0_RKIND
+ end do
+ do iEdge = 1, nEdgesSolve
+ fEdge(iEdge) = 0.0_RKIND
+ end do
+ do iVertex = 1, nVerticesSolve
+ fVertex(iVertex) = 0.0_RKIND
+ end do
+
+ ! Setup stream function for velocity
+ do iVertex = 1, nVerticesSolve ! need to loop over all vertices to ensure correct value for edges
+ psiVertex(iVertex) = yVertex(iVertex)*config_periodic_planar_velocity_strength
+ end do
+
+ !boundaryVertex => block_ptr % mesh % boundaryVertex % array(1,:)
+ !!write(stdoutUnit,*) boundaryVertex(:)
+ !block_ptr % scratch % psiVertex % array = &
+ ! boundaryVertex * &
+ ! sum(boundaryVertex * block_ptr % scratch % psiVertex % array) &
+ ! /sum(boundaryVertex) &
+ ! + (1-boundaryVertex) * block_ptr % scratch % psiVertex % array
+
+ ! Define normalVelocity as (grad psiVertex)
+ do iEdge = 1, nEdgesSolve
+ normalVelocity(:,iEdge) = -1.0_RKIND * (psiVertex(verticesOnEdge(1, iEdge)) &
+ - psiVertex(verticesOnEdge(2, iEdge)))/dvEdge(iEdge)
+ end do
+
+ block_ptr => block_ptr % next
+ end do ! do while(associated(block_ptr))
+ call mpas_deallocate_scratch_field(psiVertexField, .false.)
+
+ write(stderrUnit,*) 'Finishing initialization of periodic_planar'
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_setup_periodic_planar!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_validate_periodic_planar
+!
+!> \brief Validation for this initial condition
+!> \author Phillip J. Wolfram
+!> \date 10/14/2015
+!> \details
+!> This routine validates the configuration options for this case.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_validate_periodic_planar(configPool, packagePool, iocontext, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (mpas_pool_type), intent(inout) :: configPool, packagePool
+ type (mpas_io_context_type), intent(inout) :: iocontext
+ integer, intent(out) :: iErr
+
+ character (len=StrKIND), pointer :: config_init_configuration
+ integer, pointer :: config_vert_levels, config_periodic_planar_vert_levels
+
+ iErr = 0
+
+ call mpas_pool_get_config(configPool, 'config_init_configuration', config_init_configuration)
+ if(config_init_configuration .ne. trim('periodic_planar')) return
+
+ call mpas_pool_get_config(configPool, 'config_vert_levels', config_vert_levels)
+ call mpas_pool_get_config(configPool, 'config_periodic_planar_vert_levels', config_periodic_planar_vert_levels)
+
+ if(config_vert_levels <= 0 .and. config_periodic_planar_vert_levels > 0) then
+ config_vert_levels = config_periodic_planar_vert_levels
+ else if (config_vert_levels <= 0) then
+ write(stderrUnit,*) 'IERROR: Validation failed for periodic_planar. Not given a usable value for vertical levels.'
+ iErr = 1
+ end if
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_validate_periodic_planar!}}}
+
+
+!***********************************************************************
+
+end module ocn_init_periodic_planar
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_sea_mount.F b/src/core_ocean/mode_init/mpas_ocn_init_sea_mount.F
new file mode 100644
index 0000000000..32754aba77
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_sea_mount.F
@@ -0,0 +1,376 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_sea_mount
+!
+!> \brief MPAS ocean initialize case -- Sea Mount
+!> \author Mark Petersen
+!> \date 08/10/15
+!> \details
+!> This module contains the routines for initializing the
+!> the sea mount test case
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_sea_mount
+
+ use mpas_kind_types
+ use mpas_io_units
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+ use mpas_dmpar
+
+ use ocn_constants
+ use ocn_init_vertical_grids
+ use ocn_init_cell_markers
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_setup_sea_mount, &
+ ocn_init_validate_sea_mount
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_setup_sea_mount
+!
+!> \brief Setup for sea mount test case
+!> \author Mark Petersen
+!> \date 08/10/15
+!> \details
+!> This routine sets up the initial conditions for the sea mount test case.
+!> It should also ensure the mesh that was input is valid for the configuration.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_sea_mount(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+ real (kind=RKIND) :: yMin, yMax, xMin, xMax, dcEdgeMin, dcEdgeMinGlobal
+ real (kind=RKIND) :: yMinGlobal, yMaxGlobal, yMidGlobal, xMinGlobal, xMaxGlobal, xMidGlobal
+ real (kind=RKIND) :: densityCell, z, radius
+
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: verticalMeshPool
+ type (mpas_pool_type), pointer :: tracersPool
+
+ integer :: iCell, k, idx
+
+ ! Define config variable pointers
+ character (len=StrKIND), pointer :: config_init_configuration, config_vertical_grid, config_sea_mount_layer_type, &
+ config_sea_mount_stratification_type
+ real (kind=RKIND), pointer :: config_sea_mount_width, &
+ config_sea_mount_bottom_depth, config_sea_mount_height,config_sea_mount_radius, &
+ config_sea_mount_density_coef_linear, config_sea_mount_density_coef_exp, &
+ config_sea_mount_density_gradient_linear, config_sea_mount_density_gradient_exp, &
+ config_sea_mount_density_depth_linear, config_sea_mount_density_depth_exp, &
+ config_sea_mount_density_ref, config_sea_mount_density_alpha, config_sea_mount_density_Tref, &
+ config_sea_mount_salinity, config_sea_mount_coriolis_parameter
+
+ ! Define dimension pointers
+ integer, pointer :: nCellsSolve, nEdgesSolve, nVertLevels, nVertLevelsP1
+ integer, pointer :: index_temperature, index_salinity
+
+ ! Define variable pointers
+ integer, dimension(:), pointer :: maxLevelCell
+ real (kind=RKIND), dimension(:), pointer :: xCell, yCell,refBottomDepth, refZMid, refLayerThickness, &
+ vertCoordMovementWeights, bottomDepth, &
+ fCell, fEdge, fVertex, dcEdge
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness, restingThickness
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
+
+ ! Define local interfaceLocations variable
+ real (kind=RKIND), dimension(:), pointer :: interfaceLocations
+
+ logical, pointer :: on_a_sphere
+
+ iErr = 0
+
+ call mpas_pool_get_config(ocnConfigs, 'config_init_configuration', config_init_configuration)
+
+ if(config_init_configuration .ne. trim('sea_mount')) return
+
+ call mpas_pool_get_config(ocnConfigs, 'config_vertical_grid', config_vertical_grid)
+
+ call mpas_pool_get_config(ocnConfigs, 'config_sea_mount_layer_type', config_sea_mount_layer_type)
+ call mpas_pool_get_config(ocnConfigs, 'config_sea_mount_stratification_type', config_sea_mount_stratification_type)
+ call mpas_pool_get_config(ocnConfigs, 'config_sea_mount_width', config_sea_mount_width)
+ call mpas_pool_get_config(ocnConfigs, 'config_sea_mount_bottom_depth', config_sea_mount_bottom_depth)
+ call mpas_pool_get_config(ocnConfigs, 'config_sea_mount_height', config_sea_mount_height)
+ call mpas_pool_get_config(ocnConfigs, 'config_sea_mount_radius', config_sea_mount_radius)
+ call mpas_pool_get_config(ocnConfigs, 'config_sea_mount_density_coef_linear', config_sea_mount_density_coef_linear)
+ call mpas_pool_get_config(ocnConfigs, 'config_sea_mount_density_gradient_linear', config_sea_mount_density_gradient_linear)
+ call mpas_pool_get_config(ocnConfigs, 'config_sea_mount_density_depth_linear', config_sea_mount_density_depth_linear)
+ call mpas_pool_get_config(ocnConfigs, 'config_sea_mount_density_coef_exp', config_sea_mount_density_coef_exp)
+ call mpas_pool_get_config(ocnConfigs, 'config_sea_mount_density_gradient_exp', config_sea_mount_density_gradient_exp)
+ call mpas_pool_get_config(ocnConfigs, 'config_sea_mount_density_depth_exp', config_sea_mount_density_depth_exp)
+ call mpas_pool_get_config(ocnConfigs, 'config_sea_mount_density_ref', config_sea_mount_density_ref)
+ call mpas_pool_get_config(ocnConfigs, 'config_sea_mount_density_alpha', config_sea_mount_density_alpha)
+ call mpas_pool_get_config(ocnConfigs, 'config_sea_mount_density_Tref', config_sea_mount_density_Tref)
+ call mpas_pool_get_config(ocnConfigs, 'config_sea_mount_salinity', config_sea_mount_salinity)
+ call mpas_pool_get_config(ocnConfigs, 'config_sea_mount_coriolis_parameter', config_sea_mount_coriolis_parameter)
+
+ ! Determine vertical grid for configuration
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevelsP1', nVertLevelsP1)
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+
+ if ( on_a_sphere ) call mpas_dmpar_global_abort('MPAS-ocean: ERROR: The sea mount configuration can only be applied to ' &
+ // 'a planar mesh. Exiting...')
+
+ allocate(interfaceLocations(nVertLevelsP1))
+ call ocn_generate_vertical_grid( config_vertical_grid, interfaceLocations )
+
+ ! Initalize min/max values to large positive and negative values
+ yMin = 1.0E10_RKIND
+ yMax = -1.0E10_RKIND
+ xMin = 1.0E10_RKIND
+ xMax = -1.0E10_RKIND
+ dcEdgeMin = 1.0E10_RKIND
+
+ ! Determine local min and max values.
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
+
+ yMin = min( yMin, minval(yCell(1:nCellsSolve)))
+ yMax = max( yMax, maxval(yCell(1:nCellsSolve)))
+ xMin = min( xMin, minval(xCell(1:nCellsSolve)))
+ xMax = max( xMax, maxval(xCell(1:nCellsSolve)))
+ dcEdgeMin = min( dcEdgeMin, minval(dcEdge(1:nEdgesSolve)))
+
+ block_ptr => block_ptr % next
+ end do
+
+ ! Determine global min and max values.
+ call mpas_dmpar_min_real(domain % dminfo, yMin, yMinGlobal)
+ call mpas_dmpar_max_real(domain % dminfo, yMax, yMaxGlobal)
+ call mpas_dmpar_min_real(domain % dminfo, xMin, xMinGlobal)
+ call mpas_dmpar_max_real(domain % dminfo, xMax, xMaxGlobal)
+ call mpas_dmpar_min_real(domain % dminfo, dcEdgeMin, dcEdgeMinGlobal)
+
+ xMidGlobal = (xMinGlobal + xMaxGlobal) * 0.5_RKIND
+ yMidGlobal = (yMinGlobal + yMaxGlobal) * 0.5_RKIND
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', index_temperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', index_salinity)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_array(meshPool, 'vertCoordMovementWeights', vertCoordMovementWeights)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'fCell', fCell)
+ call mpas_pool_get_array(meshPool, 'fEdge', fEdge)
+ call mpas_pool_get_array(meshPool, 'fVertex', fVertex)
+
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+
+ call mpas_pool_get_array(verticalMeshPool, 'refZMid', refZMid)
+ call mpas_pool_get_array(verticalMeshPool, 'restingThickness', restingThickness)
+ call mpas_pool_get_array(verticalMeshPool, 'refLayerThickness', refLayerThickness)
+
+ ! mrp note: doubly non-periodic. Can delete these later.
+ call ocn_mark_north_boundary(meshPool, yMaxGlobal, dcEdgeMinGlobal, iErr)
+ call ocn_mark_south_boundary(meshPool, yMinGlobal, dcEdgeMinGlobal, iErr)
+ call ocn_mark_east_boundary(meshPool, xMaxGlobal, dcEdgeMinGlobal, iErr)
+ call ocn_mark_west_boundary(meshPool, xMinGlobal, dcEdgeMinGlobal, iErr)
+
+ ! Set refBottomDepth and refZMid
+ do k = 1, nVertLevels
+ refBottomDepth(k) = config_sea_mount_bottom_depth * interfaceLocations(k+1)
+ refZMid(k) = - 0.5_RKIND * (interfaceLocations(k+1) + interfaceLocations(k)) * config_sea_mount_bottom_depth
+ end do
+
+ refLayerThickness(1) = refBottomDepth(1)
+ do k = 2, nVertLevels
+ refLayerThickness(k) = refBottomDepth(k) - refBottomDepth(k-1)
+ end do
+
+ ! Set vertCoordMovementWeights
+ vertCoordMovementWeights(:) = 1.0_RKIND
+
+ do iCell = 1, nCellsSolve
+
+ radius = sqrt( (xCell(iCell)-xMidGlobal)**2 + (yCell(iCell)-yMidGlobal)**2 )
+
+ ! Set bottomDepth. See Beckmann and Haidvogel 1993 eqn 12, Shchepetkin 2003 eqn 4.2
+ bottomDepth(iCell) = config_sea_mount_bottom_depth - config_sea_mount_height &
+ * exp(-(max(radius-config_sea_mount_radius, 0.0_RKIND))**2 / config_sea_mount_width**2)
+
+ ! Set maxLevelCell and layerThickness
+ if ( trim(config_sea_mount_layer_type) == 'z-level' ) then
+ maxLevelCell(iCell) = -1
+ do k = 1, nVertLevels
+ if (bottomDepth(iCell) .le. refBottomDepth(k)) then
+ maxLevelCell(iCell) = k
+ ! make full cell only:
+ bottomDepth(iCell) = refBottomDepth(k)
+ exit
+ end if
+ end do
+ do k = 1, maxLevelCell(iCell)
+ layerThickness(k, iCell) = refLayerThickness(k)
+ end do
+ else if ( trim(config_sea_mount_layer_type) == 'sigma') then
+ maxLevelCell(iCell) = nVertLevels
+ do k = 1, nVertLevels
+ layerThickness(k, iCell) = bottomDepth(iCell) / nVertLevels
+ end do
+ end if
+
+ ! Set restingThickness
+ do k = 1, maxLevelCell(iCell)
+ restingThickness(k, iCell) = layerThickness(k, iCell)
+ end do
+
+ ! Set stratification using temperature. See Beckmann and Haidvogel 1993 eqn 15-16.
+ idx = index_temperature
+ z = 0.0_RKIND
+ do k = 1, maxLevelCell(iCell)
+
+ z = z - 0.5_RKIND * layerThickness(k, iCell)
+
+ if ( trim(config_sea_mount_stratification_type) == 'linear' ) then
+ densityCell = config_sea_mount_density_coef_linear - config_sea_mount_density_gradient_linear * z &
+ / config_sea_mount_density_depth_linear
+ elseif ( trim(config_sea_mount_stratification_type) == 'exponential' ) then
+ densityCell = config_sea_mount_density_coef_exp - config_sea_mount_density_gradient_exp * exp( z &
+ / config_sea_mount_density_depth_exp)
+ else
+ call mpas_dmpar_global_abort('MPAS-ocean: Error: Incorrect config_sea_mount_stratification_type: ' &
+ // config_sea_mount_stratification_type)
+ end if
+
+ ! Back-solve linear EOS for temperature, with S=S_ref
+ ! T = T_ref - (rho - rho_ref)/alpha
+ activeTracers(idx, k, iCell) = config_sea_mount_density_Tref - (densityCell - config_sea_mount_density_ref) &
+ / config_sea_mount_density_alpha
+ z = z - 0.5_RKIND * layerThickness(k, iCell)
+
+ end do
+
+ ! Set salinity
+ idx = index_salinity
+ activeTracers(idx, :, iCell) = config_sea_mount_salinity
+
+ end do
+
+ ! Set Coriolis parameters
+ fCell(:) = config_sea_mount_coriolis_parameter
+ fEdge(:) = config_sea_mount_coriolis_parameter
+ fVertex(:) = config_sea_mount_coriolis_parameter
+
+ block_ptr => block_ptr % next
+ end do
+
+ deallocate(interfaceLocations)
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_setup_sea_mount!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_validate_sea_mount
+!
+!> \brief Validation for sea mount test case
+!> \author Mark Petersen
+!> \date 08/10/15
+!> \details
+!> This routine validates the configuration options for the sea mount test case.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_validate_sea_mount(configPool, packagePool, iocontext, iErr)!{{{
+
+ !--------------------------------------------------------------------
+ type (mpas_pool_type), intent(in) :: configPool, packagePool
+ type (mpas_io_context_type), intent(inout), target :: iocontext
+
+ integer, intent(out) :: iErr
+
+ character (len=StrKIND), pointer :: config_init_configuration
+ integer, pointer :: config_vert_levels, config_sea_mount_vert_levels
+
+ iErr = 0
+
+ call mpas_pool_get_config(configPool, 'config_init_configuration', config_init_configuration)
+
+ if(config_init_configuration .ne. trim('sea_mount')) return
+
+ call mpas_pool_get_config(configPool, 'config_vert_levels', config_vert_levels)
+ call mpas_pool_get_config(configPool, 'config_sea_mount_vert_levels', config_sea_mount_vert_levels)
+
+ if(config_vert_levels <= 0 .and. config_sea_mount_vert_levels > 0) then
+ config_vert_levels = config_sea_mount_vert_levels
+ else if (config_vert_levels <= 0) then
+ write(stderrUnit,*) 'ERROR: Validation failed for sea mount. Not given a usable value for vertical levels.'
+ iErr = 1
+ end if
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_validate_sea_mount!}}}
+
+!***********************************************************************
+
+end module ocn_init_sea_mount
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_soma.F b/src/core_ocean/mode_init/mpas_ocn_init_soma.F
new file mode 100644
index 0000000000..fce8e854cb
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_soma.F
@@ -0,0 +1,417 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_soma
+!
+!> \brief MPAS ocean initialize case -- Simulating Ocean Mesoscale Activity (SOMA)
+!> \author Todd Ringler
+!> \date 10/08/2013
+!> \details
+!> This module contains the routines for initializing the
+!> the idealized SOMA test case
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_soma
+
+ use mpas_kind_types
+ use mpas_io_units
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+
+ use ocn_constants
+ use ocn_init_vertical_grids
+ use ocn_init_cell_markers
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_setup_soma, &
+ ocn_init_validate_soma
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_setup_soma
+!
+!> \brief Setup for soma test case
+!> \author Todd Ringler
+!> \date 02/26/2014
+!> \details
+!> This routine sets up the initial conditions for the
+!> SOMA configuration.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_soma(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ ! local work variables
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool, verticalMeshPool, statePool, forcingPool, tracersPool
+ type (mpas_pool_type), pointer :: tracersSurfaceRestoringFieldsPool, tracersInteriorRestoringFieldsPool
+
+ integer :: iCell, k
+ real (kind=RKIND) :: distance, deltaLon, deltaLat, xDistance, yDistance, zMid, sphereRadius
+ real (kind=RKIND) :: lonCurrent, latCurrent
+ real (kind=RKIND) :: deltay, depth, factor, latCenter, lonCenter, windStress
+ real (kind=RKIND) :: temperature, salinity
+ real (kind=RKIND), dimension(:), pointer :: interfaceLocations
+
+ ! Define config variable pointers
+ character (len=StrKIND), pointer :: config_init_configuration, config_vertical_grid
+
+ ! SOMA test case run-time configuration parameters
+ integer, pointer :: config_soma_vert_levels
+ real (kind=RKIND), pointer :: config_eos_linear_alpha
+ real (kind=RKIND), pointer :: config_soma_surface_salinity
+ real (kind=RKIND), pointer :: config_soma_surface_temperature
+ real (kind=RKIND), pointer :: config_soma_density_difference_linear
+ real (kind=RKIND), pointer :: config_soma_thermocline_depth
+ real (kind=RKIND), pointer :: config_soma_center_latitude
+ real (kind=RKIND), pointer :: config_soma_center_longitude
+ real (kind=RKIND), pointer :: config_soma_domain_width
+ real (kind=RKIND), pointer :: config_soma_shelf_width
+ real (kind=RKIND), pointer :: config_soma_shelf_depth
+ real (kind=RKIND), pointer :: config_soma_bottom_depth
+ real (kind=RKIND), pointer :: config_soma_phi
+ real (kind=RKIND), pointer :: config_soma_ref_density
+ real (kind=RKIND), pointer :: config_soma_density_difference
+
+ ! Define dimension pointers
+ integer, pointer :: nVertLevels, nCells, nVertLevelsP1
+ integer, pointer :: index_temperature, index_salinity, index_tracer1
+
+ ! Define variable pointers
+ logical, pointer :: on_a_sphere
+ integer, dimension(:), pointer :: maxLevelCell
+ real (kind=RKIND), dimension(:), pointer :: refBottomDepth, bottomCell, refZMid
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness, restingThickness
+ real (kind=RKIND), pointer :: sphere_radius
+ real (kind=RKIND), dimension(:), pointer :: lonCell, latCell, bottomDepth
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers, debugTracers
+ real (kind=RKIND), dimension(:), pointer :: sensibleHeatFlux
+ real (kind=RKIND), dimension(:), pointer :: windStressZonal, windStressMeridional
+ real (kind=RKIND), dimension(:, :), pointer :: activeTracersPistonVelocity, activeTracersSurfaceRestoringValue
+ real (kind=RKIND), dimension(:, :, :), pointer :: activeTracersInteriorRestoringValue, activeTracersInteriorRestoringRate
+
+ ! assume no error
+ iErr = 0
+
+ ! test if SOMA is the desired configuration
+ call mpas_pool_get_config(domain % configs, 'config_init_configuration', config_init_configuration)
+ if(config_init_configuration .ne. trim('soma')) return
+
+ ! get config variables
+ call mpas_pool_get_config(domain % configs, 'config_eos_linear_alpha', config_eos_linear_alpha)
+ call mpas_pool_get_config(domain % configs, 'config_soma_density_difference_linear', config_soma_density_difference_linear)
+ call mpas_pool_get_config(domain % configs, 'config_soma_thermocline_depth', config_soma_thermocline_depth)
+ call mpas_pool_get_config(domain % configs, 'config_soma_surface_temperature', config_soma_surface_temperature)
+ call mpas_pool_get_config(domain % configs, 'config_soma_surface_salinity', config_soma_surface_salinity)
+ call mpas_pool_get_config(domain % configs, 'config_vertical_grid', config_vertical_grid)
+ call mpas_pool_get_config(domain % configs, 'config_soma_vert_levels', config_soma_vert_levels)
+ call mpas_pool_get_config(domain % configs, 'config_soma_center_latitude', config_soma_center_latitude)
+ call mpas_pool_get_config(domain % configs, 'config_soma_center_longitude', config_soma_center_longitude)
+ call mpas_pool_get_config(domain % configs, 'config_soma_domain_width', config_soma_domain_width)
+ call mpas_pool_get_config(domain % configs, 'config_soma_shelf_width', config_soma_shelf_width)
+ call mpas_pool_get_config(domain % configs, 'config_soma_shelf_depth', config_soma_shelf_depth)
+ call mpas_pool_get_config(domain % configs, 'config_soma_bottom_depth', config_soma_bottom_depth)
+ call mpas_pool_get_config(domain % configs, 'config_soma_phi', config_soma_phi)
+ call mpas_pool_get_config(domain % configs, 'config_soma_ref_density', config_soma_ref_density)
+ call mpas_pool_get_config(domain % configs, 'config_soma_density_difference', config_soma_density_difference)
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevelsP1', nVertLevelsP1)
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+ call mpas_pool_get_config(meshPool, 'sphere_radius', sphere_radius)
+ sphereRadius = sphere_radius
+
+ ! error checking
+ if(.not. on_a_sphere) then
+ write(stderrUnit, *) 'ERROR: SOMA test case can only be defined on a spherical mesh.'
+ iErr = 1
+ return
+ else
+ write(stderrUnit, *) 'SOMA test case using spherical radius of size: ', sphereRadius
+ end if
+
+ ! Define interface locations
+ allocate( interfaceLocations( nVertLevelsP1 ) )
+ call ocn_generate_vertical_grid( config_vertical_grid, interfaceLocations )
+
+ ! assign config variables
+ nVertLevels = config_soma_vert_levels
+ nVertLevelsP1 = nVertLevels + 1
+
+ ! set center of SOMA domain
+ ! Convert center locations to radians from degrees
+ latCenter = config_soma_center_latitude * pii / 180.0_RKIND
+ lonCenter = config_soma_center_longitude * pii / 180.0_RKIND
+
+ ! Setup the vertical grid and layerThickness initial condition
+ write(stderrUnit,*) 'setting up vertical grid and layer thickness'
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_array(verticalMeshPool, 'restingThickness', restingThickness)
+ call mpas_pool_get_array(verticalMeshPool, 'refZMid', refZMid)
+
+ ! Set layerThickness and restingThickness
+ ! Uniform layer thickness across lat/lon
+ do k = 1, nVertLevels
+ layerThickness(k, :) = config_soma_bottom_depth * ( interfaceLocations(k+1) - interfaceLocations(k) )
+ restingThickness(k, :) = layerThickness(k, :)
+ end do
+
+ ! Set refBottomDepth
+ do k = 1, nVertLevels
+ refBottomDepth(k) = config_soma_bottom_depth * interfaceLocations(k+1)
+ refZMid(k) = -config_soma_bottom_depth * (interfaceLocations(k)+interfaceLocations(k+1))/2.0_RKIND
+ end do
+
+ block_ptr => block_ptr % next
+
+ end do
+
+ ! Set bathymetry
+ write(stderrUnit,*) 'setting up bathymetry'
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_array(meshPool, 'lonCell', lonCell)
+ call mpas_pool_get_array(meshPool, 'latCell', latCell)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+
+ ! set bottomDepth
+ bottomDepth(:) = 0.0_RKIND
+ do iCell = 1, nCells
+ lonCurrent = lonCell(iCell)
+ latCurrent = latCell(iCell)
+
+ deltaLon = abs(lonCurrent - lonCenter)
+ if (deltaLon .gt. pii) deltaLon = deltaLon - 2.0_RKIND*pii
+ deltaLat = latCurrent - latCenter
+ xDistance = deltaLon * sphereRadius * cos(latCurrent)
+ yDistance = deltaLat * sphereRadius
+ distance = sqrt( xDistance**2 + yDistance**2 )
+ factor = 1.0 - distance**2 / config_soma_domain_width**2
+
+ if(factor > config_soma_shelf_width) then
+ bottomDepth(iCell) = config_soma_shelf_depth + (config_soma_bottom_depth-config_soma_shelf_depth)/2.0_RKIND &
+ * (1.0 + tanh(factor/config_soma_phi))
+ else
+ bottomDepth(iCell) = -1.0_RKIND
+ endif
+
+ ! Set maxLevelCell to -1 for cells to be culled
+ if (bottomDepth(iCell) > 0.0_RKIND) then
+ maxLevelCell(iCell) = 1
+ else
+ maxLevelCell(iCell) = -1
+ endif
+
+ ! Determine maxLevelCell based on bottomDepth and refBottomDepth
+ ! Also set botomDepth based on refBottomDepth, since
+ ! above bottomDepth was set with continuous analytical functions,
+ ! and needs to be discrete
+ if (maxLevelCell(iCell) > 0) then
+ maxLevelCell(iCell) = nVertLevels
+ if (nVertLevels .gt. 1) then
+ do k = 1, nVertLevels
+ if (bottomDepth(iCell) < refBottomDepth(k) ) then
+ maxLevelCell(iCell) = k-1
+ bottomDepth(iCell) = refBottomDepth(k-1)
+ exit
+ end if
+ end do
+ end if
+ end if
+
+ enddo ! Looping through with iCell
+
+ block_ptr => block_ptr % next
+
+ enddo ! done setting bathymetry
+
+ ! mark cells for culling
+ block_ptr => domain % blocklist
+ do while (associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call ocn_mark_maxlevelcell(meshPool, iErr)
+ block_ptr => block_ptr % next
+ end do
+
+ ! Set forcing boundary conditions and initial conditions for temperature and salinity
+ write(stderrUnit,*) 'setting up forcing and initial T/S conditions'
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_array(meshPool, 'lonCell', lonCell)
+ call mpas_pool_get_array(meshPool, 'latCell', latCell)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', index_temperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', index_salinity)
+ call mpas_pool_get_dimension(tracersPool, 'index_tracer1', index_tracer1)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+ call mpas_pool_get_array(tracersPool, 'debugTracers', debugTracers, 1)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_array(verticalMeshPool, 'refZMid', refZMid)
+ call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool)
+ call mpas_pool_get_array(forcingPool, 'sensibleHeatFlux', sensibleHeatFlux)
+ call mpas_pool_get_array(forcingPool, 'windStressZonal', windStressZonal)
+ call mpas_pool_get_array(forcingPool, 'windStressMeridional', windStressMeridional, 1)
+ call mpas_pool_get_subpool(forcingPool, 'tracersSurfaceRestoringFields', tracersSurfaceRestoringFieldsPool)
+ call mpas_pool_get_subpool(forcingPool, 'tracersInteriorRestoringFields', tracersInteriorRestoringFieldsPool)
+ call mpas_pool_get_array(tracersSurfaceRestoringFieldsPool, 'activeTracersPistonVelocity', activeTracersPistonVelocity, 1)
+ call mpas_pool_get_array(tracersSurfaceRestoringFieldsPool, 'activeTracersSurfaceRestoringValue', &
+ activeTracersSurfaceRestoringValue, 1)
+ call mpas_pool_get_array(tracersInteriorRestoringFieldsPool, 'activeTracersInteriorRestoringRate', &
+ activeTracersInteriorRestoringRate, 1)
+ call mpas_pool_get_array(tracersInteriorRestoringFieldsPool, 'activeTracersInteriorRestoringValue', &
+ activeTracersInteriorRestoringValue, 1)
+
+ do iCell = 1, nCells
+ lonCurrent = lonCell(iCell)
+ latCurrent = latCell(iCell)
+
+ ! Set initial temperature and salinity
+ do k = 1, nVertLevels
+ zMid = refZMid(k)
+
+ distance = config_soma_ref_density &
+ - (1.0_RKIND - config_soma_density_difference_linear) * config_soma_density_difference &
+ * tanh(zMid / config_soma_thermocline_depth) - config_soma_density_difference_linear &
+ * config_soma_density_difference * zMid / config_soma_bottom_depth
+ factor = (config_soma_ref_density - distance) / config_eos_linear_alpha
+ temperature = config_soma_surface_temperature + factor
+
+ factor = - zMid / config_soma_bottom_depth
+ salinity = config_soma_surface_salinity + factor
+
+ if ( associated(activeTracers) ) then
+ activeTracers(index_temperature, k, iCell) = temperature
+ activeTracers(index_salinity, k, iCell) = salinity
+ end if
+
+ enddo
+
+ ! Set up debugging tracers
+ if ( associated(debugTracers) ) then
+ debugTracers(index_tracer1, :, iCell) = 1.0_RKIND
+ end if
+
+ end do ! iCell = 1, nCells
+
+ ! Set wind stress
+ do iCell = 1, nCells
+ lonCurrent = lonCell(iCell)
+ latCurrent = latCell(iCell)
+
+ deltay = sphereRadius * ( latCurrent - latCenter )
+ factor = 1.0_RKIND - 0.5 * deltay / config_soma_domain_width
+ windstress = factor * 0.1 * exp( -(deltay / config_soma_domain_width)**2 ) &
+ * cos(pii * deltay / config_soma_domain_width)
+
+ windStressZonal(iCell) = windStress
+ windStressMeridional(iCell) = 0.0_RKIND
+
+ end do
+
+ block_ptr => block_ptr % next
+ end do
+
+ write(stderrUnit,*) 'exiting ocn_init_setup_soma'
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_setup_soma!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_validate_soma
+!
+!> \brief Validation for SOMA test case
+!> \author Todd Ringler
+!> \date 02/26/2014
+!> \details
+!> This routine validates the configuration options for the SOMA test case.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_validate_soma(configPool, packagePool, iocontext, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (mpas_pool_type), intent(inout) :: configPool, packagePool
+ type (mpas_io_context_type), intent(inout) :: iocontext
+ integer, intent(out) :: iErr
+
+ character (len=StrKIND), pointer :: config_init_configuration
+ integer, pointer :: config_vert_levels, config_soma_vert_levels
+
+ iErr = 0
+
+ call mpas_pool_get_config(configPool, 'config_init_configuration', config_init_configuration)
+ if(config_init_configuration .ne. trim('soma')) return
+
+ call mpas_pool_get_config(configPool, 'config_vert_levels', config_vert_levels)
+ call mpas_pool_get_config(configPool, 'config_soma_vert_levels', config_soma_vert_levels)
+
+ if(config_vert_levels <= 0 .and. config_soma_vert_levels > 0) then
+ config_vert_levels = config_soma_vert_levels
+ else if (config_vert_levels <= 0) then
+ write(stderrUnit,*) 'ERROR: Validation failed for SOMA. Not given a usable value for vertical levels.'
+ iErr = 1
+ end if
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_validate_soma!}}}
+
+end module ocn_init_soma
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_spherical_utils.F b/src/core_ocean/mode_init/mpas_ocn_init_spherical_utils.F
new file mode 100644
index 0000000000..778513ea1e
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_spherical_utils.F
@@ -0,0 +1,622 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_spherical_utils
+!
+!> \brief MPAS ocean spherical utilities
+!> \author Doug Jacobsen
+!> \date 03/20/2015
+!> \details
+!> This module contains the routines for updating mesh quantities based on a spherical radius
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_spherical_utils
+
+ use mpas_kind_types
+ use mpas_io_units
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+ use mpas_stream_manager
+
+ implicit none
+ private
+
+ public :: ocn_init_expand_sphere, ocn_transform_from_lonlat_to_xyz
+ public :: transform_from_xyz_to_lonlat, ocn_unit_vector_in_3space
+ public :: ocn_vector_on_tangent_plane, ocn_cross_product_in_3space
+ public :: ocn_init_set_pools_sphere_radius
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_expand_sphere
+!
+!> \brief MPAS-Ocean Spherical Expansion Routine
+!> \author Doug Jacobsen
+!> \date 03/20/2015
+!> \details
+!> This routine expands mesh quantities to sphere of radius newRadius.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_expand_sphere(domain, stream_manager, newRadius, err)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ type (mpas_streamManager_type), intent(inout) :: stream_manager
+ real (kind=RKIND), intent(in) :: newRadius
+ integer, intent(out) :: err
+
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool
+
+ character (len=StrKIND) :: streamID
+ integer :: directionProperty
+
+ logical, pointer :: config_expand_sphere, config_realistic_coriolis_parameter
+ logical, pointer :: on_a_sphere
+ real (kind=RKIND), pointer :: sphere_radius
+
+ integer, pointer :: nCells, nCellsSolve, nEdgesSolve, nVerticesSolve, vertexDegree
+
+ integer, dimension(:, :), pointer :: cellsOnVertex
+
+ real (kind=RKIND), dimension(:), pointer :: areaCell, areaTriangle
+ real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge
+ real (kind=RKIND), dimension(:), pointer :: fCell, fEdge, fVertex
+ real (kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell, latCell, lonCell
+ real (kind=RKIND), dimension(:), pointer :: xEdge, yEdge, zEdge, latEdge, lonEdge
+ real (kind=RKIND), dimension(:), pointer :: xVertex, yVertex, zVertex, latVertex, lonVertex
+ real (kind=RKIND), dimension(:, :), pointer :: kiteAreasOnVertex
+
+ real (kind=RKIND) :: oldRadius, ratio
+ real (kind=RKIND) :: norm
+ real (kind=RKIND) :: oldX, oldY, oldZ
+ integer :: iCell, iEdge, iVertex, i
+
+ err = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_expand_sphere', config_expand_sphere)
+
+ if ( .not. config_expand_sphere ) return
+
+ call mpas_pool_get_config(domain % configs, 'config_realistic_coriolis_parameter', config_realistic_coriolis_parameter)
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool)
+
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+ call mpas_pool_get_config(meshPool, 'sphere_radius', sphere_radius)
+
+ if ( .not. on_a_sphere ) then
+ write(stderrUnit, *) 'Warning: Only spherical meshes can been expanded.'
+ write(stderrUnit, *) 'Skipping expansion'
+ return
+ end if
+
+ if ( sphere_radius == 0.0_RKIND ) then
+ write(stderrUnit, *) 'ERROR: Sphere radius is 0.0'
+ err = 1
+ return
+ end if
+
+ write(stderrUnit, *) 'Expanding mesh to a radius of size: ', newRadius, 'm'
+
+ call mpas_stream_mgr_begin_iteration(stream_manager)
+ do while (mpas_stream_mgr_get_next_stream(stream_manager, streamID, directionProperty))
+ if ( directionProperty == MPAS_STREAM_OUTPUT .or. directionProperty == MPAS_STREAM_INPUT_OUTPUT ) then
+ call mpas_stream_mgr_add_att(stream_manager, 'sphere_radius', newRadius, streamID)
+ end if
+ end do
+
+ oldRadius = sphere_radius
+ ratio = newRadius / oldRadius
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call ocn_init_set_pools_sphere_radius(block_ptr % structs, newRadius)
+
+ ! Expand cell quantities
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
+ call mpas_pool_get_dimension(meshPool, 'nVerticesSolve', nVerticesSolve)
+ call mpas_pool_get_dimension(meshPool, 'vertexDegree', vertexDegree)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'zCell', zCell)
+ call mpas_pool_get_array(meshPool, 'latCell', latCell)
+ call mpas_pool_get_array(meshPool, 'lonCell', lonCell)
+ call mpas_pool_get_array(meshPool, 'areaCell', areaCell)
+ call mpas_pool_get_array(meshPool, 'fCell', fCell)
+
+ call mpas_pool_get_array(meshPool, 'xEdge', xEdge)
+ call mpas_pool_get_array(meshPool, 'yEdge', yEdge)
+ call mpas_pool_get_array(meshPool, 'zEdge', zEdge)
+ call mpas_pool_get_array(meshPool, 'latEdge', latEdge)
+ call mpas_pool_get_array(meshPool, 'lonEdge', lonEdge)
+ call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge)
+ call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
+ call mpas_pool_get_array(meshPool, 'fEdge', fEdge)
+
+ call mpas_pool_get_array(meshPool, 'xVertex', xVertex)
+ call mpas_pool_get_array(meshPool, 'yVertex', yVertex)
+ call mpas_pool_get_array(meshPool, 'zVertex', zVertex)
+ call mpas_pool_get_array(meshPool, 'latVertex', latVertex)
+ call mpas_pool_get_array(meshPool, 'lonVertex', lonVertex)
+ call mpas_pool_get_array(meshPool, 'areaTriangle', areaTriangle)
+ call mpas_pool_get_array(meshPool, 'kiteAreasOnVertex', kiteAreasOnVertex)
+ call mpas_pool_get_array(meshPool, 'cellsOnVertex', cellsOnVertex)
+ call mpas_pool_get_array(meshPool, 'fVertex', fVertex)
+
+ do iCell = 1, nCellsSolve
+ oldX = xCell(iCell)
+ oldY = yCell(iCell)
+ oldZ = zCell(iCell)
+
+ norm = sqrt(oldX**2 + oldY**2 + oldZ**2)
+
+ xCell(iCell) = (oldX / norm) * newRadius
+ yCell(iCell) = (oldY / norm) * newRadius
+ zCell(iCell) = (oldZ / norm) * newRadius
+ areaCell(iCell) = (areaCell(iCell) / (oldRadius**2) )* newRadius**2
+
+ if(config_realistic_coriolis_parameter) then
+ fCell(iCell) = 2.0_RKIND * omega * sin(latCell(iCell))
+ end if
+ end do
+
+ ! Expand vertex quantities
+ do iVertex = 1, nVerticesSolve
+ oldX = xVertex(iVertex)
+ oldY = yVertex(iVertex)
+ oldZ = zVertex(iVertex)
+
+ norm = sqrt(oldX**2 + oldY**2 + oldZ**2)
+
+ xVertex(iVertex) = (oldX / norm) * newRadius
+ yVertex(iVertex) = (oldY / norm) * newRadius
+ zVertex(iVertex) = (oldZ / norm) * newRadius
+ areaTriangle(iVertex) = 0.0_RKIND
+
+ do i = 1, vertexDegree
+ if (cellsOnVertex(i, iVertex) < nCells+1) then
+ kiteAreasOnVertex(i, iVertex) = ( kiteAreasOnVertex(i, iVertex) / oldRadius**2) * newRadius**2
+ else
+ kiteAreasOnVertex(i, iVertex) = 0.0_RKIND
+ end if
+ areaTriangle(iVertex) = areaTriangle(iVertex) + kiteAreasOnVertex(i, iVertex)
+ end do
+
+ if(config_realistic_coriolis_parameter) then
+ fVertex(iVertex) = 2.0_RKIND * omega * sin( latVertex(iVertex) )
+ end if
+ end do
+
+ ! Expand edge quantities
+ do iEdge = 1, nEdgesSolve
+ oldX = xEdge(iEdge)
+ oldY = yEdge(iEdge)
+ oldZ = zEdge(iEdge)
+
+ norm = sqrt(oldX**2 + oldY**2 + oldZ**2)
+
+ xEdge(iEdge) = (oldX / norm) * newRadius
+ yEdge(iEdge) = (oldY / norm) * newRadius
+ zEdge(iEdge) = (oldZ / norm) * newRadius
+ dvEdge(iEdge) = (dvEdge(iEdge) / oldRadius) * newRadius
+ dcEdge(iEdge) = (dcEdge(iEdge) / oldRadius) * newRadius
+
+ if(config_realistic_coriolis_parameter) then
+ fEdge(iEdge) = 2.0_RKIND * omega * sin( latEdge(iEdge) )
+ end if
+ end do
+
+ block_ptr % domain % sphere_radius = newRadius
+ sphere_radius = newRadius
+ block_ptr => block_ptr % next
+
+ end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_expand_sphere!}}}
+
+!***********************************************************************
+!
+! recursive routine ocn_init_set_pools_sphere_radius
+!
+!> \brief MPAS-Ocean Sphere radius update routine
+!> \author Doug Jacobsen
+!> \date 09/09/2015
+!> \details
+!> This routine updates the value of sphere_radius in all pools that contain
+!> it.
+!
+!-----------------------------------------------------------------------
+ recursive subroutine ocn_init_set_pools_sphere_radius(inPool, newRadius)!{{{
+ type (mpas_pool_type), intent(inout) :: inPool
+ real (kind=RKIND), intent(in) :: newRadius
+
+ type (mpas_pool_type), pointer :: subPool
+ type (mpas_pool_iterator_type) :: poolItr
+ real (kind=RKIND), pointer :: sphere_radius
+
+ call mpas_pool_begin_iteration(inPool)
+
+ do while ( mpas_pool_get_next_member(inPool, poolItr) )
+ if ( poolItr % memberType == MPAS_POOL_SUBPOOL ) then
+ call mpas_pool_get_subpool(inPool, poolItr % memberName, subPool)
+ call ocn_init_set_pools_sphere_radius(subPool, newRadius)
+ else if ( poolItr % memberType == MPAS_POOL_CONFIG ) then
+
+ if ( poolItr % memberName == 'sphere_radius' ) then
+ call mpas_pool_get_config(inPool, poolItr % memberName, sphere_radius)
+ sphere_radius = newRadius
+ end if
+
+ end if
+ end do
+
+ end subroutine ocn_init_set_pools_sphere_radius!}}}
+
+!***********************************************************************
+!
+! routine ocn_transform_from_lonlat_to_xyz
+!
+!> \brief MPAS-Ocean Tranform LatLon to XYZ
+!> \author Todd Ringler
+!> \date 02/19/2014
+!> \details
+!> This routine converts a (lat, lon) coordinate into an (x, y, z) coordinate
+!> INTENT(IN)
+!> xin = x position
+!> yin = y position
+!> zin = z position
+!> ulon = east component of vector
+!> ulat = north component of vector
+!>
+!> INTENT(OUT)
+!> ux = x component of vector
+!> uy = y component of vector
+!> uz = z component of vector
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_transform_from_lonlat_to_xyz(xin, yin, zin, ulon, ulat, ux, uy, uz)!{{{
+ implicit none
+ real, intent(in) :: xin, yin, zin, ulon, ulat
+ real, intent(out) :: ux, uy, uz
+ real :: h(3,3), p(3), q(3), g(3), X1(3,3), X2(3,3), trans_X2_to_X1(3,3), r
+ integer :: i,j,k
+ logical :: l_Pole
+ real, parameter :: epsvt = 1.0e-10_RKIND
+
+ !-----------------------------------------------------------------------
+ ! define the e1, e2, and e3 directions
+ !-----------------------------------------------------------------------
+ X1(1,1) = 1.0_RKIND; X1(1,2) = 0.0_RKIND; X1(1,3) = 0.0_RKIND
+ X1(2,1) = 0.0_RKIND; X1(2,2) = 1.0_RKIND; X1(2,3) = 0.0_RKIND
+ X1(3,1) = 0.0_RKIND; X1(3,2) = 0.0_RKIND; X1(3,3) = 1.0_RKIND
+
+ !-----------------------------------------------------------------------
+ ! find the vectors (measured in X1) that point in the local
+ ! east (h(1,:)), north (h(2,:)), and vertical (h(3,:)) direction
+ !-----------------------------------------------------------------------
+ h(3,1) = xin; h(3,2) = yin; h(3,3) = zin
+ call ocn_unit_vector_in_3space(h(3,:))
+
+ !-----------------------------------------------------------------------
+ ! g(:) is a work array and holds the vector pointing to the North Pole.
+ ! measured in X1
+ !-----------------------------------------------------------------------
+ g(:) = X1(3,:)
+
+ !-----------------------------------------------------------------------
+ ! determine if the local vertical hits a pole
+ !-----------------------------------------------------------------------
+ l_Pole = .false.
+ r = g(1)*h(3,1) + g(2)*h(3,2) + g(3)*h(3,3)
+ r = abs(r) + epsvt
+ if(r.gt.1.0_RKIND) then
+ l_Pole = .true.
+ h(3,:) = h(3,:) + epsvt
+ call ocn_unit_vector_in_3space(h(3,:))
+ endif
+
+ !-----------------------------------------------------------------------
+ ! find the vector that is perpendicular to the local vertical vector
+ ! and points in the direction of of the North pole, this defines the local
+ ! north direction. measured in X1
+ !-----------------------------------------------------------------------
+ call ocn_vector_on_tangent_plane ( h(3,:), g(:), h(2,:) )
+
+ !-----------------------------------------------------------------------
+ ! take the cross product of the local North direction and the local vertical
+ ! to find the local east vector. still in X1
+ !-----------------------------------------------------------------------
+ call ocn_cross_product_in_3space ( h(2,:), h(3,:), h(1,:) )
+
+ !-----------------------------------------------------------------------
+ ! put these 3 vectors into a matrix X2
+ !-----------------------------------------------------------------------
+ X2(1,:) = h(1,:) ! local east (measured in X1)
+ X2(2,:) = h(2,:) ! local north (measured in X1)
+ X2(3,:) = h(3,:) ! local vertical (measured in X1)
+
+ !-----------------------------------------------------------------------
+ ! compute the transformation matrix
+ !-----------------------------------------------------------------------
+ trans_X2_to_X1(:,:) = matmul(X1,transpose(X2))
+
+ !-----------------------------------------------------------------------
+ ! transform (ulon, ulat) into (x,y,z)
+ !-----------------------------------------------------------------------
+ p(1) = ulon; p(2) = ulat; p(3) = 0
+ g(:) = matmul(trans_X2_to_X1(:, :), p(:))
+ ux = g(1); uy = g(2); uz = g(3)
+
+ end subroutine ocn_transform_from_lonlat_to_xyz!}}}
+
+!***********************************************************************
+!
+! routine ocn_transform_from_xyz_to_lonlat
+!
+!> \brief MPAS-Ocean transform XYZ to LatLon
+!> \author Todd Ringler
+!> \date 02/19/2014
+!> \details
+!> This routine converts an (x, y, z) coordinate into a (lat, lon) coordinate
+!> INTENT(IN)
+!> xin = x position
+!> yin = y position
+!> zin = z position
+!> ux = x component of vector
+!> uy = y component of vector
+!> uz = z component of vector
+!>
+!> INTENT(OUT)
+!> ulon = east component of vector
+!> ulat = north component of vector
+!
+!-----------------------------------------------------------------------
+ subroutine transform_from_xyz_to_lonlat(xin, yin, zin, ux, uy, uz, ulon, ulat)!{{{
+ implicit none
+ real, intent(in) :: xin, yin, zin, ux, uy, uz
+ real, intent(out) :: ulon, ulat
+ real :: h(3,3), p(3), q(3), g(3), X1(3,3), X2(3,3), trans_X1_to_X2(3,3), r
+ integer :: i,j,k
+ logical :: l_Pole
+ real, parameter :: epsvt = 1.0e-10_RKIND
+
+ !-----------------------------------------------------------------------
+ ! define the e1, e2, and e3 directions
+ !-----------------------------------------------------------------------
+ X1(1,1) = 1.0_RKIND; X1(1,2) = 0.0_RKIND; X1(1,3) = 0.0_RKIND
+ X1(2,1) = 0.0_RKIND; X1(2,2) = 1.0_RKIND; X1(2,3) = 0.0_RKIND
+ X1(3,1) = 0.0_RKIND; X1(3,2) = 0.0_RKIND; X1(3,3) = 1.0_RKIND
+
+ !-----------------------------------------------------------------------
+ ! find the vectors (measured in X1) that point in the local
+ ! east (h(1,:)), north (h(2,:)), and vertical (h(3,:)) direction
+ !-----------------------------------------------------------------------
+ h(3,1) = xin; h(3,2) = yin; h(3,3) = zin
+ call ocn_unit_vector_in_3space(h(3,:))
+
+ !-----------------------------------------------------------------------
+ ! g(:) is a work array and holds the vector pointing to the North Pole.
+ ! measured in X1
+ !-----------------------------------------------------------------------
+ g(:) = X1(3,:)
+
+ !-----------------------------------------------------------------------
+ ! determine if the local vertical hits a pole
+ !-----------------------------------------------------------------------
+ l_Pole = .false.
+ r = g(1)*h(3,1) + g(2)*h(3,2) + g(3)*h(3,3)
+ r = abs(r) + epsvt
+ if(r.gt.1.0_RKIND) then
+ l_Pole = .true.
+ h(3,:) = h(3,:) + epsvt
+ call ocn_unit_vector_in_3space(h(3,:))
+ endif
+
+ !-----------------------------------------------------------------------
+ ! find the vector that is perpendicular to the local vertical vector
+ ! and points in the direction of of the North pole, this defines the local
+ ! north direction. measured in X1
+ !-----------------------------------------------------------------------
+ call ocn_vector_on_tangent_plane ( h(3,:), g(:), h(2,:) )
+
+ !-----------------------------------------------------------------------
+ ! take the cross product of the local North direction and the local vertical
+ ! to find the local east vector. still in X1
+ !-----------------------------------------------------------------------
+ call ocn_cross_product_in_3space ( h(2,:), h(3,:), h(1,:) )
+
+ !-----------------------------------------------------------------------
+ ! put these 3 vectors into a matrix X2
+ !-----------------------------------------------------------------------
+ X2(1,:) = h(1,:) ! local east (measured in X1)
+ X2(2,:) = h(2,:) ! local north (measured in X1)
+ X2(3,:) = h(3,:) ! local vertical (measured in X1)
+
+ !-----------------------------------------------------------------------
+ ! compute the transformation matrix
+ !-----------------------------------------------------------------------
+ trans_X1_to_X2(:,:) = matmul(X2,transpose(X1))
+
+ !-----------------------------------------------------------------------
+ ! transform (ulon, ulat) into (x,y,z)
+ !-----------------------------------------------------------------------
+ p(1) = ux; p(2) = uy; p(3) = uz
+ g(:) = matmul(trans_X1_to_X2(:, :), p(:))
+ ulon = g(1); ulat= g(2);
+
+ end subroutine transform_from_xyz_to_lonlat!}}}
+
+!***********************************************************************
+!
+! routine ocn_unit_vector_in_3space
+!
+!> \brief MPAS-Ocean 3D unit vector
+!> \author Todd Ringler
+!> \date 02/19/2014
+!> \details
+!> This routine normalizes a vector in 3space.
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_unit_vector_in_3space (p_1)!{{{
+
+ !-----------------------------------------------------------------------
+ ! PURPOSE : normalize p_1 to unit length and overwrite p_1
+ !-----------------------------------------------------------------------
+
+ !-----------------------------------------------------------------------
+ ! intent(inout)
+ !-----------------------------------------------------------------------
+ real , intent(inout) :: &
+ p_1 (:)
+
+ !-----------------------------------------------------------------------
+ ! local
+ !-----------------------------------------------------------------------
+ real :: length
+
+ length = SQRT (p_1(1)**2 + p_1(2)**2 + p_1(3)**2 )
+ length = 1.0_RKIND/length
+ p_1(1) = p_1(1)*length
+ p_1(2) = p_1(2)*length
+ p_1(3) = p_1(3)*length
+
+ end subroutine ocn_unit_vector_in_3space!}}}
+
+!***********************************************************************
+!
+! routine ocn_vector_on_tangent_plane
+!
+!> \brief MPAS-Ocean Vector on a tangent plane
+!> \author Todd Ringler
+!> \date 02/19/2014
+!> \details
+!> Given two points measured in (x,y,z) and lying on
+!> the unit sphere, find the vector (p_out) that lies on the plane
+!> perpendicular to the p_1 vector and points in the direction of
+!> the projection of p_2 onto the tangent plane.
+!>
+!> NOTE : p_1 and p_2 are assumed to be of unit length
+!> NOTE : p_out is normalized to unit length
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_vector_on_tangent_plane(p_1, p_2, p_out)!{{{
+!-----------------------------------------------------------------------
+! intent(in)
+!-----------------------------------------------------------------------
+ real , intent(in) :: &
+ p_1 (:), &
+ p_2 (:)
+
+!-----------------------------------------------------------------------
+! intent(out)
+!-----------------------------------------------------------------------
+ real , intent(out) :: &
+ p_out (:)
+
+!-----------------------------------------------------------------------
+! local
+!-----------------------------------------------------------------------
+ real :: &
+ work (3), t1(3), t2(3)
+
+! work (1) = - p_1(2) * ( -p_1(2) * p_2(1) + p_1(1) * p_2(2) ) &
+! + p_1(3) * ( p_1(3) * p_2(1) - p_1(1) * p_2(3) )
+
+! work (2) = + p_1(1) * ( -p_1(2) * p_2(1) + p_1(1) * p_2(2) ) &
+! - p_1(3) * ( -p_1(3) * p_2(2) + p_1(2) * p_2(3) )
+
+! work (3) = - p_1(1) * ( p_1(3) * p_2(1) - p_1(1) * p_2(3) ) &
+! + p_1(2) * ( -p_1(3) * p_2(2) + p_1(2) * p_2(3) )
+
+
+ t1(:) = p_2(:) - p_1(:)
+ t2(:) = p_1
+
+ call ocn_unit_vector_in_3space (t1)
+ call ocn_unit_vector_in_3space (t2)
+
+ call ocn_cross_product_in_3space(t1(:), t2(:), work(:))
+ call ocn_unit_vector_in_3space (work)
+ call ocn_cross_product_in_3space(t2(:),work(:),p_out(:))
+ call ocn_unit_vector_in_3space (p_out)
+
+ end subroutine ocn_vector_on_tangent_plane!}}}
+
+!***********************************************************************
+!
+! routine ocn_cross_product_in_3space
+!
+!> \brief MPAS-Ocean Cross product in 3D
+!> \author Todd Ringler
+!> \date 02/19/2014
+!> \details
+!> compute p_1 cross p_2 and place in p_out
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_cross_product_in_3space(p_1,p_2,p_out)!{{{
+!-----------------------------------------------------------------------
+! intent(in)
+!-----------------------------------------------------------------------
+ real , intent(in) :: &
+ p_1 (:), &
+ p_2 (:)
+
+!-----------------------------------------------------------------------
+! intent(out)
+!-----------------------------------------------------------------------
+ real , intent(out) :: &
+ p_out (:)
+
+ p_out(1) = p_1(2)*p_2(3)-p_1(3)*p_2(2)
+ p_out(2) = p_1(3)*p_2(1)-p_1(1)*p_2(3)
+ p_out(3) = p_1(1)*p_2(2)-p_1(2)*p_2(1)
+
+ end subroutine ocn_cross_product_in_3space!}}}
+
+!***********************************************************************
+
+end module ocn_init_spherical_utils
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_ssh_and_ssp.F b/src/core_ocean/mode_init/mpas_ocn_init_ssh_and_ssp.F
new file mode 100644
index 0000000000..e3b0255ade
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_ssh_and_ssp.F
@@ -0,0 +1,835 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_ssh_and_ssp
+!
+!> \brief MPAS ocean initialize matching SSH and SSP
+!> \author Xylar Asay-Davis
+!> \date 06/05/2015
+!> \details
+!> This module contains the routines for aiding in initializing the
+!> sea-surface pressure (SSP) based on the sea-surface height (SSH)
+!> so that the barotropic pressure-gradient force (PGF) is initially small
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_ssh_and_ssp
+
+ use mpas_kind_types
+ use mpas_io_units
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+
+ use ocn_constants
+ use ocn_init_interpolation
+ use ocn_init_vertical_grids
+
+ use ocn_equation_of_state
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_ssh_and_ssp_vertical_grid, &
+ ocn_init_ssh_and_ssp_balance
+
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+
+!***********************************************************************
+!
+! routine ocn_init_ssh_and_ssp_vertical_grid
+!
+!> \brief Initialize z* vertical grid based on SSH
+!> \author Xylar Asay-Davis
+!> \date 10/21/2015
+!> \details
+!> This routine sets up the vertical grid (layerThickness,
+!> zMid and restingThickness) needed for computing SSH from
+!> SSP or visa versa. bottomDepth, refBottomDepth, maxLevelCell
+!> and modifySSHMask must have been computed by the test case
+!> before calling this routine. If
+!> config_iterative_init_variable = 'ssp', the test
+!> case must compute refSSH before calling this routine.
+!> modifySSHMask should be set to 1 wherever the ssh or ssp
+!> should be modified for consistency (e.g. under land ice). This
+!> routine will take care of setting up partial bottom cells
+!> by calling ocn_alter_bottomDepth_for_pbcs (except for the
+!> Haney-number-constrained coordinate, which handle thin bottom
+!> cells via the Haney-number constraint.
+
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_ssh_and_ssp_vertical_grid(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ !--------------------------------------------------------------------
+
+ iErr = 0
+ call ocn_init_vertical_grid(domain, iErr, updateOnly=.false.)
+
+ end subroutine ocn_init_ssh_and_ssp_vertical_grid
+
+!***********************************************************************
+!
+! routine ocn_init_ssh_and_ssp_balance
+!
+!> \brief Compute the balance SSP given the SSH or visa versa
+!> \author Xylar Asay-Davis
+!> \date 10/21/2015
+!> \details
+!> This routine either updates SSH based on SSP (if config_iterative_init_variable = 'ssh')
+!> or visa versa (if config_iterative_init_variable = 'ssp'). The routine either produces
+!> and initial guess at SSP or SSH (if config_read_ssh_and_ssp_from_stream = .false.)
+!> or it updates SSP or SSH based on the change in SSH over a forward run
+!> (if config_read_ssh_and_ssp_from_stream = .true.).
+!> The SSP and SSH are approximately consistent with one another
+!> in the sense that the horizontal pressure-gradient force (HPGF)
+!> should be small at the ocean surface.
+!> ocn_init_ssh_and_ssp_vertical_grid should be called to produce
+!> the appropriate vertical grid before calling this subroutine.
+!> activeTracers should be initialized based on this vertical grid.
+!> Upon completion, the vertical grid will have been updated (if necessary)
+!> to be consistent with the SSH, in which case the activeTracers will have been
+!> interpolated to the new grid.
+
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_ssh_and_ssp_balance(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ logical, pointer :: config_read_ssh_and_ssp_from_stream
+
+ character (len=StrKIND), pointer :: config_iterative_init_variable
+
+ !--------------------------------------------------------------------
+
+ iErr = 0
+
+ call mpas_pool_get_config(ocnConfigs, 'config_read_ssh_and_ssp_from_stream', config_read_ssh_and_ssp_from_stream)
+ call mpas_pool_get_config(ocnConfigs, 'config_iterative_init_variable', config_iterative_init_variable)
+
+
+ if(config_read_ssh_and_ssp_from_stream) then
+ if(config_iterative_init_variable == 'ssp') then
+ call ocn_update_ssp_from_ssh(domain, iErr)
+
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: ocn_update_ssp_from_ssh failed.'
+ return
+ end if
+ end if
+ else
+ ! In this case, also recompute activeTracers, zMid and layerThickness taking
+ ! the ssh into account
+ call initial_guess_ssp_ssh(domain, iErr)
+
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: initial_guess_ssp_ssh failed.'
+ return
+ end if
+ end if
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_ssh_and_ssp_balance
+
+!***********************************************************************
+!
+! PRIVATE SUBROUTINES
+!
+!***********************************************************************
+
+!***********************************************************************
+!
+! routine ocn_init_vertical_grid
+!
+!> \brief Initialize z* vertical grid based on SSH
+!> \author Xylar Asay-Davis
+!> \date 10/21/2015
+!> \details
+!> This routine sets up the vertical grid (layerThickness,
+!> zMid and restingThickness) needed for computing SSH from
+!> SSP or visa versa. bottomDepth, refBottomDepth and maxLevelCell
+!> must have been computed by the test case before calling this
+!> routine. If config_iterative_init_variable = 'ssp', the test
+!> case must compute refSSH before calling this routine. This
+!> routine will take care of setting up partial bottom cells
+!> by calling ocn_alter_bottomDepth_for_pbcs (except for the
+!> Haney-number-constrained coordinate, which handle thin bottom
+!> cells via the Haney-number constraint.
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_vertical_grid(domain, iErr, updateOnly)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+ logical, intent(in) :: updateOnly
+
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool, statePool, diagnosticsPool, verticalMeshPool
+
+ logical, pointer :: config_read_ssh_and_ssp_from_stream , &
+ config_modify_open_ocean_ssh, &
+ config_use_rx1_constraint
+
+ character (len=StrKIND), pointer :: config_iterative_init_variable
+
+ ! Define dimension pointers
+ integer, pointer :: nCells, nVertLevels
+
+ ! Define variable pointers
+ integer, dimension(:), pointer :: maxLevelCell, modifySSHMask
+ real (kind=RKIND), dimension(:), pointer :: refBottomDepth, bottomDepth, deltaSSH, &
+ refSSH, ssh
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness, restingThickness, zMid
+
+ integer :: iCell
+
+ logical :: initWithSSH, initZStarWithSSH, initZStarWithoutSSH, initRx1WithSSH
+
+ !--------------------------------------------------------------------
+
+ iErr = 0
+
+ call mpas_pool_get_config(ocnConfigs, 'config_read_ssh_and_ssp_from_stream', config_read_ssh_and_ssp_from_stream)
+ call mpas_pool_get_config(ocnConfigs, 'config_iterative_init_variable', config_iterative_init_variable)
+
+ if(config_iterative_init_variable .ne. 'ssh' &
+ .and. config_iterative_init_variable .ne. 'ssp') then
+ iErr = 1
+ write(stderrUnit,*) 'ERROR: invalid value for config_iterative_init_variable', trim(config_iterative_init_variable)
+ return
+ end if
+ call mpas_pool_get_config(ocnConfigs, 'config_use_rx1_constraint', config_use_rx1_constraint)
+
+ initWithSSH = updateOnly .or. config_read_ssh_and_ssp_from_stream
+ initZStarWithSSH = initWithSSH .and. .not. config_use_rx1_constraint
+ initZStarWithoutSSH = .not. initWithSSH
+ initRx1WithSSH = initWithSSH .and. config_use_rx1_constraint
+
+ if(.not. updateOnly) then
+ ! we haven't computed deltaSSH yet and may need to modify ssh
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+
+ call mpas_pool_get_array(statePool, 'ssh', ssh, 1)
+
+ call mpas_pool_get_array(diagnosticsPool, 'refSSH', refSSH)
+ call mpas_pool_get_array(diagnosticsPool, 'deltaSSH', deltaSSH)
+ call mpas_pool_get_array(diagnosticsPool, 'modifySSHMask', modifySSHMask)
+
+ if(config_read_ssh_and_ssp_from_stream) then
+ where(modifySSHMask(:) == 1)
+ deltaSSH(:) = ssh(:) - refSSH(:)
+ elsewhere
+ deltaSSH(:) = 0.0_RKIND
+ end where
+ end if
+ if(config_iterative_init_variable == 'ssp') then
+ ! we're updating SSP so we want to keep ssh fixed at refSSH
+ ssh(:) = refSSH(:)
+ end if
+
+ do iCell = 1, nCells
+ if(modifySSHMask(iCell) == 0) then
+ ! we don't want the SSH to be modified here, so set it back to zero
+ ssh(iCell) = 0.0_RKIND
+ end if
+ end do !iCell
+
+ do iCell = 1, nCells
+ if(initRx1WithSSH .and. (modifySSHMask(iCell) == 1)) then
+ !pbcs are handled differently for the Haney-number-constrained coordinate
+ cycle
+ end if
+
+ call ocn_alter_bottomDepth_for_pbcs(bottomDepth(iCell), refBottomDepth, maxLevelCell(iCell), iErr)
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: ocn_alter_bottomDepth_for_pbcs failed.'
+ return
+ end if
+
+ end do
+ block_ptr => block_ptr % next
+ end do !block_ptr
+ end if
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+ call mpas_pool_get_array(statePool, 'ssh', ssh, 1)
+
+ call mpas_pool_get_array(verticalMeshPool, 'restingThickness', restingThickness)
+
+ call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
+ call mpas_pool_get_array(diagnosticsPool, 'refSSH', refSSH)
+ call mpas_pool_get_array(diagnosticsPool, 'deltaSSH', deltaSSH)
+ call mpas_pool_get_array(diagnosticsPool, 'modifySSHMask', modifySSHMask)
+
+ do iCell = 1, nCells
+ if(initZStarWithoutSSH) then
+ ! We don't know the ssh or ssp yet, and we need tracers on a reference grid to figure it out.
+ ! compute restingThickness and reference layerThickness and zMid based on topography with ssh=0
+ ! (omitting ssh argument)
+ call ocn_compute_layerThickness_zMid_from_bottomDepth(layerThickness(:,iCell),zMid(:,iCell), &
+ refBottomDepth,bottomDepth(iCell), &
+ maxLevelCell(iCell),nVertLevels,iErr, &
+ restingThickness=restingThickness(:,iCell))
+ else if(initZStarWithSSH) then
+ ! we already know the ssh and ssp we want to use.
+ ! compute the layer thicknesses and zMid based on topography and ssh
+ call ocn_compute_layerThickness_zMid_from_bottomDepth(layerThickness(:,iCell),zMid(:,iCell), &
+ refBottomDepth,bottomDepth(iCell), &
+ maxLevelCell(iCell),nVertLevels,iErr, &
+ restingThickness=restingThickness(:,iCell), &
+ ssh=ssh(iCell))
+ end if
+
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: ocn_compute_layerThickness_zMid_from_bottomDepth failed.'
+ return
+ end if
+ end do !iCell
+
+ block_ptr => block_ptr % next
+ end do !block_ptr
+
+ if(initRx1WithSSH) then
+ ! We already know the ssh and ssp we want to use.
+ ! Compute the layer thicknesses and zMid based on topography and ssh.
+ ! Use rx1 constraint to recompute the vertical grid.
+ call ocn_init_vertical_grid_with_max_rx1(domain, iErr)
+
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: ocn_init_vertical_grid_with_max_rx1 failed.'
+ return
+ end if
+
+ end if
+
+ end subroutine ocn_init_vertical_grid
+
+!***********************************************************************
+!
+! routine initial_guess_ssp_ssh
+!
+!> \brief Compute the balance SSP given the SSH or visa versa
+!> \author Xylar Asay-Davis
+!> \date 10/12/2015
+!> \details
+!> This routine computes the SSH that is approximately consistent
+!> with a given SSP or visa versa, given reference temperature and
+!> salinity fields. activeTracers should be initialized to reference
+!> T and S and will contain T and S interpolated at zMid on completion.
+!> This subroutine assumes that zMid and/or layerThickness are needed
+!> from computing the reference T and S and have already been computed
+!> with ocn_compute_layerThickness_zMid_from_bottomDepth (omitting the
+!> ssh argument) before calling this routine. zMid and layerThickness
+!> are recomputed taking the SSH into account in this routine.
+!> The density and bottom pressure are also computed by this routine.
+
+!-----------------------------------------------------------------------
+
+ subroutine initial_guess_ssp_ssh(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool, forcingPool, statePool, diagnosticsPool, &
+ verticalMeshPool, scratchPool
+
+ type (mpas_pool_type), pointer :: tracersPool
+
+ integer, dimension(:), pointer :: maxLevelCell
+ real (kind=RKIND), dimension(:), pointer :: ssh
+
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness, zMid
+
+ real (kind=RKIND), dimension(:,:), pointer :: density
+ real (kind=RKIND), dimension(:), pointer :: seaSurfacePressure, &
+ bottomPressure
+
+
+ real(kind=RKIND), dimension(:,:), pointer :: origZMid
+ integer, dimension(:), pointer :: origMaxLevelCell
+ type (field2DReal), pointer :: origZMidField
+ type (field1DInteger), pointer :: origMaxLevelCellField
+ integer, pointer :: nCells, nVertLevels
+
+ character (len=StrKIND), pointer :: config_iterative_init_variable
+
+ integer :: iCell
+
+ iErr = 0
+
+ call mpas_pool_get_config(ocnConfigs, 'config_iterative_init_variable', config_iterative_init_variable)
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'scratch', scratchPool)
+
+ call mpas_pool_get_field(scratchPool, 'scratchZMid', origZMidField)
+ call mpas_allocate_scratch_field(origZMidField, .false.)
+ call mpas_pool_get_field(scratchPool, 'scratchMaxLevelCell', origMaxLevelCellField)
+ call mpas_allocate_scratch_field(origMaxLevelCellField, .false.)
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+
+ call mpas_pool_get_array(forcingPool, 'seaSurfacePressure', seaSurfacePressure)
+
+ call mpas_pool_get_array(statePool, 'ssh', ssh, 1)
+ call mpas_pool_get_array(diagnosticsPool, 'bottomPressure', bottomPressure)
+ call mpas_pool_get_array(diagnosticsPool, 'density', density)
+
+ call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
+ call mpas_pool_get_array(scratchPool, 'scratchZMid', origZMid)
+ call mpas_pool_get_array(scratchPool, 'scratchMaxLevelCell', origMaxLevelCell)
+
+ ! compute the bottom pressure assuming ssh = 0 (the full weight of the water column)
+ call compute_density_and_bottom_pressure(meshPool, statePool, diagnosticsPool, scratchPool, &
+ layerThickness, density, bottomPressure, iErr)
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: compute_density_and_bottom_pressure failed.'
+ return
+ end if
+
+ if(config_iterative_init_variable == 'ssh') then
+ do iCell = 1, nCells
+ ! compute ssh where pressure equals seaSurfacePressure
+ ssh(iCell) = find_z_given_pressure(seaSurfacePressure(iCell), density(:,iCell), &
+ layerThickness(:,iCell), nVertLevels, maxLevelCell(iCell))
+ end do
+ end if
+
+ ! save the old zMid for use in tracer inerpolation
+ origZMid(:,:) = zMid(:,:)
+ origMaxLevelCell(:) = maxLevelCell(:)
+
+ block_ptr => block_ptr % next
+ end do !block_ptr
+
+ ! update the vertical grid based on the new ssh
+ call ocn_init_vertical_grid(domain, iErr, updateOnly=.true.)
+
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: ocn_init_vertical_grid failed.'
+ return
+ end if
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+
+ call mpas_pool_get_array(forcingPool, 'seaSurfacePressure', seaSurfacePressure)
+
+ call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
+ call mpas_pool_get_array(diagnosticsPool, 'bottomPressure', bottomPressure)
+ call mpas_pool_get_array(diagnosticsPool, 'density', density)
+
+ call mpas_pool_get_array(scratchPool, 'scratchZMid', origZMid)
+ call mpas_pool_get_array(scratchPool, 'scratchMaxLevelCell', origMaxLevelCell)
+
+ ! interpolate active tracers to the new zMid
+ call interpolate_activeTracers(meshPool, origZMid, zMid, &
+ origMaxLevelCell, maxLevelCell, &
+ activeTracers, iErr)
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: interpolate_activeTracers failed.'
+ return
+ end if
+
+ if(config_iterative_init_variable == 'ssp') then
+ ! now compute what the weight of each ocean column with the new layer thickness,
+ ! stored temporarily in seaSurfacePressure to not require an extra scratch variable
+ call compute_density_and_bottom_pressure(meshPool, statePool, diagnosticsPool, scratchPool, &
+ layerThickness, density, seaSurfacePressure, iErr)
+
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: compute_density_and_bottom_pressure failed.'
+ return
+ end if
+
+ ! the SSP is the weight of the full ocean column minus the weight of the column
+ ! with the SSH applied (temporarily stored in seaSurfacePressure)
+ seaSurfacePressure(:) = bottomPressure(:) - seaSurfacePressure(:)
+ end if
+
+ block_ptr => block_ptr % next
+ end do !block_ptr
+
+ call mpas_deallocate_scratch_field(origZMidField, .false.)
+ call mpas_deallocate_scratch_field(origMaxLevelCellField, .false.)
+
+ !--------------------------------------------------------------------
+
+ end subroutine initial_guess_ssp_ssh!}}}
+
+!***********************************************************************
+!
+! routine ocn_update_ssp_from_ssh
+!
+!> \brief Update the SSP based on a change in SSH
+!> \author Xylar Asay-Davis
+!> \date 10/20/2015
+!> \details
+!> This routine adds a perturbation to the sea-surface pressure (SSP)
+!> based on the change in the sea-surface height (SSH) over a short
+!> forward run as part of an iterative process for finding a compatible
+!> SSP given a desired SSH.
+
+!-----------------------------------------------------------------------
+
+ subroutine ocn_update_ssp_from_ssh(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool, statePool, diagnosticsPool, verticalMeshPool, scratchPool, forcingPool
+
+ real (kind=RKIND), dimension(:), pointer :: deltaSSH
+
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness
+
+ real (kind=RKIND), dimension(:,:), pointer :: density
+ real (kind=RKIND), dimension(:), pointer :: seaSurfacePressure, &
+ bottomPressure
+ integer, dimension(:), pointer :: modifySSHMask
+
+ integer, pointer :: nCells
+ logical, pointer :: config_modify_open_ocean_ssh
+ integer :: iCell
+
+ iErr = 0
+
+ call mpas_pool_get_config(ocnConfigs, 'config_modify_open_ocean_ssh', config_modify_open_ocean_ssh)
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+
+ call mpas_pool_get_array(forcingPool, 'seaSurfacePressure', seaSurfacePressure)
+
+ call mpas_pool_get_array(diagnosticsPool, 'bottomPressure', bottomPressure)
+ call mpas_pool_get_array(diagnosticsPool, 'density', density)
+ call mpas_pool_get_array(diagnosticsPool, 'deltaSSH', deltaSSH)
+ call mpas_pool_get_array(diagnosticsPool, 'modifySSHMask', modifySSHMask)
+
+ ! compute the density and weight of each water column (stored in bottomPressure)
+ call compute_density_and_bottom_pressure(meshPool, statePool, diagnosticsPool, scratchPool, &
+ layerThickness, density, bottomPressure, iErr)
+
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: compute_density_and_bottom_pressure failed.'
+ return
+ end if
+
+ do iCell = 1,nCells
+ if(modifySSHMask(iCell) == 1) then
+ ! Moving the SSH up or down by deltaSSH would change the SSP by density(SSH)*g*deltaSSH.
+ ! If deltaSSH is positive (moving up), it means the SSP is too small and if deltaSSH
+ ! is negative (moving down), it means SSP is too large, the sign of the second term
+ ! makes sense.
+ seaSurfacePressure(iCell) = max(seaSurfacePressure(iCell) + density(1,iCell)*gravity*deltaSSH(iCell), &
+ 0.0_RKIND)
+ else
+ ! the SSP should remain zero in the open ocean, though it may be that we are allowing the SSH to evolve here
+ seaSurfacePressure(iCell) = 0.0_RKIND
+ end if
+
+ ! add the SSP, since bottomPressure only contains the weight of the water column up to now
+ bottomPressure(iCell) = bottomPressure(iCell) + seaSurfacePressure(iCell)
+ end do
+
+ block_ptr => block_ptr % next
+ end do !block_ptr
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_update_ssp_from_ssh!}}}
+
+!***********************************************************************
+!
+! routine compute_density_and_bottom_pressure
+!
+!> \brief Compute bottom pressure from current state
+!> \author Xylar Asay-Davis
+!> \date 06/05/2015
+!> \details
+!> This routine computes bottom pressure from layerThickness and density
+!> based on T and S from the current state. The bottom pressure with and
+!> without the ssh can be used to determine a seaSurfacePressure that
+!> roughly consistent with the ssh.
+!> bottomDepth, restingThickness, layerThicknesses, zMid, maxLevelCell,
+!> temperature and salinity should have already been initialized before
+!> calling this routine.
+
+!----------------------------------------------------------------------
+
+ subroutine compute_density_and_bottom_pressure(meshPool, statePool, diagnosticsPool, &
+ scratchPool, layerThickness, density, &
+ bottomPressure, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (mpas_pool_type), intent(in) :: meshPool, statePool
+ type (mpas_pool_type), intent(inout) :: diagnosticsPool, scratchPool
+ real (kind=RKIND), dimension(:,:), intent(in) :: layerThickness
+
+
+ real (kind=RKIND), dimension(:,:), intent(out) :: density
+ real (kind=RKIND), dimension(:), intent(out) :: bottomPressure
+ integer, intent(out) :: iErr
+
+ ! Define dimension pointers
+ integer, pointer :: nCells, nVertLevels
+
+ integer, dimension(:), pointer :: maxLevelCell
+
+ ! Define variable pointers
+ integer :: iCell, k
+
+
+ iErr = 0
+
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+
+ call ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, scratchPool, 0, 'relative', density, iErr, &
+ timeLevelIn=1)
+
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: ocn_equation_of_state_density failed.'
+ return
+ end if
+
+ do iCell = 1, nCells
+ if(maxLevelCell(iCell) <= 0) cycle
+ bottomPressure(iCell) = 0.0_RKIND
+ do k=1,maxLevelCell(iCell)
+ bottomPressure(iCell) = bottomPressure(iCell) &
+ + density(k,iCell)*gravity*layerThickness(k,iCell)
+ end do
+ end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine compute_density_and_bottom_pressure!}}}
+
+!***********************************************************************
+!
+! routine interpolate_activeTracers
+!
+!> \brief interpolate the active tracers from reference fields
+!> \author Xylar Asay-Davis
+!> \date 10/12/2015
+!> \details
+!> Perform linear interpolation of T and S from reference fields without
+!> the sea-surface height (SSH) displacement at refZMid to new locations
+!> zMid that take the SSH into account.
+
+!-----------------------------------------------------------------------
+
+ subroutine interpolate_activeTracers(meshPool, inZMid, outZMid, &
+ inMaxLevelCell, outMaxLevelCell, &
+ activeTracers, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (mpas_pool_type), intent(in) :: meshPool
+ real (kind=RKIND), dimension(:,:), intent(in) :: inZMid, outZMid
+ integer, dimension(:), intent(in) :: inMaxLevelCell, outMaxLevelCell
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: activeTracers
+ integer, intent(out) :: iErr
+
+ ! Define dimension pointers
+ integer, pointer :: nCells, nVertLevels
+
+ ! Define variable pointers
+ integer :: iCell, inKMax, outKMax
+
+ real (kind=RKIND), dimension(:), allocatable :: inTracerColumn, outTracerColumn
+
+ integer :: nTracers, iTracer
+
+ iErr = 0
+
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ nTracers = size(activeTracers, dim=1)
+ allocate(inTracerColumn(nVertLevels),outTracerColumn(nVertLevels))
+
+ do iCell = 1, nCells
+ inKMax = inMaxLevelCell(iCell)
+ outKMax = outMaxLevelCell(iCell)
+ if((inKMax <= 0) .or. (outKMax <= 0)) cycle
+
+ do iTracer = 1, nTracers
+ inTracerColumn(:) = activeTracers(iTracer,:,iCell)
+ call ocn_init_interpolation_linear_vert(inZMid(1:inKMax,iCell), &
+ inTracerColumn(1:inKMax), &
+ inKMax, &
+ outZMid(1:outKMax,iCell), &
+ outTracerColumn(1:outKMax), &
+ outKMax, &
+ extrapolate=.true.)
+ activeTracers(iTracer,:,iCell) = outTracerColumn(:)
+ end do
+ end do
+
+ deallocate(inTracerColumn, outTracerColumn)
+
+ !--------------------------------------------------------------------
+
+ end subroutine interpolate_activeTracers!}}}
+
+!***********************************************************************
+!
+! funciton find_z_given_pressure
+!
+!> \brief interpolate the active tracers from reference fields
+!> \author Xylar Asay-Davis
+!> \date 10/13/2015
+!> \details
+!> In a column, find the depth at which the hydrostatic pressure reaches a given
+!> value provided a density profile.
+
+!-----------------------------------------------------------------------
+
+ function find_z_given_pressure(pressure, density, layerThickness, nVertLevels, maxLevelCell) result(z)
+ real (kind=RKIND), intent(in) :: pressure
+ real (kind=RKIND), intent(in), dimension(nVertLevels) :: density, layerThickness
+ integer, intent(in) :: nVertLevels, maxLevelCell
+ real (kind=RKIND) :: z
+
+ integer :: k
+ real (kind=RKIND) :: pressureTop, pressureBot
+
+ pressureTop = 0.0_RKIND
+ z = 0.0_RKIND
+
+ if(maxLevelCell <= 0) return
+
+ do k = 1, maxLevelCell
+ pressureBot = pressureTop + density(k)*gravity*layerThickness(k)
+ if(pressure < pressureBot) then
+ ! note: this will simply extrapolate if presssure is negative for some reason
+ z = z - (pressure - pressureTop)/(pressureBot - pressureTop)*layerThickness(k)
+ return
+ end if
+ z = z - layerThickness(k)
+ pressureTop = pressureBot
+ end do
+
+ end function find_z_given_pressure
+
+!***********************************************************************
+
+end module ocn_init_ssh_and_ssp
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_sub_ice_shelf_2D.F b/src/core_ocean/mode_init/mpas_ocn_init_sub_ice_shelf_2D.F
new file mode 100644
index 0000000000..83c1987618
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_sub_ice_shelf_2D.F
@@ -0,0 +1,388 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_sub_ice_shelf_2D
+!
+!> \brief MPAS ocean initialize case -- sub_ice_shelf_2D
+!> \author Mark Petersen
+!> \date 9/2/2015
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_sub_ice_shelf_2D
+
+ use mpas_kind_types
+ use mpas_io_units
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+ use mpas_dmpar
+
+ use ocn_constants
+ use ocn_init_vertical_grids
+ use ocn_init_cell_markers
+
+ use ocn_init_ssh_and_ssp
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_setup_sub_ice_shelf_2D, &
+ ocn_init_validate_sub_ice_shelf_2D
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+ contains
+
+ !***********************************************************************
+ !
+ ! routine ocn_init_setup_sub_ice_shelf_2D
+ !
+ !> \brief Setup for this initial condition
+ !> \author Mark Petersen
+ !> \date 9/2/2015
+ !> \details
+ !> This routine sets up the initial conditions for this case.
+ !
+ !-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_sub_ice_shelf_2D(domain, iErr)!{{{
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+ real (kind=RKIND) :: yMin, yMax, xMin, xMax, dcEdgeMin, dcEdgeMinGlobal, maxDepth
+ real (kind=RKIND) :: yMinGlobal, yMaxGlobal, yMidGlobal, xMinGlobal, xMaxGlobal
+ real (kind=RKIND) :: totalSubIceThickness, y1,y2,y3, d1,d2,d3, surfaceDepression, surfaceSalinity, bottomSalinity
+
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: tracersPool
+ type (mpas_pool_type), pointer :: forcingPool
+ type (mpas_pool_type), pointer :: verticalMeshPool
+
+ integer :: iCell, k, idx
+
+ ! Define config variable pointers
+ character (len=StrKIND), pointer :: config_init_configuration, config_vertical_grid
+ real (kind=RKIND), pointer :: config_sub_ice_shelf_2D_bottom_depth, &
+ config_sub_ice_shelf_2D_cavity_thickness, config_sub_ice_shelf_2D_edge_width, config_sub_ice_shelf_2D_temperature, &
+ config_sub_ice_shelf_2D_surface_salinity, config_sub_ice_shelf_2D_bottom_salinity, &
+ config_sub_ice_shelf_2D_y1, config_sub_ice_shelf_2D_y2,config_sub_ice_shelf_2D_slope_height
+
+ ! Define dimension pointers
+ integer, pointer :: nCellsSolve, nEdgesSolve, nVertLevels, nVertLevelsP1, nCells
+ integer, pointer :: index_temperature, index_salinity
+
+ ! Define variable pointers
+ integer, dimension(:), pointer :: maxLevelCell, modifySSHMask
+ real (kind=RKIND), dimension(:), pointer :: xCell, yCell,refBottomDepth, refZMid, &
+ vertCoordMovementWeights, bottomDepth, &
+ fCell, fEdge, fVertex, dcEdge
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
+
+ ! Define local interfaceLocations variable
+ real (kind=RKIND), dimension(:), pointer :: interfaceLocations
+
+ logical, pointer :: on_a_sphere
+
+ type (mpas_pool_type), pointer :: diagnosticsPool
+ real(kind=RKIND), dimension(:), pointer :: landIceFraction, refSSH
+ real (kind=RKIND), dimension(:,:), pointer :: zMid
+
+ iErr = 0
+
+ call mpas_pool_get_config(ocnConfigs, 'config_init_configuration', config_init_configuration)
+ if(config_init_configuration .ne. trim('sub_ice_shelf_2D')) return
+
+ call mpas_pool_get_config(ocnConfigs, 'config_vertical_grid', config_vertical_grid)
+ call mpas_pool_get_config(ocnConfigs, 'config_sub_ice_shelf_2D_bottom_depth',config_sub_ice_shelf_2D_bottom_depth)
+ call mpas_pool_get_config(ocnConfigs, 'config_sub_ice_shelf_2D_cavity_thickness', config_sub_ice_shelf_2D_cavity_thickness)
+ call mpas_pool_get_config(ocnConfigs, 'config_sub_ice_shelf_2D_edge_width', config_sub_ice_shelf_2D_edge_width)
+ call mpas_pool_get_config(ocnConfigs, 'config_sub_ice_shelf_2D_temperature', config_sub_ice_shelf_2D_temperature)
+ call mpas_pool_get_config(ocnConfigs, 'config_sub_ice_shelf_2D_surface_salinity', config_sub_ice_shelf_2D_surface_salinity)
+ call mpas_pool_get_config(ocnConfigs, 'config_sub_ice_shelf_2D_bottom_salinity', config_sub_ice_shelf_2D_bottom_salinity)
+ call mpas_pool_get_config(ocnConfigs, 'config_sub_ice_shelf_2D_y1', config_sub_ice_shelf_2D_y1)
+ call mpas_pool_get_config(ocnConfigs, 'config_sub_ice_shelf_2D_y2', config_sub_ice_shelf_2D_y2)
+ call mpas_pool_get_config(ocnConfigs, 'config_sub_ice_shelf_2D_slope_height', config_sub_ice_shelf_2D_slope_height)
+
+ ! points 1 and 2 are where angles on ice shelf are located.
+ ! point 3 is at the surface.
+ ! d variables are total water thickness below ice shelf.
+ y1=config_sub_ice_shelf_2D_y1
+ y2=config_sub_ice_shelf_2D_y2
+ y3=config_sub_ice_shelf_2D_y2 + config_sub_ice_shelf_2D_edge_width
+ d1=config_sub_ice_shelf_2D_cavity_thickness
+ d2=config_sub_ice_shelf_2D_cavity_thickness+config_sub_ice_shelf_2D_slope_height
+ d3=config_sub_ice_shelf_2D_bottom_depth
+
+ bottomSalinity = config_sub_ice_shelf_2D_bottom_salinity
+ surfaceSalinity = config_sub_ice_shelf_2D_surface_salinity
+
+ ! Determine vertical grid for configuration
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevelsP1', nVertLevelsP1)
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+
+ ! you may restrict your case geometry as follows:
+ if ( on_a_sphere ) call mpas_dmpar_global_abort('MPAS-ocean: ERROR: The sub_ice_shelf_2D configuration ' &
+ // 'can only be applied to a planar mesh. Exiting...')
+
+ allocate(interfaceLocations(nVertLevelsP1))
+ call ocn_generate_vertical_grid( config_vertical_grid, interfaceLocations )
+
+ ! Initalize min/max values to large positive and negative values
+ yMin = 1.0E10_RKIND
+ yMax = -1.0E10_RKIND
+ xMin = 1.0E10_RKIND
+ xMax = -1.0E10_RKIND
+ dcEdgeMin = 1.0E10_RKIND
+
+ ! Determine local min and max values.
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
+
+ yMin = min( yMin, minval(yCell(1:nCellsSolve)))
+ yMax = max( yMax, maxval(yCell(1:nCellsSolve)))
+ xMin = min( xMin, minval(xCell(1:nCellsSolve)))
+ xMax = max( xMax, maxval(xCell(1:nCellsSolve)))
+ dcEdgeMin = min( dcEdgeMin, minval(dcEdge(1:nEdgesSolve)))
+
+ block_ptr => block_ptr % next
+ end do
+
+ ! Determine global min and max values.
+ call mpas_dmpar_min_real(domain % dminfo, yMin, yMinGlobal)
+ call mpas_dmpar_max_real(domain % dminfo, yMax, yMaxGlobal)
+ call mpas_dmpar_min_real(domain % dminfo, xMin, xMinGlobal)
+ call mpas_dmpar_max_real(domain % dminfo, xMax, xMaxGlobal)
+ call mpas_dmpar_min_real(domain % dminfo, dcEdgeMin, dcEdgeMinGlobal)
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_array(meshPool, 'vertCoordMovementWeights', vertCoordMovementWeights)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+
+ call mpas_pool_get_array(verticalMeshPool, 'refZMid', refZMid)
+
+ call mpas_pool_get_array(forcingPool, 'landIceFraction', landIceFraction)
+ call mpas_pool_get_array(diagnosticsPool, 'refSSH', refSSH)
+ call mpas_pool_get_array(diagnosticsPool, 'modifySSHMask', modifySSHMask)
+
+ call ocn_mark_north_boundary(meshPool, yMaxGlobal, dcEdgeMinGlobal, iErr)
+ call ocn_mark_south_boundary(meshPool, yMinGlobal, dcEdgeMinGlobal, iErr)
+
+ ! Set refBottomDepth and refZMid
+ do k = 1, nVertLevels
+ refBottomDepth(k) = config_sub_ice_shelf_2D_bottom_depth * interfaceLocations(k+1)
+ refZMid(k) = - 0.5_RKIND * (interfaceLocations(k+1) + interfaceLocations(k)) * config_sub_ice_shelf_2D_bottom_depth
+ end do
+
+ ! Set vertCoordMovementWeights
+ vertCoordMovementWeights(:) = 1.0_RKIND
+
+ maxDepth = refBottomDepth(nVertLevels)
+
+ if(associated(landIceFraction)) &
+ landIceFraction(:) = 0.0_RKIND
+ modifySSHMask(:) = 0
+
+ do iCell = 1, nCells
+ ! set up sub ice shelf thicknesses
+ if (yCell(iCell) < y1 ) then
+ totalSubIceThickness = d1
+ elseif (yCell(iCell) < y2 ) then
+ totalSubIceThickness = d1 + (d2-d1)*(yCell(iCell)-y1)/(y2-y1)
+ elseif (yCell(iCell) < y3 ) then
+ totalSubIceThickness = d2 + (d3-d2)*(yCell(iCell)-y2)/(y3-y2)
+ else
+ totalSubIceThickness = d3
+ endif
+ refSSH(iCell) = -config_sub_ice_shelf_2D_bottom_depth + totalSubIceThickness
+ end do
+
+ do iCell = 1, nCells
+ if (yCell(iCell) < y3 ) then
+ if(associated(landIceFraction)) &
+ landIceFraction(iCell) = 1.0_RKIND
+ modifySSHMask(iCell) = 1
+ end if
+
+ ! Set bottomDepth
+ bottomDepth(iCell) = refBottomDepth(nVertLevels)
+
+ ! Set maxLevelCell
+ maxLevelCell(iCell) = nVertLevels
+ end do
+
+ block_ptr => block_ptr % next
+ end do
+
+ ! compute the vertical grid (layerThickness, restingThickness, maxLevelCell, zMid) based on ssh,
+ ! bottomDepth and refBottomDepth
+ call ocn_init_ssh_and_ssp_vertical_grid(domain, iErr)
+
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: ocn_init_ssh_and_ssp_vertical_grid failed.'
+ call mpas_dmpar_finalize(domain % dminfo)
+ end if
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', index_temperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', index_salinity)
+
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+
+ call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
+
+ ! compute active tracer fields
+ ! If we are constructing an initial guess (rather than reading ssh in from a stream), these are reference activeTracers
+ ! on a vertical grid that has not been displaced by the ssh
+ do iCell = 1, nCells
+ ! Set temperature
+ idx = index_temperature
+ do k = 1, nVertLevels
+ activeTracers(idx, k, iCell) = config_sub_ice_shelf_2D_temperature
+ end do
+
+ ! Set up salinity stratification
+ idx = index_salinity
+ do k = 1, nVertLevels
+ activeTracers(idx, k, iCell) = surfaceSalinity + (bottomSalinity - surfaceSalinity) &
+ * (zMid(k,iCell)/(-config_sub_ice_shelf_2D_bottom_depth))
+ end do
+ end do
+
+ block_ptr => block_ptr % next
+ end do
+
+ ! compute or update the SSP (or possibly SSH), also computing density and bottomPressure along the way
+ ! If this is the initial guess, the vertical grid and activeTracers may also be recomputed based on SSH
+ call ocn_init_ssh_and_ssp_balance(domain, iErr)
+
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: ocn_init_ssh_and_ssp_balance failed.'
+ call mpas_dmpar_finalize(domain % dminfo)
+ end if
+
+ call ocn_compute_Haney_number(domain, iErr)
+
+ if(iErr .ne. 0) then
+ write(stderrUnit,*) 'ERROR: ocn_compute_Haney_number failed.'
+ call mpas_dmpar_finalize(domain % dminfo)
+ end if
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_setup_sub_ice_shelf_2D!}}}
+
+ !***********************************************************************
+ !
+ ! routine ocn_init_validate_sub_ice_shelf_2D
+ !
+ !> \brief Validation for this initial condition
+ !> \author Mark Petersen
+ !> \date 9/2/2015
+ !> \details
+ !> This routine validates the configuration options for this case.
+ !
+ !-----------------------------------------------------------------------
+
+ subroutine ocn_init_validate_sub_ice_shelf_2D(configPool, packagePool, iocontext, iErr)!{{{
+
+ !--------------------------------------------------------------------
+ type (mpas_pool_type), intent(in) :: configPool, packagePool
+ type (mpas_io_context_type), intent(inout), target :: iocontext
+
+ integer, intent(out) :: iErr
+
+ character (len=StrKIND), pointer :: config_init_configuration
+ integer, pointer :: config_vert_levels, config_sub_ice_shelf_2D_vert_levels
+
+ type (mpas_io_context_type), pointer :: iocontext_ptr
+
+ iocontext_ptr => iocontext
+
+ iErr = 0
+
+ call mpas_pool_get_config(configPool, 'config_init_configuration', config_init_configuration)
+
+ if(config_init_configuration .ne. trim('sub_ice_shelf_2D')) return
+
+ call mpas_pool_get_config(configPool, 'config_vert_levels', config_vert_levels)
+ call mpas_pool_get_config(configPool, 'config_sub_ice_shelf_2D_vert_levels', config_sub_ice_shelf_2D_vert_levels)
+
+ if(config_vert_levels <= 0 .and. config_sub_ice_shelf_2D_vert_levels > 0) then
+ config_vert_levels = config_sub_ice_shelf_2D_vert_levels
+ else if (config_vert_levels <= 0) then
+ write(stderrUnit,*) 'IERROR: Validation failed for sub_ice_shelf_2D. Not given a usable value for vertical levels.'
+ iErr = 1
+ end if
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_validate_sub_ice_shelf_2D!}}}
+
+
+ !***********************************************************************
+
+ end module ocn_init_sub_ice_shelf_2D
+
+ !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+ ! vim: foldmethod=marker
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_vertical_grids.F b/src/core_ocean/mode_init/mpas_ocn_init_vertical_grids.F
new file mode 100644
index 0000000000..2b2115b7a2
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_vertical_grids.F
@@ -0,0 +1,1357 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_vertical_grids
+!
+!> \brief MPAS ocean vertical grid generator
+!> \author Doug Jacobsen
+!> \date 03/20/2015
+!> \details
+!> This module contains the routines for generating
+!> vertical grids.
+!
+!-----------------------------------------------------------------------
+module ocn_init_vertical_grids
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+ use mpas_timer
+
+ use ocn_constants
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_generate_vertical_grid, &
+ ocn_compute_layerThickness_zMid_from_bottomDepth, &
+ ocn_alter_bottomDepth_for_pbcs, &
+ ocn_compute_Haney_number, &
+ ocn_init_vertical_grid_with_max_rx1
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+ !***********************************************************************
+ !
+ ! routine ocn_generate_vertical_grid
+ !
+ !> \brief Vertical grid generator driver
+ !> \author Doug Jacobsen
+ !> \date 03/20/2015
+ !> \details
+ !> This routine is a driver for generating vertical grids. It calls a private
+ !> module routine based on the value of the input argument gridType.
+ !> The output array interfaceLocations will contain values between
+ !> 0 being the top of top layer and 1 being the bottom of bottom layer
+ !
+ !-----------------------------------------------------------------------
+ subroutine ocn_generate_vertical_grid(gridType, interfaceLocations, configPool)!{{{
+ implicit none
+
+ character (len=*), intent(in) :: gridType
+ real (kind=RKIND), dimension(:), intent(out) :: interfaceLocations
+ type (mpas_pool_type), optional, intent(in) :: configPool !< Input: Pool with namelist options
+
+ if ( trim(gridType) == 'uniform' ) then
+ call ocn_generate_uniform_vertical_grid(interfaceLocations)
+ else if ( trim(gridType) == '60layerPHC' ) then
+ call ocn_generate_60layerPHC_vertical_grid(interfaceLocations)
+ else if ( trim(gridType) == '42layerWOCE' ) then
+ call ocn_generate_42layerWOCE_vertical_grid(interfaceLocations)
+ else if ( trim(gridType) == '100layerACMEv1' ) then
+ call ocn_generate_100layerACMEv1_vertical_grid(interfaceLocations)
+ else if ( trim(gridType) == '1dCVTgenerator' ) then
+ if (.not. present(configPool)) then
+ call mpas_dmpar_global_abort("MPAS-ocean: ERROR: requesting a 1d CVT vertical grid generation " &
+ // "without passing the corresponding parameters. Exiting...")
+ else
+ call ocn_generate_1dCVT_vertical_grid(configPool, interfaceLocations)
+ end if
+ else
+ write(stderrUnit, *) ' WARNING: '//trim(gridType)//' is an invalid vertical grid choice. No vertical ' &
+ // 'grid will be generated.'
+ end if
+
+ end subroutine ocn_generate_vertical_grid!}}}
+
+ !***********************************************************************
+ !
+ ! routine ocn_generate_uniform_vertical_grid
+ !
+ !> \brief Uniform Vertical grid generator
+ !> \author Doug Jacobsen
+ !> \date 03/20/2015
+ !> \details
+ !> This routine generates a uniform vertical grid.
+ !
+ !-----------------------------------------------------------------------
+ subroutine ocn_generate_uniform_vertical_grid(interfaceLocations)!{{{
+ implicit none
+
+ real (kind=RKIND), dimension(:), intent(out) :: interfaceLocations
+
+ real (kind=RKIND) :: layerSpacing
+ integer :: nInterfaces, iInterface
+
+ write(stderrUnit,* ) ' ---- Generating uniform vertical grid ---- '
+
+ nInterfaces = size(interfaceLocations, dim=1)
+ layerSpacing = 1.0_RKIND / (nInterfaces - 1)
+
+ interfaceLocations(1) = 0.0_RKIND
+
+ do iInterface = 2, nInterfaces
+ interfaceLocations(iInterface) = interfaceLocations(iInterface-1) + layerSpacing
+ end do
+
+ end subroutine ocn_generate_uniform_vertical_grid!}}}
+
+ !***********************************************************************
+ !
+ ! routine ocn_generate_60layerPHC_vertical_grid
+ !
+ !> \brief 60 layer PHC vertical grid generator
+ !> \author Doug Jacobsen
+ !> \date 03/20/2015
+ !> \details
+ !> This routine generates a 60 layer vertical grid based on the PHC data set.
+ !
+ !-----------------------------------------------------------------------
+ subroutine ocn_generate_60layerPHC_vertical_grid(interfaceLocations)!{{{
+ implicit none
+
+ real (kind=RKIND), dimension(:), intent(out) :: interfaceLocations
+
+ real (kind=RKIND) :: maxInterfaceLocation
+ integer :: nInterfaces, iInterface
+
+ nInterfaces = size(interfaceLocations, dim=1)
+
+ if ( nInterfaces /= 61 ) then
+ call mpas_dmpar_global_abort("MPAS-ocean: ERROR: Vertical grid must have 60 layers to "// &
+ "apply 60 Layer PHC grid. Exiting...")
+ end if
+
+ interfaceLocations(1) = 0.0_RKIND
+ interfaceLocations(2) = 500_RKIND
+ interfaceLocations(3) = 1500_RKIND
+ interfaceLocations(4) = 2500_RKIND
+ interfaceLocations(5) = 3500_RKIND
+ interfaceLocations(6) = 4500_RKIND
+ interfaceLocations(7) = 5500_RKIND
+ interfaceLocations(8) = 6500_RKIND
+ interfaceLocations(9) = 7500_RKIND
+ interfaceLocations(10) = 8500_RKIND
+ interfaceLocations(11) = 9500_RKIND
+ interfaceLocations(12) = 10500_RKIND
+ interfaceLocations(13) = 11500_RKIND
+ interfaceLocations(14) = 12500_RKIND
+ interfaceLocations(15) = 13500_RKIND
+ interfaceLocations(16) = 14500_RKIND
+ interfaceLocations(17) = 15500_RKIND
+ interfaceLocations(18) = 16509.83984375_RKIND
+ interfaceLocations(19) = 17547.904296875_RKIND
+ interfaceLocations(20) = 18629.125_RKIND
+ interfaceLocations(21) = 19766.025390625_RKIND
+ interfaceLocations(22) = 20971.134765625_RKIND
+ interfaceLocations(23) = 22257.826171875_RKIND
+ interfaceLocations(24) = 23640.880859375_RKIND
+ interfaceLocations(25) = 25137.013671875_RKIND
+ interfaceLocations(26) = 26765.416015625_RKIND
+ interfaceLocations(27) = 28548.361328125_RKIND
+ interfaceLocations(28) = 30511.91796875_RKIND
+ interfaceLocations(29) = 32686.794921875_RKIND
+ interfaceLocations(30) = 35109.34375_RKIND
+ interfaceLocations(31) = 37822.75390625_RKIND
+ interfaceLocations(32) = 40878.4609375_RKIND
+ interfaceLocations(33) = 44337.765625_RKIND
+ interfaceLocations(34) = 48273.66796875_RKIND
+ interfaceLocations(35) = 52772.796875_RKIND
+ interfaceLocations(36) = 57937.28515625_RKIND
+ interfaceLocations(37) = 63886.2578125_RKIND
+ interfaceLocations(38) = 70756.328125_RKIND
+ interfaceLocations(39) = 78700.25_RKIND
+ interfaceLocations(40) = 87882.5234375_RKIND
+ interfaceLocations(41) = 98470.5859375_RKIND
+ interfaceLocations(42) = 110620.421875_RKIND
+ interfaceLocations(43) = 124456.6953125_RKIND
+ interfaceLocations(44) = 140049.71875_RKIND
+ interfaceLocations(45) = 157394.640625_RKIND
+ interfaceLocations(46) = 176400.328125_RKIND
+ interfaceLocations(47) = 196894.421875_RKIND
+ interfaceLocations(48) = 218645.65625_RKIND
+ interfaceLocations(49) = 241397.15625_RKIND
+ interfaceLocations(50) = 264900.125_RKIND
+ interfaceLocations(51) = 288938.46875_RKIND
+ interfaceLocations(52) = 313340.46875_RKIND
+ interfaceLocations(53) = 337979.375_RKIND
+ interfaceLocations(54) = 362767.0625_RKIND
+ interfaceLocations(55) = 387645.21875_RKIND
+ interfaceLocations(56) = 412576.84375_RKIND
+ interfaceLocations(57) = 437539.28125_RKIND
+ interfaceLocations(58) = 462519.0625_RKIND
+ interfaceLocations(59) = 487508.375_RKIND
+ interfaceLocations(60) = 512502.84375_RKIND
+ interfaceLocations(61) = 537500_RKIND
+
+ maxInterfaceLocation = maxval(interfaceLocations)
+
+ interfaceLocations(:) = interfaceLocations(:) / maxInterfaceLocation
+
+ end subroutine ocn_generate_60layerPHC_vertical_grid!}}}
+
+ !***********************************************************************
+ !
+ ! routine ocn_generate_42layerWOCE_vertical_grid
+ !
+ !> \brief 42 layer WOCE vertical grid generator
+ !> \author Doug Jacobsen
+ !> \date 03/20/2015
+ !> \details
+ !> This routine generates a 42 layer vertical grid based on the WOCE data set.
+ !
+ !-----------------------------------------------------------------------
+ subroutine ocn_generate_42layerWOCE_vertical_grid(interfaceLocations)!{{{
+ implicit none
+
+ real (kind=RKIND), dimension(:), intent(out) :: interfaceLocations
+
+ real (kind=RKIND) :: maxInterfaceLocation
+ integer :: nInterfaces, iInterface
+
+ nInterfaces = size(interfaceLocations, dim=1)
+
+ if ( nInterfaces /= 43 ) then
+ call mpas_dmpar_global_abort("MPAS-ocean: ERROR: Vertical grid must have 42 layers "// &
+ "to apply 42 Layer WOCE grid. Exiting...")
+ end if
+
+ interfaceLocations(1) = 0.0_RKIND
+ interfaceLocations(2) = 5.00622_RKIND
+ interfaceLocations(3) = 15.06873_RKIND
+ interfaceLocations(4) = 25.28343_RKIND
+ interfaceLocations(5) = 35.75849_RKIND
+ interfaceLocations(6) = 46.61269_RKIND
+ interfaceLocations(7) = 57.98099_RKIND
+ interfaceLocations(8) = 70.02139_RKIND
+ interfaceLocations(9) = 82.92409_RKIND
+ interfaceLocations(10) = 96.92413_RKIND
+ interfaceLocations(11) = 112.3189_RKIND
+ interfaceLocations(12) = 129.4936_RKIND
+ interfaceLocations(13) = 148.9582_RKIND
+ interfaceLocations(14) = 171.4044_RKIND
+ interfaceLocations(15) = 197.7919_RKIND
+ interfaceLocations(16) = 229.4842_RKIND
+ interfaceLocations(17) = 268.4617_RKIND
+ interfaceLocations(18) = 317.6501_RKIND
+ interfaceLocations(19) = 381.3864_RKIND
+ interfaceLocations(20) = 465.9132_RKIND
+ interfaceLocations(21) = 579.3073_RKIND
+ interfaceLocations(22) = 729.3513_RKIND
+ interfaceLocations(23) = 918.3723_RKIND
+ interfaceLocations(24) = 1139.153_RKIND
+ interfaceLocations(25) = 1378.574_RKIND
+ interfaceLocations(26) = 1625.7_RKIND
+ interfaceLocations(27) = 1875.106_RKIND
+ interfaceLocations(28) = 2125.011_RKIND
+ interfaceLocations(29) = 2375_RKIND
+ interfaceLocations(30) = 2624.999_RKIND
+ interfaceLocations(31) = 2874.999_RKIND
+ interfaceLocations(32) = 3124.999_RKIND
+ interfaceLocations(33) = 3374.999_RKIND
+ interfaceLocations(34) = 3624.999_RKIND
+ interfaceLocations(35) = 3874.999_RKIND
+ interfaceLocations(36) = 4124.999_RKIND
+ interfaceLocations(37) = 4374.999_RKIND
+ interfaceLocations(38) = 4624.999_RKIND
+ interfaceLocations(39) = 4874.999_RKIND
+ interfaceLocations(40) = 5124.999_RKIND
+ interfaceLocations(41) = 5374.999_RKIND
+ interfaceLocations(42) = 5624.999_RKIND
+ interfaceLocations(43) = 5874.999_RKIND
+
+ maxInterfaceLocation = maxval(interfaceLocations)
+
+ interfaceLocations(:) = interfaceLocations(:) / maxInterfaceLocation
+
+ end subroutine ocn_generate_42layerWOCE_vertical_grid!}}}
+
+
+ !***********************************************************************
+ !
+ ! routine ocn_generate_100layerACMEv1_vertical_grid
+ !
+ !> \brief 100 vertical layer vertical grid generator for ACME v1
+ !> \author Todd Ringler
+ !> \date 04/23/2015
+ !> \details
+ !> This routine generates a 100 layer grid
+ !
+ !-----------------------------------------------------------------------
+ subroutine ocn_generate_100layerACMEv1_vertical_grid(interfaceLocations)!{{{
+ implicit none
+
+ real (kind=RKIND), dimension(:), intent(out) :: interfaceLocations
+
+ real (kind=RKIND) :: maxInterfaceLocation
+ integer :: nInterfaces, iInterface
+
+ nInterfaces = size(interfaceLocations, dim=1)
+
+ if ( nInterfaces /= 101 ) then
+ call mpas_dmpar_global_abort("MPAS-ocean: ERROR: Vertical grid must have 100 layers to "// &
+ "apply 100 Layer PHC grid. Exiting...")
+ end if
+
+ interfaceLocations( 1) = 0.0000E+00_RKIND
+ interfaceLocations( 2) = 0.1510E+01_RKIND
+ interfaceLocations( 3) = 0.3135E+01_RKIND
+ interfaceLocations( 4) = 0.4882E+01_RKIND
+ interfaceLocations( 5) = 0.6761E+01_RKIND
+ interfaceLocations( 6) = 0.8779E+01_RKIND
+ interfaceLocations( 7) = 0.1095E+02_RKIND
+ interfaceLocations( 8) = 0.1327E+02_RKIND
+ interfaceLocations( 9) = 0.1577E+02_RKIND
+ interfaceLocations( 10) = 0.1845E+02_RKIND
+ interfaceLocations( 11) = 0.2132E+02_RKIND
+ interfaceLocations( 12) = 0.2440E+02_RKIND
+ interfaceLocations( 13) = 0.2769E+02_RKIND
+ interfaceLocations( 14) = 0.3122E+02_RKIND
+ interfaceLocations( 15) = 0.3500E+02_RKIND
+ interfaceLocations( 16) = 0.3904E+02_RKIND
+ interfaceLocations( 17) = 0.4335E+02_RKIND
+ interfaceLocations( 18) = 0.4797E+02_RKIND
+ interfaceLocations( 19) = 0.5289E+02_RKIND
+ interfaceLocations( 20) = 0.5815E+02_RKIND
+ interfaceLocations( 21) = 0.6377E+02_RKIND
+ interfaceLocations( 22) = 0.6975E+02_RKIND
+ interfaceLocations( 23) = 0.7614E+02_RKIND
+ interfaceLocations( 24) = 0.8294E+02_RKIND
+ interfaceLocations( 25) = 0.9018E+02_RKIND
+ interfaceLocations( 26) = 0.9790E+02_RKIND
+ interfaceLocations( 27) = 0.1061E+03_RKIND
+ interfaceLocations( 28) = 0.1148E+03_RKIND
+ interfaceLocations( 29) = 0.1241E+03_RKIND
+ interfaceLocations( 30) = 0.1340E+03_RKIND
+ interfaceLocations( 31) = 0.1445E+03_RKIND
+ interfaceLocations( 32) = 0.1556E+03_RKIND
+ interfaceLocations( 33) = 0.1674E+03_RKIND
+ interfaceLocations( 34) = 0.1799E+03_RKIND
+ interfaceLocations( 35) = 0.1932E+03_RKIND
+ interfaceLocations( 36) = 0.2072E+03_RKIND
+ interfaceLocations( 37) = 0.2221E+03_RKIND
+ interfaceLocations( 38) = 0.2379E+03_RKIND
+ interfaceLocations( 39) = 0.2546E+03_RKIND
+ interfaceLocations( 40) = 0.2722E+03_RKIND
+ interfaceLocations( 41) = 0.2909E+03_RKIND
+ interfaceLocations( 42) = 0.3106E+03_RKIND
+ interfaceLocations( 43) = 0.3314E+03_RKIND
+ interfaceLocations( 44) = 0.3534E+03_RKIND
+ interfaceLocations( 45) = 0.3766E+03_RKIND
+ interfaceLocations( 46) = 0.4011E+03_RKIND
+ interfaceLocations( 47) = 0.4269E+03_RKIND
+ interfaceLocations( 48) = 0.4541E+03_RKIND
+ interfaceLocations( 49) = 0.4827E+03_RKIND
+ interfaceLocations( 50) = 0.5128E+03_RKIND
+ interfaceLocations( 51) = 0.5445E+03_RKIND
+ interfaceLocations( 52) = 0.5779E+03_RKIND
+ interfaceLocations( 53) = 0.6130E+03_RKIND
+ interfaceLocations( 54) = 0.6498E+03_RKIND
+ interfaceLocations( 55) = 0.6885E+03_RKIND
+ interfaceLocations( 56) = 0.7291E+03_RKIND
+ interfaceLocations( 57) = 0.7717E+03_RKIND
+ interfaceLocations( 58) = 0.8164E+03_RKIND
+ interfaceLocations( 59) = 0.8633E+03_RKIND
+ interfaceLocations( 60) = 0.9124E+03_RKIND
+ interfaceLocations( 61) = 0.9638E+03_RKIND
+ interfaceLocations( 62) = 0.1018E+04_RKIND
+ interfaceLocations( 63) = 0.1074E+04_RKIND
+ interfaceLocations( 64) = 0.1133E+04_RKIND
+ interfaceLocations( 65) = 0.1194E+04_RKIND
+ interfaceLocations( 66) = 0.1259E+04_RKIND
+ interfaceLocations( 67) = 0.1326E+04_RKIND
+ interfaceLocations( 68) = 0.1396E+04_RKIND
+ interfaceLocations( 69) = 0.1469E+04_RKIND
+ interfaceLocations( 70) = 0.1546E+04_RKIND
+ interfaceLocations( 71) = 0.1625E+04_RKIND
+ interfaceLocations( 72) = 0.1708E+04_RKIND
+ interfaceLocations( 73) = 0.1794E+04_RKIND
+ interfaceLocations( 74) = 0.1884E+04_RKIND
+ interfaceLocations( 75) = 0.1978E+04_RKIND
+ interfaceLocations( 76) = 0.2075E+04_RKIND
+ interfaceLocations( 77) = 0.2176E+04_RKIND
+ interfaceLocations( 78) = 0.2281E+04_RKIND
+ interfaceLocations( 79) = 0.2390E+04_RKIND
+ interfaceLocations( 80) = 0.2503E+04_RKIND
+ interfaceLocations( 81) = 0.2620E+04_RKIND
+ interfaceLocations( 82) = 0.2742E+04_RKIND
+ interfaceLocations( 83) = 0.2868E+04_RKIND
+ interfaceLocations( 84) = 0.2998E+04_RKIND
+ interfaceLocations( 85) = 0.3134E+04_RKIND
+ interfaceLocations( 86) = 0.3274E+04_RKIND
+ interfaceLocations( 87) = 0.3418E+04_RKIND
+ interfaceLocations( 88) = 0.3568E+04_RKIND
+ interfaceLocations( 89) = 0.3723E+04_RKIND
+ interfaceLocations( 90) = 0.3882E+04_RKIND
+ interfaceLocations( 91) = 0.4047E+04_RKIND
+ interfaceLocations( 92) = 0.4218E+04_RKIND
+ interfaceLocations( 93) = 0.4393E+04_RKIND
+ interfaceLocations( 94) = 0.4574E+04_RKIND
+ interfaceLocations( 95) = 0.4761E+04_RKIND
+ interfaceLocations( 96) = 0.4953E+04_RKIND
+ interfaceLocations( 97) = 0.5151E+04_RKIND
+ interfaceLocations( 98) = 0.5354E+04_RKIND
+ interfaceLocations( 99) = 0.5564E+04_RKIND
+ interfaceLocations(100) = 0.5779E+04_RKIND
+ interfaceLocations(101) = 0.6000E+04_RKIND
+
+ maxInterfaceLocation = maxval(interfaceLocations)
+
+ interfaceLocations(:) = interfaceLocations(:) / maxInterfaceLocation
+
+ end subroutine ocn_generate_100layerACMEv1_vertical_grid!}}}
+
+
+!***********************************************************************
+!
+! routine ocn_generate_1dCVT_vertical_grid
+!
+!> \brief 1D CVT vertical grid generator
+!> \author Juan A. Saenz
+!> \date 09/10/2015
+!> \details
+!> This routine generates a vertical grid with total depth = 1.
+!> This code is adapted from Todd's cvt_1d code.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_generate_1dCVT_vertical_grid(configPool, interfaceLocations)!{{{
+
+ type (mpas_pool_type), intent(in) :: configPool
+ real (kind=RKIND), dimension(:), intent(out) :: interfaceLocations
+
+ integer :: k
+ integer :: nInterfaces, nVertLevels
+ real (kind=RKIND) :: stretch1
+ real (kind=RKIND) :: stretch2
+ real (kind=RKIND) :: dzSeed
+
+ real (kind=RKIND) :: stretch
+ real (kind=RKIND) :: dz
+ real (kind=RKIND) :: maxInterfaceLocation
+
+ real (kind=RKIND), pointer :: config_1dCVTgenerator_stretch1
+ real (kind=RKIND), pointer :: config_1dCVTgenerator_stretch2
+ real (kind=RKIND), pointer :: config_1dCVTgenerator_dzSeed
+
+ call mpas_pool_get_config(configPool, 'config_1dCVTgenerator_stretch1', config_1dCVTgenerator_stretch1)
+ call mpas_pool_get_config(configPool, 'config_1dCVTgenerator_stretch2', config_1dCVTgenerator_stretch2)
+ call mpas_pool_get_config(configPool, 'config_1dCVTgenerator_dzSeed', config_1dCVTgenerator_dzSeed)
+
+ stretch1 = config_1dCVTgenerator_stretch1
+ stretch2 = config_1dCVTgenerator_stretch2
+ dzSeed = config_1dCVTgenerator_dzSeed
+
+ nInterfaces = size(interfaceLocations, dim=1)
+ nVertLevels = nInterfaces - 1
+
+ ! compute profile starting at top and stretch dz as we move down
+ dz = dzSeed
+ interfaceLocations(1) = 0.0_RKIND
+ interfaceLocations(2) = dz
+ do k=2,nVertLevels
+ stretch = stretch1 + (stretch2-stretch1)*k/nVertLevels
+ dz = stretch*dz
+ interfaceLocations(k+1) = interfaceLocations(k) + dz
+ enddo
+
+ ! normalize so that positions span 0 to 1
+ maxInterfaceLocation = maxval(interfaceLocations)
+ interfaceLocations(:) = interfaceLocations(:) / maxInterfaceLocation
+
+ end subroutine ocn_generate_1dCVT_vertical_grid!}}}
+
+
+!***********************************************************************
+!
+! routine ocn_compute_layerThickness_zMid_from_bottomDepth
+!
+!> \brief Compute auxiliary z-variables from bottomDepth
+!> \author Mark Petersen
+!> \date 10/17/2015
+!> \details
+!> This routine computes auxiliary z-variables from bottomDepth
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_compute_layerThickness_zMid_from_bottomDepth(layerThickness,zMid,refBottomDepth,bottomDepth, &
+ maxLevelCell,nVertLevels,iErr,restingThickness,ssh)!{{{
+ real (kind=RKIND), dimension(nVertLevels), intent(out) :: layerThickness, zMid
+ real (kind=RKIND), dimension(nVertLevels), intent(in) :: refBottomDepth
+ real (kind=RKIND), intent(in) :: bottomDepth
+ integer, intent(in) :: maxLevelCell, nVertLevels
+ integer, intent(out) :: iErr
+ real (kind=RKIND), dimension(nVertLevels), intent(out), optional :: restingThickness
+ real (kind=RKIND), intent(in), optional :: ssh
+
+ integer :: k
+ real (kind=RKIND) :: layerStretch, zTop
+
+ iErr = 0
+
+ layerThickness(:) = 0.0_RKIND
+ zMid(:) = 0.0_RKIND
+
+ if(present(ssh) .and. .not. present(restingThickness)) then
+ write (stderrUnit,*) ' Error: ssh present but restingThickness not present ' &
+ // 'in ocn_compute_layerThickness_zMid_from_bottomDepth'
+ iErr = 1
+ return
+ end if
+
+ if (maxLevelCell<=0) return
+
+ ! first, compute the resting layer thickness (same as layer thickness if ssh not present)
+ if (maxLevelCell==1) then
+ layerThickness(1) = bottomDepth
+ else
+ layerThickness(1) = refBottomDepth(1)
+
+ do k = 2, maxLevelCell-1
+ layerThickness(k) = refBottomDepth(k) - refBottomDepth(k-1)
+ end do
+
+ k = maxLevelCell
+ layerThickness(k) = bottomDepth - refBottomDepth(k-1)
+
+ endif
+
+ zTop = 0.0_RKIND
+ ! copy to layerThickness to restingThickness
+ if (present(restingThickness)) then
+ restingThickness(:) = layerThickness(:)
+ ! stretch layers if ssh is present
+ if(present(ssh)) then
+ layerStretch = (ssh + bottomDepth)/bottomDepth
+ zTop = ssh
+ do k=1,maxLevelCell
+ layerThickness(k) = layerStretch*restingThickness(k)
+ end do
+ end if
+ end if
+
+ ! compute zMid based on the layer thickness
+ do k = 1, maxLevelCell
+ zMid(k) = zTop - 0.5_RKIND*layerThickness(k)
+ zTop = zTop - layerThickness(k)
+ end do
+
+ end subroutine ocn_compute_layerThickness_zMid_from_bottomDepth !}}}
+
+
+!***********************************************************************
+!
+! routine ocn_alter_bottomDepth_for_pbcs
+!
+!> \brief Alter bottom depth for partial bottom cells
+!> \author Mark Petersen
+!> \date 10/19/2015
+!> \details
+!> This routine alters the bottom depth in a single column based on pbc settings
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_alter_bottomDepth_for_pbcs(bottomDepth, refBottomDepth, maxLevelCell, iErr)
+
+ real (kind=RKIND), intent(inout) :: bottomDepth
+ integer, intent(inout) :: maxLevelCell
+ real (kind=RKIND), dimension(maxLevelCell), intent(in) :: refBottomDepth
+ integer, intent(out) :: iErr
+ integer :: k
+
+ logical, pointer :: config_alter_ICs_for_pbcs
+ real (kind=RKIND) :: minBottomDepth, minBottomDepthMid
+ real (kind=RKIND), pointer :: config_min_pbc_fraction
+ character (len=StrKIND), pointer :: config_pbc_alteration_type
+ call mpas_pool_get_config(ocnConfigs, 'config_alter_ICs_for_pbcs', config_alter_ICs_for_pbcs)
+ call mpas_pool_get_config(ocnConfigs, 'config_pbc_alteration_type', config_pbc_alteration_type)
+ call mpas_pool_get_config(ocnConfigs, 'config_min_pbc_fraction', config_min_pbc_fraction)
+
+ iErr = 0
+
+ if (maxLevelCell > 1) then
+ if (config_alter_ICs_for_pbcs) then
+
+ if (config_pbc_alteration_type .eq. 'partial_cell') then
+ ! Change value of maxLevelCell for partial bottom cells
+ k = maxLevelCell
+ minBottomDepth = refBottomDepth(k) - (1.0-config_min_pbc_fraction)*(refBottomDepth(k) - refBottomDepth(k-1))
+ minBottomDepthMid = 0.5_RKIND*(minBottomDepth + refBottomDepth(k-1))
+ if (bottomDepth .lt. minBottomDepthMid) then
+ ! Round up to cell above
+ maxLevelCell = maxLevelCell - 1
+ bottomDepth = refBottomDepth(maxLevelCell)
+ else if (bottomDepth .lt. minBottomDepth) then
+ ! Round down cell to the min_pbc_fraction.
+ bottomDepth = minBottomDepth
+ end if
+ elseif (config_pbc_alteration_type .eq. 'full_cell') then
+ bottomDepth = refBottomDepth(maxLevelCell)
+ else
+ write (stderrUnit,*) ' Error: Incorrect choice of config_pbc_alteration_type: ', config_pbc_alteration_type
+ iErr = 1
+ endif
+ endif
+ endif
+
+ end subroutine ocn_alter_bottomDepth_for_pbcs
+
+!***********************************************************************
+!
+! routine ocn_compute_Haney_number
+!
+!> \brief computes the Haney number (rx1)
+!> \author Xylar Asay-Davis
+!> \date 11/20/2015
+!> \details
+!> This routine computes the Haney number (rx1), which is a measure of
+!> hydrostatic consistency
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_compute_Haney_number(domain, iErr)
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool, diagnosticsPool
+ real (kind=RKIND), dimension(:,:), pointer :: zMid
+ real (kind=RKIND), dimension(:,:), pointer :: rx1Edge, rx1Cell
+ real (kind=RKIND), dimension(:), pointer :: rx1MaxEdge, rx1MaxCell
+ real (kind=RKIND), pointer :: globalRx1Max
+
+ integer, pointer :: nCells, nVertLevels, nEdges
+ integer, dimension(:), pointer :: maxLevelCell
+ integer, dimension(:,:), pointer :: cellsOnEdge
+
+ integer :: iEdge, c1, c2, k, maxLevelEdge
+
+ real (kind=RKIND) :: dzVert1, dzVert2, dzEdgeK, dzEdgeKp1, rx1, localMaxRx1Edge
+
+ iErr = 0
+
+ localMaxRx1Edge = 0.0_RKIND
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
+
+ call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
+
+ call mpas_pool_get_array(diagnosticsPool, 'rx1Edge', rx1Edge)
+ call mpas_pool_get_array(diagnosticsPool, 'rx1Cell', rx1Cell)
+ call mpas_pool_get_array(diagnosticsPool, 'rx1MaxEdge', rx1MaxEdge)
+ call mpas_pool_get_array(diagnosticsPool, 'rx1MaxCell', rx1MaxCell)
+ call mpas_pool_get_array(diagnosticsPool, 'globalRx1Max', globalRx1Max)
+
+ rx1Edge(:,:) = 0.0_RKIND
+ rx1Cell(:,:) = 0.0_RKIND
+ rx1MaxEdge(:) = 0.0_RKIND
+ rx1MaxCell(:) = 0.0_RKIND
+ do iEdge = 1,nEdges
+ c1 = cellsOnEdge(1,iEdge)
+ c2 = cellsOnEdge(2,iEdge)
+ ! not a valid edge
+ if((c1 > nCells) .or. (c2 > nCells)) cycle
+ maxLevelEdge = min(maxLevelCell(c1), maxLevelCell(c2))
+ do k = 1,maxLevelEdge-1
+ dzVert1 = zMid(k,c1)-zMid(k+1,c1)
+ dzVert2 = zMid(k,c2)-zMid(k+1,c2)
+ dzEdgeK = zMid(k,c2)-zMid(k,c1)
+ dzEdgeKp1 = zMid(k+1,c2)-zMid(k+1,c1)
+
+ rx1 = abs(dzEdgeK+dzEdgeKp1)/(dzVert1+dzVert2)
+
+ rx1Edge(k,iEdge) = rx1
+ rx1Cell(k,c1) = max(rx1Cell(k,c1),rx1)
+ rx1Cell(k,c2) = max(rx1Cell(k,c2),rx1)
+
+ rx1MaxEdge(iEdge) = max(rx1MaxEdge(iEdge),rx1)
+ rx1MaxCell(c2) = max(rx1MaxCell(c2),rx1)
+ rx1MaxCell(c1) = max(rx1MaxCell(c1),rx1)
+ end do
+ end do
+
+ localMaxRx1Edge = max(localMaxRx1Edge,maxval(rx1MaxEdge))
+
+ block_ptr => block_ptr % next
+ end do
+ call mpas_dmpar_max_real(domain % dminfo, localMaxRx1Edge, globalRx1Max)
+ write (stdoutUnit,'(a, es10.2)') ' global max of rx1:', globalRx1Max
+
+ end subroutine ocn_compute_Haney_number
+
+!***********************************************************************
+!
+! routine ocn_init_vertical_grid_with_max_rx1
+!
+!> \brief re-initializes the vertical grid so rx1 < rx1Max
+!> \author Xylar Asay-Davis
+!> \date 11/23/2015
+!> \details
+!> This routine re-initializes the vertical grid (layerThickness,
+!> restingThickness maxLevelCell, zMid) so that the Haney number is
+!> less than a maximum value (rx1 < rx1Max). ssh and bottomDepth should
+!> have been initialized before calling this routine. bottomDepth will
+!> be modified for full or partial bottom cells in this routine, so
+!> this step should not be performed before calling this routine
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_init_vertical_grid_with_max_rx1(domain, iErr)
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ type (block_type), pointer :: block_ptr
+
+ type (mpas_pool_type), pointer :: meshPool, statePool, diagnosticsPool, verticalMeshPool, scratchPool, forcingPool
+
+ integer, pointer :: config_rx1_smooth_count, config_rx1_inner_iteration_count, config_rx1_horiz_smooth_open_ocean_cells, &
+ config_rx1_min_levels
+ real (kind=RKIND), pointer :: config_rx1_max, config_rx1_horiz_smooth_weight, &
+ config_rx1_vert_smooth_weight, config_rx1_inner_iteration_weight, &
+ config_rx1_min_layer_thickness
+
+ type (field2DReal), pointer :: zInterfaceField, layerThicknessNewField
+ type (field1DReal), pointer :: zTopField, zBotField, zBotNewField, bottomDepthMaxLevelField
+ type (field1DInteger), pointer :: smoothingMaskField, smoothingMaskNewField
+
+ real (kind=RKIND), dimension(:,:), pointer :: zMid, layerThickness, restingThickness, zInterface, layerThicknessNew
+ real (kind=RKIND), dimension(:), pointer :: ssh, bottomDepth, refBottomDepth, zTop, zBot, zBotNew, landIceFraction, &
+ bottomDepthMaxLevel
+
+ integer, pointer :: nCells, nVertLevels, nEdges
+ integer, dimension(:), pointer :: maxLevelCell, cullCell, nEdgesOnCell, smoothingMask, smoothingMaskNew
+ integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnCell
+
+ integer :: iCell, iEdge, coc, c1, c2, k, maxLevelEdge, iSmooth, iterIndex, maxLevel
+
+ real (kind=RKIND) :: dzEdgeK, dzEdgeKp1, stretch, dzEdgeMean, dzVertGoal, &
+ zThreshold, zMin, zMean, weight, sigma, zBotEdge, rx1Goal, dzVertMean, &
+ zBot_bottomLayer, zInterfaceNew, zMidNext, zInterfaceNext
+
+ real (kind=RKIND), parameter :: eps=1e-6_RKIND
+
+ iErr = 0
+
+ call mpas_pool_get_config(domain % configs, 'config_rx1_smooth_count', config_rx1_smooth_count)
+ call mpas_pool_get_config(domain % configs, 'config_rx1_inner_iteration_count', config_rx1_inner_iteration_count)
+ call mpas_pool_get_config(domain % configs, 'config_rx1_inner_iteration_weight', config_rx1_inner_iteration_weight)
+ call mpas_pool_get_config(domain % configs, 'config_rx1_max', config_rx1_max)
+ call mpas_pool_get_config(domain % configs, 'config_rx1_horiz_smooth_weight', config_rx1_horiz_smooth_weight)
+ call mpas_pool_get_config(domain % configs, 'config_rx1_vert_smooth_weight', config_rx1_vert_smooth_weight)
+ call mpas_pool_get_config(domain % configs, 'config_rx1_horiz_smooth_open_ocean_cells', &
+ config_rx1_horiz_smooth_open_ocean_cells)
+ call mpas_pool_get_config(domain % configs, 'config_rx1_min_levels', config_rx1_min_levels)
+ call mpas_pool_get_config(domain % configs, 'config_rx1_min_layer_thickness', config_rx1_min_layer_thickness)
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_field(diagnosticsPool, 'rx1InitSmoothingMask', smoothingMaskField, 1)
+
+ ! allocate scratch variables that persist across blocks
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'scratch', scratchPool)
+ call mpas_pool_get_field(scratchPool, 'zInterfaceScratch', zInterfaceField)
+ call mpas_pool_get_field(scratchPool, 'zTopScratch', zTopField)
+ call mpas_pool_get_field(scratchPool, 'zBotScratch', zBotField)
+ call mpas_pool_get_field(scratchPool, 'bottomDepthMaxLevelScratch', bottomDepthMaxLevelField)
+ call mpas_allocate_scratch_field(zInterfaceField, .false.)
+ call mpas_allocate_scratch_field(zTopField, .false.)
+ call mpas_allocate_scratch_field(zBotField, .false.)
+ call mpas_allocate_scratch_field(bottomDepthMaxLevelField, .false.)
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+
+ call mpas_pool_get_array(meshPool, 'cullCell', cullCell)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_array(statePool, 'ssh', ssh, 1)
+ call mpas_pool_get_array(scratchPool, 'zInterfaceScratch', zInterface)
+
+ call mpas_pool_get_array(forcingPool, 'landIceFraction', landIceFraction)
+ call mpas_pool_get_array(diagnosticsPool, 'rx1InitSmoothingMask', smoothingMask, 1)
+ call mpas_pool_get_array(scratchPool, 'bottomDepthMaxLevelScratch', bottomDepthMaxLevel)
+
+ ! initialize zInterface to z* without PBCs and extended to nVertLevels+1 (beyond bottomDepth)
+ maxLevelCell(nCells+1) = -1
+ do iCell = 1, nCells
+ if(associated(cullCell)) then
+ if(cullCell(iCell) == 1) then
+ ! we need to know to ignore this cell later
+ maxLevelCell(iCell) = -1
+ end if
+ end if
+
+ if(maxLevelCell(iCell) <= 0) then
+ ! this is land
+ zInterface(:,iCell) = 0.0_RKIND
+ cycle
+ end if
+
+ ! don't let bottomDepth go below the z-level grid
+ bottomDepth(iCell) = min(bottomDepth(iCell), refBottomDepth(nVertLevels))
+
+ ! lower bottomDepth if the whole column is thinner than the minimum
+ bottomDepth(iCell) = max(bottomDepth(iCell), -ssh(iCell) + config_rx1_min_layer_thickness*config_rx1_min_levels)
+
+ stretch = (ssh(iCell) + bottomDepth(iCell))/bottomDepth(iCell)
+ zInterface(1,iCell) = ssh(iCell)
+ zInterface(2:nVertLevels+1,iCell) = stretch*(-refBottomDepth(:) + bottomDepth(iCell)) - bottomDepth(iCell)
+
+ ! Linearly interpolate the level at which bottomDepth = refBottomDepth. Later on, bottomDepth will
+ ! always be constrained to be at a layer no deeper than this, meaning that the vertical coordinate
+ ! cannot become more squashed than a z* coordinate
+ if(bottomDepth(iCell) < refBottomDepth(1)) then
+ bottomDepthMaxLevel(iCell) = bottomDepth(iCell)/refBottomDepth(1)
+ else
+ k = 2
+ do while((k < nVertLevels) .and. (bottomDepth(iCell) >= refBottomDepth(k)))
+ k = k + 1
+ end do
+ bottomDepthMaxLevel(iCell) = k + (bottomDepth(iCell)-refBottomDepth(k-1))/(refBottomDepth(k)-refBottomDepth(k-1))
+ end if
+
+ end do !iCell
+
+ ! initialize the smoothing mask to valid cells under land ice
+ smoothingMask(:) = 0
+ where((maxLevelCell(:) > 0) .and. (landIceFraction(:) > eps))
+ smoothingMask(:) = 1
+ end where
+
+ block_ptr => block_ptr % next
+ end do !block_ptr
+
+ ! expand the smoothing mask to neighbors of land-ice cells
+ do iSmooth = 1, config_rx1_horiz_smooth_open_ocean_cells
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell)
+ call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(diagnosticsPool, 'rx1InitSmoothingMask', smoothingMask, 1)
+
+ call mpas_pool_get_field(scratchPool, 'smoothingMaskNewScratch', smoothingMaskNewField)
+ call mpas_allocate_scratch_field(smoothingMaskNewField, .true.)
+ call mpas_pool_get_array(scratchPool, 'smoothingMaskNewScratch', smoothingMaskNew)
+
+ smoothingMaskNew(:) = smoothingMask(:)
+
+ ! expand the mask to neighbors
+ do iCell = 1, nCells
+ if(smoothingMask(iCell) == 0) cycle
+
+ do iEdge = 1, nEdgesOnCell(iCell)
+ coc = cellsOnCell(iEdge,iCell)
+ if(maxLevelCell(coc) <= 0) cycle
+
+ ! we have a neighbor of a masked cell, so make sure it is also masked
+ smoothingMaskNew(coc) = 1
+ end do !iEdge
+ end do !iCell
+
+ smoothingMask(:) = smoothingMaskNew(:)
+ call mpas_deallocate_scratch_field(smoothingMaskNewField, .true.)
+
+ block_ptr => block_ptr % next
+ end do !block_ptr
+
+ ! do halo update on smoothingMask
+ call mpas_dmpar_exch_halo_field(smoothingMaskField)
+ end do !iSmooth
+
+ do iSmooth = 1, config_rx1_smooth_count
+
+ write(stderrUnit, *) "smoothing iteration ", iSmooth
+
+ if(iSmooth > 1) then
+ ! only do smoothing for passes after the first
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell)
+ call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(scratchPool, 'zInterfaceScratch', zInterface)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness,1)
+ call mpas_pool_get_array(scratchPool, 'zTopScratch', zTop)
+ call mpas_pool_get_array(diagnosticsPool, 'rx1InitSmoothingMask', smoothingMask, 1)
+
+ call mpas_pool_get_field(scratchPool, 'layerThicknessNewScratch', layerThicknessNewField)
+ call mpas_allocate_scratch_field(layerThicknessNewField, .true.)
+ call mpas_pool_get_array(scratchPool, 'layerThicknessNewScratch', layerThicknessNew)
+ call mpas_pool_get_array(scratchPool, 'bottomDepthMaxLevelScratch', bottomDepthMaxLevel)
+
+ ! smooth zInterface horizontally (except in top layer, which is held fixed at ssh)
+ do k = 2, nVertLevels+1
+ zTop(:) = zInterface(k,:)
+ do iCell = 1, nCells
+ if(smoothingMask(iCell) == 0) cycle ! this also covers cases where maxLevelCell <= 0
+ zMean = 0.0_RKIND
+ weight = 0.0_RKIND
+ do iEdge = 1, nEdgesOnCell(iCell)
+ coc = cellsOnCell(iEdge,iCell)
+ if(maxLevelCell(coc) <= 0) cycle
+
+ zMean = zMean + zInterface(k,coc)
+ weight = weight + 1.0_RKIND
+ end do !iEdge
+ ! use zTop for temporary storage
+ if(weight > 0.0_RKIND) then
+ zTop(iCell) = config_rx1_horiz_smooth_weight*zMean/weight &
+ + (1.0_RKIND - config_rx1_horiz_smooth_weight)*zInterface(k, iCell)
+ else
+ zTop(iCell) = zInterface(k, iCell)
+ end if
+ end do !iCell
+ ! copy back from temporary storage in zTop
+ zInterface(k,:) = zTop(:)
+ end do !k
+
+ do iCell = 1, nCells
+ if(smoothingMask(iCell) == 0) cycle
+ call ocn_init_rx1_grid_constrain_bottom_depth_level(zInterface(:,iCell), bottomDepth(iCell), &
+ config_rx1_min_levels, bottomDepthMaxLevel(iCell))
+ end do
+
+ ! no halo exchange in zInterface should be required because halo exchange of zBot will handle this
+
+ layerThickness(:,:) = max(config_rx1_min_layer_thickness, zInterface(1:nVertLevels,:) - zInterface(2:nVertLevels+1,:))
+ layerThicknessNew(:,:) = layerThickness(:,:)
+
+ ! smooth layerThickness vertically
+ weight = config_rx1_vert_smooth_weight
+ do iCell = 1, nCells
+ if(smoothingMask(iCell) == 0) cycle
+
+ layerThicknessNew(1,iCell) = (1.0_RKIND - weight)*layerThickness(1,iCell) &
+ + weight*layerThickness(2,iCell)
+ do k = 2, nVertLevels-1
+ layerThicknessNew(k,iCell) = (1.0_RKIND - weight)*layerThickness(k,iCell) &
+ + weight*0.5_RKIND*(layerThickness(k-1,iCell)+layerThickness(k+1,iCell))
+ end do
+ layerThicknessNew(nVertLevels,iCell) = (1.0_RKIND - weight)*layerThickness(nVertLevels,iCell) &
+ + weight*layerThickness(nVertLevels-1,iCell)
+ end do
+ layerThickness(:,:) = layerThicknessNew(:,:)
+
+ ! recompute zInterface for k > 1 from layerThickness
+ do k = 1, nVertLevels
+ zInterface(k+1,:) = zInterface(k,:) - layerThickness(k,:)
+ end do
+ do iCell = 1, nCells
+ if(smoothingMask(iCell) == 0) cycle
+ call ocn_init_rx1_grid_constrain_bottom_depth_level(zInterface(:,iCell), bottomDepth(iCell), &
+ config_rx1_min_levels, bottomDepthMaxLevel(iCell))
+ end do
+
+ call mpas_deallocate_scratch_field(layerThicknessNewField, .true.)
+
+ block_ptr => block_ptr % next
+ end do !block_ptr
+ end if !iSmooth > 1
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+
+ call mpas_pool_get_array(scratchPool, 'zInterfaceScratch', zInterface)
+ call mpas_pool_get_array(scratchPool, 'zTopScratch', zTop)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(diagnosticsPool, 'rx1InitSmoothingMask', smoothingMask, 1)
+
+ ! rx1 that constrains top layer is a special case, since there's no layer above
+ zTop(:) = zInterface(1,:)
+
+ ! set maxLevelCell to -1 in regions we will modify; it will be recomputed as we work our way down
+ where (smoothingMask == 1)
+ maxLevelCell = -1
+ end where
+
+ block_ptr => block_ptr % next
+ end do !block_ptr
+
+ ! rx1 is allowed to get twice as big in the top layer because we're only looking at half a layer
+ rx1Goal = 2.0_RKIND*config_rx1_max
+
+ do k = 1,nVertLevels
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+
+ call mpas_pool_get_array(scratchPool, 'zInterfaceScratch', zInterface)
+ call mpas_pool_get_array(scratchPool, 'zBotScratch', zBot)
+
+ ! make zInterface(k+1,:) deeper if layer k would be too thin
+ zInterface(k+1,:) = min(zInterface(k+1,:), &
+ zInterface(k,:) - config_rx1_min_layer_thickness)
+
+ zBot(:) = 0.5_RKIND*(zInterface(k,:) + zInterface(k+1,:))
+
+ block_ptr => block_ptr % next
+ end do !block_ptr
+
+ do iterIndex = 1, config_rx1_inner_iteration_count
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+
+ call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
+
+ call mpas_pool_get_array(scratchPool, 'zInterfaceScratch', zInterface)
+ call mpas_pool_get_array(scratchPool, 'zTopScratch', zTop)
+ call mpas_pool_get_array(scratchPool, 'zBotScratch', zBot)
+ call mpas_pool_get_array(diagnosticsPool, 'rx1InitSmoothingMask', smoothingMask, 1)
+
+ call mpas_pool_get_field(scratchPool, 'zBotNewScratch', zBotNewField)
+ call mpas_allocate_scratch_field(zBotNewField, .true.)
+ call mpas_pool_get_array(scratchPool, 'zBotNewScratch', zBotNew)
+
+ zBotNew(:) = zBot(:)
+ do iEdge = 1,nEdges
+ c1 = cellsOnEdge(1,iEdge)
+ c2 = cellsOnEdge(2,iEdge)
+ if((smoothingMask(c1) == 0) .or. (smoothingMask(c2) == 0)) then
+ ! this not and edge we're allowed to alter, so leave zBot alone
+ cycle
+ end if
+
+ dzEdgeK = zTop(c2)-zTop(c1)
+ dzEdgeKp1 = zBot(c2)-zBot(c1)
+ dzEdgeMean = 0.5_RKIND*abs(dzEdgeK+dzEdgeKp1)
+ dzVertGoal = dzEdgeMean/rx1Goal
+ zBotEdge = 0.5_RKIND*(zTop(c1)+zTop(c2)) - dzVertGoal
+ dzVertMean = 0.5_RKIND*(zTop(c1)-zBot(c1)+zTop(c2)-zBot(c2))
+
+ ! Once iteration has converged, we want 0.5_RKIND*(zBot(c1) + zBot(c2)) <= zBotEdge
+ zBotNew(c1) = min(zBotNew(c1), 2.0_RKIND*zBotEdge - zBot(c2))
+ zBotNew(c2) = min(zBotNew(c2), 2.0_RKIND*zBotEdge - zBot(c1))
+ end do !iEdge
+
+ ! first, adjust zBot so zInterface(k+1,:) matched -bottomDepth where appropriate
+ if(config_rx1_smooth_count == 1) then
+ weight = 1.0_RKIND
+ else
+ ! the weight goes from 0.0 for the first smoothing iteration to 1.0 for the last
+ weight = (iSmooth - 1.0_RKIND)/(config_rx1_smooth_count - 1.0_RKIND)
+ end if
+
+ if(k >= config_rx1_min_levels) then
+ do iCell = 1, nCells
+ if(smoothingMask(iCell) == 0) cycle ! not modifying this column
+
+ if(k == nVertLevels) then
+ ! there is no zInterface(k+2,iCell), and we don't really need it
+ zMidNext = 2.0_RKIND*zBot(iCell) - zInterface(k,iCell) !zInterface(k+1,iCell)
+ else
+ ! first, compute the location of zInterface(k+2), making sure layers are thick enough
+ zInterfaceNext = min(zInterface(k+2,iCell), &
+ 2.0_RKIND*zBot(iCell) - zInterface(k,iCell) &
+ + config_rx1_min_layer_thickness)
+ ! next, compute the location of the middle of the next layer
+ zMidNext = zBot(iCell) - 0.5_RKIND*(zInterface(k,iCell) - zInterfaceNext)
+ end if
+
+ ! zInterface(k+1) isn't deep enough to be closest to -bottomDepth
+ if((bottomDepth(iCell) > -zMidNext) .and. (k < nVertLevels)) cycle
+
+ !we already found the bottom layer above this one
+ if((maxLevelCell(iCell) >= config_rx1_min_levels) .and. (maxLevelCell(iCell) < k)) cycle
+
+ ! this must be the bottom layer
+ maxLevelCell(iCell) = k
+ if(bottomDepth(iCell) > -zInterface(k,iCell)) then
+ ! bottomDepth is below the top of this layer so we can adjust zBot such that
+ ! zIterface(k+1,iCell) = -bottomDepth
+ ! Don't let this process make the layer too thin
+ zBot_bottomLayer = zInterface(k,iCell) &
+ - 0.5_RKIND*max(bottomDepth(iCell) + zInterface(k,iCell), &
+ config_rx1_min_layer_thickness)
+ ! -bottomDepth is closer to zInterface(k+1,:) than to other interfaces
+ ! relax zBot toward zBot_bottomLayer, with stronger weighting for higher smoothing iteration
+ zBot(iCell) = (1.0_RKIND - weight)*zBot(iCell) + weight*zBot_bottomLayer
+ zBot(iCell) = min(zBot(iCell), zInterface(k,iCell) + 0.5_RKIND*config_rx1_min_layer_thickness)
+ end if
+ end do ! iCell
+ end if ! k >= config_rx1_min_levels
+
+ ! next, adjust zBot toward zBotNew (with rx1 < rx1Max)
+ if(config_rx1_inner_iteration_count == 1) then
+ weight = 0.0_RKIND
+ else
+ weight = (iterIndex - 1.0_RKIND)/(config_rx1_inner_iteration_count - 1.0_RKIND)
+ end if
+ ! the weight goes from config_rx1_inner_iteration_weight for the first iteration to 1.0 for the last
+ weight = (1.0_RKIND - weight)*config_rx1_inner_iteration_weight + weight
+ zBot(:) = (1.0_RKIND - weight)*zBot(:) + weight*zBotNew(:)
+
+ call mpas_deallocate_scratch_field(zBotNewField, .true.)
+
+ block_ptr => block_ptr % next
+ end do !block_ptr
+
+ ! do halo update on zBot
+ call mpas_dmpar_exch_halo_field(zBotField)
+
+ end do !iterIndex
+
+ ! update zInterface, layerThickness, zTop
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+
+ call mpas_pool_get_array(scratchPool, 'zInterfaceScratch', zInterface)
+ call mpas_pool_get_array(scratchPool, 'zTopScratch', zTop)
+ call mpas_pool_get_array(scratchPool, 'zBotScratch', zBot)
+ call mpas_pool_get_array(diagnosticsPool, 'rx1InitSmoothingMask', smoothingMask, 1)
+
+ where (smoothingMask(:) == 1)
+ zInterface(k+1,:) = 2.0_RKIND*zBot(:) - zInterface(k,:)
+ end where
+
+ zTop(:) = zBot(:)
+
+ block_ptr => block_ptr % next
+ end do !block_ptr
+
+ rx1Goal = config_rx1_max
+
+ end do !k
+
+ ! compute maxLevelCell and adjust zInterfaces
+ ! for full or partial bottom cells (if requested)
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(scratchPool, 'zInterfaceScratch', zInterface)
+ call mpas_pool_get_array(diagnosticsPool, 'rx1InitSmoothingMask', smoothingMask, 1)
+ call mpas_pool_get_array(scratchPool, 'bottomDepthMaxLevelScratch', bottomDepthMaxLevel)
+
+ ! put zInterface back within bounds if necessary
+ do iCell = 1, nCells
+ if(smoothingMask(iCell) == 0) cycle
+
+ call ocn_init_rx1_grid_constrain_bottom_depth_level(zInterface(:,iCell), bottomDepth(iCell), &
+ config_rx1_min_levels, bottomDepthMaxLevel(iCell))
+
+ maxLevelCell(iCell) = min(maxLevelCell(iCell),int(bottomDepthMaxLevel(iCell)))
+ end do
+
+ block_ptr => block_ptr % next
+ end do !block_ptr
+ end do !iSmooth
+
+ ! compute maxLevelCell, zMid and restingThickness; update bottomDepth and layerThickness
+ ! for full or partial bottom cells (if requested)
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'diagnostics', diagnosticsPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'scratch', scratchPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(verticalMeshPool, 'restingThickness', restingThickness)
+ call mpas_pool_get_array(statePool, 'ssh', ssh, 1)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+ call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid, 1)
+ call mpas_pool_get_array(scratchPool, 'zInterfaceScratch', zInterface)
+ call mpas_pool_get_array(diagnosticsPool, 'rx1InitSmoothingMask', smoothingMask, 1)
+
+ ! compute zMid, layerThickness and restingThickness
+ do iCell = 1, nCells
+ if(maxLevelCell(iCell) == -1) then
+ bottomDepth(iCell) = 0.0_RKIND
+ zMid(:,iCell) = 0.0_RKIND
+ layerThickness(:,iCell) = 0.0_RKIND
+ restingThickness(:,iCell) = 0.0_RKIND
+ cycle
+ end if
+
+ if(smoothingMask(iCell) == 1) then
+ ! we may not have been able to put the layer interface exactly at bottomDepth,
+ ! either because bottomDepth was too shallow for the minimum number of layers
+ ! or because contracting the layer would have led to rx1 > rx1Max
+ bottomDepth(iCell) = -zInterface(maxLevelCell(iCell)+1,iCell)
+ end if
+
+ ! don't allow layers to go below -bottomDepth
+ zInterface(:,iCell) = max(zInterface(:,iCell),-bottomDepth(iCell))
+
+ zMid(:,iCell) = 0.5_RKIND*(zInterface(1:nVertLevels,iCell) + zInterface(2:nVertLevels+1,iCell))
+ layerThickness(:,iCell) = zInterface(1:nVertLevels,iCell) - zInterface(2:nVertLevels+1,iCell)
+
+ !restingThickness can be computed by "undoing" the z* stretch
+ stretch = (ssh(iCell) + bottomDepth(iCell))/bottomDepth(iCell)
+ zInterface(:,iCell) = (zInterface(:,iCell) + bottomDepth(iCell))/stretch - bottomDepth(iCell)
+ restingThickness(:,iCell) = zInterface(1:nVertLevels,iCell) - zInterface(2:nVertLevels+1,iCell)
+ end do
+
+ block_ptr => block_ptr % next
+ end do !block_ptr
+
+ call mpas_deallocate_scratch_field(zInterfaceField, .false.)
+ call mpas_deallocate_scratch_field(zTopField, .false.)
+ call mpas_deallocate_scratch_field(zBotField, .false.)
+ call mpas_deallocate_scratch_field(bottomDepthMaxLevelField, .false.)
+
+ end subroutine ocn_init_vertical_grid_with_max_rx1
+
+!***********************************************************************
+!
+! routine ocn_init_rx1_grid_constrain_bottom_depth_level
+!
+!> \brief constrain the min and max index where z=-bottomDepth
+!> \author Xylar Asay-Davis
+!> \date 12/04/2015
+!> \details
+!> This routine constrains vertical grid in a given column to have at
+!> least bottomDepthMinLevel and at most bottomDepthMaxLevel vertical
+!> levels between z=ssh and z=-bottomDepth. If necessary, the column
+!> is rescaled, holding the top fixed, until the constraint is
+!> satisfied. bottomDepthMaxLevel can be non-integer, and is
+!> computed based on the level in refBottomDepth where bottomDepth
+!> would occur (i.e. the number of vertical levels in a z-level
+!> coordinate with bathymetry at -bottomDepth).
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_init_rx1_grid_constrain_bottom_depth_level(zInterface, bottomDepth, bottomDepthMinLevel, bottomDepthMaxLevel)
+
+ real (kind=RKIND), dimension(:), intent(inout) :: zInterface
+ integer, intent(in) :: bottomDepthMinLevel
+ real (kind=RKIND), intent(in) :: bottomDepth, bottomDepthMaxLevel
+
+ integer :: nVertLevels, k
+
+ real (kind=RKIND) :: stretch, frac, z, z0
+
+ z0 = zInterface(1)
+
+ if(z0 <= -bottomDepth) return ! this must be a land cell, so there's nothing to do
+
+ !k = bottomDepthMinLevel+1
+ !z = zInterface(k)
+ !if(z < -bottomDepth) then
+ ! ! the column has become too stretched, so squash it so z --> -bottomDepth
+ ! stretch = (z0+bottomDepth)/(z0-z)
+ ! zInterface(:) = stretch*(zInterface(:)-z0) + z0
+ ! return
+ !end if
+
+ nVertLevels = size(zInterface)-1
+
+ k = min(int(bottomDepthMaxLevel),nVertLevels)
+ frac = bottomDepthMaxLevel - k
+ z = zInterface(k) + frac*(zInterface(k+1) - zInterface(k))
+ if(z > -bottomDepth) then
+ ! the column has become too squashed, so stretch it so z --> -bottomDepth
+ stretch = (z0+bottomDepth)/(z0-z)
+ zInterface(:) = stretch*(zInterface(:)-z0) + z0
+ end if
+
+ end subroutine ocn_init_rx1_grid_constrain_bottom_depth_level
+
+!***********************************************************************
+
+end module ocn_init_vertical_grids
+
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker et ts=3 tw=132
diff --git a/src/core_ocean/mode_init/mpas_ocn_init_ziso.F b/src/core_ocean/mode_init/mpas_ocn_init_ziso.F
new file mode 100644
index 0000000000..f06a60dc18
--- /dev/null
+++ b/src/core_ocean/mode_init/mpas_ocn_init_ziso.F
@@ -0,0 +1,585 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_init_ziso
+!
+!> \brief MPAS ocean initialize case -- Zonally periodic Idealized Southern Ocean (ZISO)
+!> \author Phillip J. Wolfram, Luke Van Roekel, Todd Ringler
+!> \date 09/14/2015
+!> \details
+!> This module contains the routines for initializing the
+!> ZISO initial condition.
+!
+!-----------------------------------------------------------------------
+
+module ocn_init_ziso
+
+ use mpas_kind_types
+ use mpas_io_units
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_constants
+ use mpas_stream_manager
+ use mpas_dmpar
+
+ use ocn_constants
+ use ocn_init_vertical_grids
+ use ocn_init_cell_markers
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_init_setup_ziso, &
+ ocn_init_validate_ziso
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_init_setup_ziso
+!
+!> \brief Setup for this initial condition
+!> \author Phillip J. Wolfram, Luke Van Roekel, Todd Ringler
+!> \date 09/14/2015
+!> \details
+!> This routine sets up the initial conditions for the ZISO configuration.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_setup_ziso(domain, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (domain_type), intent(inout) :: domain
+ integer, intent(out) :: iErr
+
+ ! local work variables
+ type (block_type), pointer :: block_ptr
+ type (mpas_pool_type), pointer :: meshPool, verticalMeshPool, statePool, forcingPool, tracersPool
+ type (mpas_pool_type), pointer :: tracersSurfaceRestoringFieldsPool, tracersInteriorRestoringFieldsPool
+
+ integer :: iCell, iEdge, iVertex, k, idx
+ real (kind=RKIND), dimension(:), pointer :: interfaceLocations
+
+ ! Define config variable pointers
+ character (len=StrKIND), pointer :: config_init_configuration, config_vertical_grid
+ logical, pointer :: config_write_cull_cell_mask
+
+ ! ZISO test case run-time configuration parameters
+ logical, pointer :: config_ziso_use_slopping_bathymetry
+ real (kind=RKIND), pointer :: config_ziso_meridional_extent
+ real (kind=RKIND), pointer :: config_ziso_bottom_depth
+ real (kind=RKIND), pointer :: config_ziso_wind_stress_max
+ real (kind=RKIND), pointer :: config_ziso_reference_coriolis
+ real (kind=RKIND), pointer :: config_ziso_coriolis_gradient
+ real (kind=RKIND), pointer :: config_ziso_shelf_depth
+ real (kind=RKIND), pointer :: config_ziso_slope_center_position
+ real (kind=RKIND), pointer :: config_ziso_slope_half_width
+ real (kind=RKIND), pointer :: config_ziso_initial_temp_t1
+ real (kind=RKIND), pointer :: config_ziso_initial_temp_t2
+ real (kind=RKIND), pointer :: config_ziso_initial_temp_h1
+ real (kind=RKIND), pointer :: config_ziso_initial_temp_mt
+ real (kind=RKIND), pointer :: config_ziso_mean_restoring_temp
+ real (kind=RKIND), pointer :: config_ziso_restoring_temp_dev_ta
+ real (kind=RKIND), pointer :: config_ziso_restoring_temp_dev_tb
+ real (kind=RKIND), pointer :: config_ziso_restoring_temp_piston_vel
+ real (kind=RKIND), pointer :: config_ziso_restoring_sponge_l
+ real (kind=RKIND), pointer :: config_ziso_restoring_temp_tau
+ real (kind=RKIND), pointer :: config_ziso_restoring_temp_ts
+ real (kind=RKIND), pointer :: config_ziso_restoring_temp_ze
+ real (kind=RKIND), pointer :: config_ziso_wind_transition_position
+ real (kind=RKIND), pointer :: config_ziso_antarctic_shelf_front_width
+ real (kind=RKIND), pointer :: config_ziso_wind_stress_shelf_front_max
+ logical, pointer :: config_ziso_add_easterly_wind_stress_ASF
+
+ ! configure settings related to frazil
+ logical, pointer :: config_ziso_frazil_enable
+ real (kind=RKIND), pointer :: config_ziso_frazil_temperature_anomaly
+
+ integer, pointer :: config_ziso_vert_levels
+
+ ! Define dimension pointers
+ integer, pointer :: nVertLevels, nCellsSolve, nEdgesSolve, nVerticesSolve, nVertLevelsP1
+ integer, pointer :: index_temperature, index_salinity
+
+ ! Define variable pointers
+ logical, pointer :: on_a_sphere
+ integer, dimension(:), pointer :: maxLevelCell
+ real (kind=RKIND), dimension(:), pointer :: xCell, yCell, xEdge, yEdge, xVertex, yVertex, refBottomDepth, refZMid, &
+ vertCoordMovementWeights, bottomDepth, &
+ fCell, fEdge, fVertex, dcEdge
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness, restingThickness
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
+ real (kind=RKIND), dimension(:, :), pointer :: activeTracersPistonVelocity, activeTracersSurfaceRestoringValue
+ real (kind=RKIND), dimension(:, :, :), pointer :: activeTracersInteriorRestoringValue, activeTracersInteriorRestoringRate
+ real (kind=RKIND), dimension(:), pointer :: windStressZonal, windStressMeridional
+
+ real (kind=RKIND) :: yMin, yMax, xMin, xMax, dcEdgeMin, dcEdgeMinGlobal
+ real (kind=RKIND) :: yMinGlobal, yMaxGlobal, yMidGlobal, xMinGlobal, xMaxGlobal
+ real(kind=RKIND), pointer :: y_period
+ character (len=StrKIND) :: streamID
+ integer :: directionProperty
+
+ ! Local variable related to frazil
+ real (kind=RKIND) :: distanceX, distanceY, distance, frazil_temperature, scaleFactor
+
+ ! assume no error
+ iErr = 0
+
+ ! test if ZISO is the desired configuration
+ call mpas_pool_get_config(ocnConfigs, 'config_init_configuration', config_init_configuration)
+ if(config_init_configuration .ne. trim('ziso')) return
+
+ write(stderrUnit,*) 'Starting initialization of Zonally periodic Idealized Southern Ocean (ZISO)'
+
+ ! get config variables !{{{
+ call mpas_pool_get_config(domain % configs, 'config_write_cull_cell_mask', config_write_cull_cell_mask)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_use_slopping_bathymetry', config_ziso_use_slopping_bathymetry)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_bottom_depth', config_ziso_bottom_depth)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_meridional_extent', config_ziso_meridional_extent)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_reference_coriolis', config_ziso_reference_coriolis)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_coriolis_gradient', config_ziso_coriolis_gradient)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_vert_levels', config_ziso_vert_levels)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_wind_stress_max', config_ziso_wind_stress_max)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_slope_half_width', config_ziso_slope_half_width)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_shelf_depth', config_ziso_shelf_depth)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_slope_center_position', config_ziso_slope_center_position)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_initial_temp_t1', config_ziso_initial_temp_t1)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_initial_temp_t2', config_ziso_initial_temp_t2)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_initial_temp_h1', config_ziso_initial_temp_h1)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_initial_temp_mt', config_ziso_initial_temp_mt)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_mean_restoring_temp', config_ziso_mean_restoring_temp)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_restoring_temp_dev_ta', config_ziso_restoring_temp_dev_ta)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_restoring_temp_dev_tb', config_ziso_restoring_temp_dev_tb)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_restoring_temp_piston_vel', config_ziso_restoring_temp_piston_vel)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_restoring_sponge_l', config_ziso_restoring_sponge_l)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_restoring_temp_tau', config_ziso_restoring_temp_tau)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_restoring_temp_ts', config_ziso_restoring_temp_ts)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_restoring_temp_ze', config_ziso_restoring_temp_ze)
+ call mpas_pool_get_config(domain % configs, 'config_vertical_grid', config_vertical_grid)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_add_easterly_wind_stress_ASF', &
+ config_ziso_add_easterly_wind_stress_ASF)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_wind_transition_position', config_ziso_wind_transition_position)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_antarctic_shelf_front_width', config_ziso_antarctic_shelf_front_width)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_wind_stress_shelf_front_max', config_ziso_wind_stress_shelf_front_max)
+
+ ! frazil configures
+ call mpas_pool_get_config(domain % configs, 'config_ziso_frazil_enable', config_ziso_frazil_enable)
+ call mpas_pool_get_config(domain % configs, 'config_ziso_frazil_temperature_anomaly', config_ziso_frazil_temperature_anomaly)
+ !}}}
+
+ ! Determine vertical grid for configuration
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevelsP1', nVertLevelsP1)
+ call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere)
+
+ ! test if configure settings are invalid
+ if ( on_a_sphere ) call mpas_dmpar_global_abort('MPAS-ocean: ERROR: The ZISO configuration can only be ' &
+ // 'applied to a planar mesh. Exiting...')
+
+ ! Define interface locations
+ allocate(interfaceLocations(nVertLevelsP1))
+ call ocn_generate_vertical_grid( config_vertical_grid, interfaceLocations )
+
+ ! assign config variables
+ nVertLevels = config_ziso_vert_levels
+ nVertLevelsP1 = nVertLevels + 1
+
+ ! keep all cells on planar, periodic mesh (no culling)
+
+ !--------------------------------------------------------------------
+ ! Use this section to find min/max of grid to allow culling
+ !--------------------------------------------------------------------
+
+ ! Initalize min/max values to large positive and negative values
+ yMin = 1.0E10_RKIND
+ yMax = -1.0E10_RKIND
+ xMin = 1.0E10_RKIND
+ xMax = -1.0E10_RKIND
+ dcEdgeMin = 1.0E10_RKIND
+
+ ! Determine local min and max values.
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
+
+ yMin = min( yMin, minval(yCell(1:nCellsSolve)))
+ yMax = max( yMax, maxval(yCell(1:nCellsSolve)))
+ xMin = min( xMin, minval(xCell(1:nCellsSolve)))
+ xMax = max( xMax, maxval(xCell(1:nCellsSolve)))
+ dcEdgeMin = min( dcEdgeMin, minval(dcEdge(1:nEdgesSolve)))
+
+ block_ptr => block_ptr % next
+ end do ! do while(associated(block_ptr))
+
+
+ !--------------------------------------------------------------------
+ ! Use this section to set initial values
+ !--------------------------------------------------------------------
+
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ call mpas_pool_get_subpool(block_ptr % structs, 'mesh', meshPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'state', statePool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_subpool(block_ptr % structs, 'forcing', forcingPool)
+
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
+ call mpas_pool_get_dimension(meshPool, 'nVerticesSolve', nVerticesSolve)
+
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', index_temperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', index_salinity)
+
+ call mpas_pool_get_array(meshPool, 'xCell', xCell)
+ call mpas_pool_get_array(meshPool, 'yCell', yCell)
+ call mpas_pool_get_array(meshPool, 'xEdge', xEdge)
+ call mpas_pool_get_array(meshPool, 'yEdge', yEdge)
+ call mpas_pool_get_array(meshPool, 'xVertex', xVertex)
+ call mpas_pool_get_array(meshPool, 'yVertex', yVertex)
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_array(meshPool, 'vertCoordMovementWeights', vertCoordMovementWeights)
+ call mpas_pool_get_array(meshPool, 'bottomDepth', bottomDepth)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'fCell', fCell)
+ call mpas_pool_get_array(meshPool, 'fEdge', fEdge)
+ call mpas_pool_get_array(meshPool, 'fVertex', fVertex)
+
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+
+ call mpas_pool_get_array(verticalMeshPool, 'refZMid', refZMid)
+ call mpas_pool_get_array(verticalMeshPool, 'restingThickness', restingThickness)
+
+ call mpas_pool_get_array(forcingPool, 'windStressZonal', windStressZonal)
+ call mpas_pool_get_array(forcingPool, 'windStressMeridional', windStressMeridional)
+ ! tests to make sure these are allocated
+ if (.not. associated(windStressZonal) .or. .not. associated(windStressMeridional)) then
+ call mpas_dmpar_global_abort("MPAS-ocean: windStressZonal and / or windStressMeridional are not allocated")
+ end if
+
+ call mpas_pool_get_subpool(forcingPool, 'tracersSurfaceRestoringFields', tracersSurfaceRestoringFieldsPool)
+ if (.not. associated(tracersSurfaceRestoringFieldsPool)) then
+ call mpas_dmpar_global_abort("MPAS-ocean: tracersSurfaceRestoringFieldsPool not allocated.")
+ end if
+ call mpas_pool_get_subpool(forcingPool, 'tracersInteriorRestoringFields', tracersInteriorRestoringFieldsPool)
+ call mpas_pool_get_array(tracersSurfaceRestoringFieldsPool, 'activeTracersPistonVelocity', activeTracersPistonVelocity, 1)
+ if (.not. associated(activeTracersPistonVelocity)) then
+ call mpas_dmpar_global_abort("MPAS-ocean: activeTracersPistonVelocity not allocated.")
+ end if
+ call mpas_pool_get_array(tracersSurfaceRestoringFieldsPool, &
+ 'activeTracersSurfaceRestoringValue', activeTracersSurfaceRestoringValue, 1)
+ call mpas_pool_get_array(tracersInteriorRestoringFieldsPool, &
+ 'activeTracersInteriorRestoringRate', activeTracersInteriorRestoringRate, 1)
+ call mpas_pool_get_array(tracersInteriorRestoringFieldsPool, &
+ 'activeTracersInteriorRestoringValue', activeTracersInteriorRestoringValue, 1)
+
+ ! Determine global min and max values.
+ call mpas_dmpar_min_real(domain % dminfo, yMin, yMinGlobal)
+ call mpas_dmpar_max_real(domain % dminfo, yMax, yMaxGlobal)
+ call mpas_dmpar_min_real(domain % dminfo, xMin, xMinGlobal)
+ call mpas_dmpar_max_real(domain % dminfo, xMax, xMaxGlobal)
+ call mpas_dmpar_min_real(domain % dminfo, dcEdgeMin, dcEdgeMinGlobal)
+
+ ! mark north / south boundaries
+ if(config_write_cull_cell_mask) then
+ call ocn_mark_north_boundary(meshPool, yMaxGlobal, dcEdgeMinGlobal, iErr)
+ call ocn_mark_south_boundary(meshPool, yMinGlobal, dcEdgeMinGlobal, iErr)
+ call mpas_pool_get_config(meshPool, 'y_period', y_period)
+ y_period = 0.0_RKIND
+ endif
+ call mpas_stream_mgr_begin_iteration(domain % streamManager)
+ do while (mpas_stream_mgr_get_next_stream(domain % streamManager, streamID, directionProperty))
+ if ( directionProperty == MPAS_STREAM_OUTPUT .or. directionProperty == MPAS_STREAM_INPUT_OUTPUT ) then
+ call mpas_stream_mgr_add_att(domain % streamManager, 'y_period', 0.0_RKIND, streamID)
+ end if
+ end do
+
+ activeTracersInteriorRestoringRate(:,:,:) = 0.0_RKIND
+ activeTracersInteriorRestoringValue(:,:,:) = 0.0_RKIND
+ activeTracersPistonVelocity(:,:) = 0.0_RKIND
+ activeTracersSurfaceRestoringValue(:,:) = 0.0_RKIND
+
+
+ ! Set refBottomDepth and refZMid
+ do k = 1, nVertLevels
+ refBottomDepth(k) = config_ziso_bottom_depth * interfaceLocations(k+1)
+ refZMid(k) = - 0.5_RKIND * (interfaceLocations(k+1) + interfaceLocations(k)) * config_ziso_bottom_depth
+ end do
+
+ ! set bottomDepth and maxLevelCell !{{{{
+ bottomDepth(:) = 0.0_RKIND
+ do iCell = 1, nCellsSolve
+
+ if (config_ziso_use_slopping_bathymetry) then
+ ! bottom depth function to be applied
+ bottomDepth(iCell) = config_ziso_shelf_depth + &
+ 0.5_RKIND*(config_ziso_bottom_depth - config_ziso_shelf_depth) * &
+ (1.0_RKIND + tanh((yCell(iCell) - config_ziso_slope_center_position) / &
+ config_ziso_slope_half_width))
+ else
+ bottomDepth(iCell) = config_ziso_bottom_depth
+ end if
+
+ ! Determine maxLevelCell based on bottomDepth and refBottomDepth
+ ! Also set botomDepth based on refBottomDepth, since
+ ! above bottomDepth was set with continuous analytical functions,
+ ! and needs to be discrete
+ maxLevelCell(iCell) = nVertLevels
+ if (nVertLevels > 1) then
+ do k = 1, nVertLevels
+ if (bottomDepth(iCell) < refBottomDepth(k)) then
+ maxLevelCell(iCell) = k-1
+ bottomDepth(iCell) = refBottomDepth(k-1)
+ exit
+ end if
+ end do
+ end if
+
+ enddo ! Looping through with iCell !}}}
+
+ ! Set vertCoordMovementWeights
+ vertCoordMovementWeights(:) = 1.0_RKIND
+
+ do iCell = 1, nCellsSolve
+
+ ! Set initial temperature
+ idx = index_temperature
+ do k = 1, nVertLevels
+ activeTracers(idx, k, iCell) = config_ziso_initial_temp_t1 + &
+ config_ziso_initial_temp_t2*tanh(refZMid(k)/config_ziso_initial_temp_h1) + config_ziso_initial_temp_mt*refZMid(k)
+ end do
+
+ ! Set initial salinity
+ idx = index_salinity
+ do k = 1, nVertLevels
+ activeTracers(idx, k, iCell) = 34.0_RKIND
+ end do
+
+ ! Set layerThickness and restingThickness
+ ! Uniform layer thickness
+ do k = 1, nVertLevels
+ layerThickness(k, iCell) = config_ziso_bottom_depth * ( interfaceLocations(k+1) - interfaceLocations(k) )
+ restingThickness(k, iCell) = layerThickness(k, iCell)
+ end do
+
+ ! Set bottomDepth (above)
+
+ ! Set maxLevelCell (above)
+
+ ! set windstress
+ if (config_ziso_add_easterly_wind_stress_ASF) then
+ if(yCell(iCell) .ge. config_ziso_wind_transition_position) then
+ windStressZonal(iCell) = config_ziso_wind_stress_max*sin((pii*(yCell(iCell) - &
+ config_ziso_wind_transition_position) / &
+ (config_ziso_meridional_extent - config_ziso_wind_transition_position)))**2
+ elseif(yCell(iCell) .ge. config_ziso_wind_transition_position - config_ziso_antarctic_shelf_front_width) then
+ windStressZonal(iCell) = 0.0_RKIND
+ if(yCell(iCell) .lt. config_ziso_wind_transition_position) then
+ windStressZonal(iCell) = config_ziso_wind_stress_shelf_front_max * &
+ sin((pii*(config_ziso_wind_transition_position &
+ - yCell(iCell)))/config_ziso_antarctic_shelf_front_width)**2
+ endif
+ endif
+ else
+ windStressZonal(iCell) = config_ziso_wind_stress_max * exp(-((yCell(iCell) - &
+ config_ziso_meridional_extent/2.0_RKIND) / &
+ (config_ziso_meridional_extent/2.0_RKIND))**2.0_RKIND) * cos(pii/2.0_RKIND*(yCell(iCell) - &
+ config_ziso_meridional_extent/2.0_RKIND)/(config_ziso_meridional_extent/2.0_RKIND))
+ endif
+ windStressMeridional(iCell) = 0.0_RKIND
+
+ ! surface restoring
+ idx = index_temperature
+ activeTracersSurfaceRestoringValue(idx,iCell) = config_ziso_mean_restoring_temp &
+ + config_ziso_restoring_temp_dev_ta * &
+ tanh(2.0_RKIND*(yCell(iCell)-config_ziso_meridional_extent/2.0_RKIND)/(config_ziso_meridional_extent/2.0_RKIND)) &
+ + config_ziso_restoring_temp_dev_tb * &
+ (yCell(iCell)-config_ziso_meridional_extent/2.0_RKIND)/(config_ziso_meridional_extent/2.0_RKIND)
+ activeTracersPistonVelocity(idx,iCell) = config_ziso_restoring_temp_piston_vel
+ idx = index_salinity
+ activeTracersSurfaceRestoringValue(idx,iCell) = 34.0_RKIND
+ activeTracersPistonVelocity(idx,iCell) = 0.0_RKIND
+
+ ! set restoring at equatorward (north) boundary
+ do k = 1, nVertLevels
+ !Interior restoring along northern wall
+ if(config_ziso_meridional_extent-yCell(iCell) <= 1.5_RKIND*config_ziso_restoring_sponge_l) then
+ idx = index_temperature
+ activeTracersInteriorRestoringValue(idx, k, iCell) = activeTracersSurfaceRestoringValue(idx,iCell) &
+ * exp(refZMid(k)/config_ziso_restoring_temp_ze)
+ activeTracersInteriorRestoringRate(idx, k, iCell) = &
+ exp(-(config_ziso_meridional_extent-yCell(iCell))/config_ziso_restoring_sponge_l) &
+ * ( 1.0_RKIND / (config_ziso_restoring_temp_tau*86400.0_RKIND))
+ idx = index_salinity
+ activeTracersInteriorRestoringValue(idx, k, iCell) = 34.0_RKIND
+ activeTracersInteriorRestoringRate(idx, k, iCell) = 0.0_RKIND
+ end if
+ end do
+
+
+ ! set restoring at poleward (south) boundary
+ do k = 1, nVertLevels
+ !Interior restoring along southern wall
+ if(yCell(iCell) <= 2.0_RKIND*config_ziso_restoring_sponge_l) then
+ idx = index_temperature
+ activeTracersInteriorRestoringValue(idx, k, iCell) = activeTracersSurfaceRestoringValue(idx,iCell)
+ activeTracersInteriorRestoringRate(idx, k, iCell) = exp(-yCell(iCell)/config_ziso_restoring_sponge_l) &
+ * ( 1.0_RKIND / (config_ziso_restoring_temp_tau*86400.0_RKIND))
+ idx = index_salinity
+ activeTracersInteriorRestoringValue(idx, k, iCell) = 34.0_RKIND
+ activeTracersInteriorRestoringRate(idx, k, iCell) = 0.0_RKIND
+ end if
+ enddo
+
+!************************************************************************************************************************
+! this test case is overloaded with the ability to evaluate the frazil algorithm
+! if config_ziso_enable_frazil is true, some of the configure options are over written to make the test useful for frazil
+!************************************************************************************************************************
+
+ if(config_ziso_frazil_enable) then
+ config_ziso_initial_temp_t1 = 0.0_RKIND
+ config_ziso_initial_temp_t2 = -1.0_RKIND
+ config_ziso_initial_temp_h1 = 300.0_RKIND
+ config_ziso_initial_temp_mt = 0.0_RKIND
+
+ ! recompute initial temperature with altered parameters
+ idx = index_temperature
+ do k = 1, nVertLevels
+ activeTracers(idx, k, iCell) = config_ziso_initial_temp_t1 + &
+ config_ziso_initial_temp_t2*tanh(refZMid(k)/config_ziso_initial_temp_h1) + config_ziso_initial_temp_mt*refZMid(k)
+ end do
+
+ distanceX = config_ziso_meridional_extent/4.0_RKIND-xCell(iCell)
+ distanceY = config_ziso_meridional_extent/2.0_RKIND-yCell(iCell)
+ distance = sqrt(distanceY**2+distanceX**2)
+ scaleFactor = exp(-distance/config_ziso_meridional_extent*20.0_RKIND)
+ if (scaleFactor.gt.0.9_RKIND) write(stderrUnit,*) ' frazil production likely at this cell: ', iCell
+ do k = 1, nVertLevels
+ frazil_temperature = config_ziso_frazil_temperature_anomaly &
+ + config_ziso_initial_temp_t2 * tanh(refZMid(k) / config_ziso_initial_temp_h1) &
+ + config_ziso_initial_temp_mt * refZMid(k)
+ if (refZMid(k).gt.-50.0) frazil_temperature = frazil_temperature + 1.0_RKIND*cos( refZMid(k) / 50.0_RKIND &
+ * pii / 2.0_RKIND)
+ activeTracers(idx, k, iCell) = (1.0_RKIND-scaleFactor)* activeTracers(idx, k, iCell) + scaleFactor &
+ * frazil_temperature
+ end do
+ end if
+
+!*********************************************************************************
+! end frazil overload
+!*********************************************************************************
+
+ end do ! do iCell
+
+ ! write warning to stderrUnit
+ if(config_ziso_frazil_enable) then
+ write(stderrUnit,*)
+ write(stderrUnit,*) ' this test case is configured for the testing of the frazil algorithm'
+ write(stderrUnit,*)
+ endif
+
+ ! Set Coriolis parameters, if other than zero
+ do iCell = 1, nCellsSolve
+ fCell(iCell) = config_ziso_reference_coriolis + yCell(iCell) * config_ziso_coriolis_gradient
+ end do
+ do iEdge = 1, nEdgesSolve
+ fEdge(iEdge) = config_ziso_reference_coriolis + yEdge(iEdge) * config_ziso_coriolis_gradient
+ end do
+ do iVertex = 1, nVerticesSolve
+ fVertex(iVertex) = config_ziso_reference_coriolis + yVertex(iVertex) * config_ziso_reference_coriolis
+ end do
+
+ block_ptr => block_ptr % next
+ end do ! do while(associated(block_ptr))
+
+ write(stderrUnit,*) 'Finishing initialization of Zonally periodic Idealized Southern Ocean (ZISO)'
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_setup_ziso!}}}
+
+!***********************************************************************
+!
+! routine ocn_init_validate_ziso
+!
+!> \brief Validation for this initial condition
+!> \author Phillip J. Wolfram, Luke Van Roekel, Todd Ringler
+!> \date 09/14/2015
+!> \details
+!> This routine validates the configuration options for this case.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_validate_ziso(configPool, packagePool, iErr)!{{{
+
+ !--------------------------------------------------------------------
+
+ type (mpas_pool_type), intent(in) :: configPool, packagePool
+ integer, intent(out) :: iErr
+
+ character (len=StrKIND), pointer :: config_init_configuration
+ integer, pointer :: config_vert_levels, config_ziso_vert_levels
+
+ iErr = 0
+
+ call mpas_pool_get_config(configPool, 'config_init_configuration', config_init_configuration)
+ if(config_init_configuration .ne. trim('ziso')) return
+
+ call mpas_pool_get_config(configPool, 'config_vert_levels', config_vert_levels)
+ call mpas_pool_get_config(configPool, 'config_ziso_vert_levels', config_ziso_vert_levels)
+
+ if(config_vert_levels <= 0 .and. config_ziso_vert_levels > 0) then
+ config_vert_levels = config_ziso_vert_levels
+ else if (config_vert_levels <= 0) then
+ write(stderrUnit,*) 'ERROR: Validation failed for ziso. Not given a usable value for vertical levels.'
+ iErr = 1
+ end if
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_init_validate_ziso!}}}
+
+
+!***********************************************************************
+
+end module ocn_init_ziso
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/Makefile b/src/core_ocean/shared/Makefile
index bfcb3e7fe5..eb6dcab82c 100644
--- a/src/core_ocean/shared/Makefile
+++ b/src/core_ocean/shared/Makefile
@@ -1,12 +1,17 @@
.SUFFIXES: .F .o
+
+#Missing In Objs?
+#mpas_ocn_tracer_surface_flux.o
+
+
OBJS = mpas_ocn_init_routines.o \
- mpas_ocn_gm.o \
- mpas_ocn_diagnostics.o \
- mpas_ocn_diagnostics_routines.o \
- mpas_ocn_thick_ale.o \
- mpas_ocn_equation_of_state.o \
- mpas_ocn_equation_of_state_jm.o \
- mpas_ocn_equation_of_state_linear.o \
+ mpas_ocn_gm.o \
+ mpas_ocn_diagnostics.o \
+ mpas_ocn_diagnostics_routines.o \
+ mpas_ocn_thick_ale.o \
+ mpas_ocn_equation_of_state.o \
+ mpas_ocn_equation_of_state_jm.o \
+ mpas_ocn_equation_of_state_linear.o \
mpas_ocn_thick_hadv.o \
mpas_ocn_thick_vadv.o \
mpas_ocn_thick_surface_flux.o \
@@ -17,39 +22,53 @@ OBJS = mpas_ocn_init_routines.o \
mpas_ocn_vel_hmix_leith.o \
mpas_ocn_vel_hmix_del4.o \
mpas_ocn_vel_forcing.o \
- mpas_ocn_vel_forcing_windstress.o \
+ mpas_ocn_vel_forcing_surface_stress.o \
mpas_ocn_vel_forcing_rayleigh.o \
mpas_ocn_vel_pressure_grad.o \
mpas_ocn_vmix.o \
mpas_ocn_vmix_coefs_const.o \
mpas_ocn_vmix_coefs_rich.o \
mpas_ocn_vmix_coefs_tanh.o \
- mpas_ocn_vmix_coefs_redi.o \
+ mpas_ocn_vmix_coefs_redi.o \
mpas_ocn_vmix_cvmix.o \
mpas_ocn_tendency.o \
mpas_ocn_tracer_hmix.o \
mpas_ocn_tracer_hmix_del2.o \
mpas_ocn_tracer_hmix_del4.o \
+ mpas_ocn_tracer_hmix_redi.o \
mpas_ocn_tracer_advection.o \
+ mpas_ocn_tracer_advection_mono.o \
+ mpas_ocn_tracer_advection_std.o \
mpas_ocn_tracer_nonlocalflux.o \
mpas_ocn_tracer_short_wave_absorption.o \
mpas_ocn_tracer_short_wave_absorption_jerlov.o \
+ mpas_ocn_tracer_short_wave_absorption_variable.o \
+ mpas_ocn_tracer_surface_restoring.o \
+ mpas_ocn_tracer_interior_restoring.o \
+ mpas_ocn_tracer_exponential_decay.o \
+ mpas_ocn_tracer_ideal_age.o \
+ mpas_ocn_tracer_TTD.o \
+ mpas_ocn_tracer_ecosys.o \
+ mpas_ocn_tracer_DMS.o \
+ mpas_ocn_tracer_MacroMolecules.o \
mpas_ocn_high_freq_thickness_hmix_del2.o \
- mpas_ocn_tracer_surface_flux.o \
+ mpas_ocn_tracer_surface_flux_to_tend.o \
mpas_ocn_test.o \
mpas_ocn_constants.o \
mpas_ocn_forcing.o \
- mpas_ocn_forcing_bulk.o \
+ mpas_ocn_surface_bulk_forcing.o \
+ mpas_ocn_surface_land_ice_fluxes.o \
+ mpas_ocn_effective_density_in_land_ice.o \
+ mpas_ocn_frazil_forcing.o \
mpas_ocn_forcing_restoring.o \
- mpas_ocn_time_average.o \
mpas_ocn_time_average_coupled.o \
mpas_ocn_sea_ice.o
all: $(OBJS)
-mpas_ocn_init_routines.o: mpas_ocn_constants.o mpas_ocn_time_average.o mpas_ocn_diagnostics.o mpas_ocn_gm.o
+mpas_ocn_init_routines.o: mpas_ocn_constants.o mpas_ocn_diagnostics.o mpas_ocn_gm.o
-mpas_ocn_tendency.o: mpas_ocn_time_average.o mpas_ocn_high_freq_thickness_hmix_del2.o mpas_ocn_tracer_surface_flux.o mpas_ocn_thick_surface_flux.o mpas_ocn_tracer_short_wave_absorption.o mpas_ocn_tracer_advection.o mpas_ocn_tracer_hmix.o mpas_ocn_tracer_nonlocalflux.o mpas_ocn_vmix.o mpas_ocn_constants.o
+mpas_ocn_tendency.o: mpas_ocn_high_freq_thickness_hmix_del2.o mpas_ocn_tracer_surface_restoring.o mpas_ocn_thick_surface_flux.o mpas_ocn_tracer_short_wave_absorption.o mpas_ocn_tracer_advection.o mpas_ocn_tracer_hmix.o mpas_ocn_tracer_nonlocalflux.o mpas_ocn_surface_bulk_forcing.o mpas_ocn_surface_land_ice_fluxes.o mpas_ocn_tracer_surface_flux_to_tend.o mpas_ocn_tracer_interior_restoring.o mpas_ocn_tracer_exponential_decay.o mpas_ocn_tracer_ideal_age.o mpas_ocn_tracer_TTD.o mpas_ocn_vmix.o mpas_ocn_constants.o mpas_ocn_frazil_forcing.o mpas_ocn_tracer_ecosys.o mpas_ocn_tracer_DMS.o mpas_ocn_tracer_MacroMolecules.o
mpas_ocn_diagnostics_routines.o: mpas_ocn_constants.o
@@ -57,8 +76,6 @@ mpas_ocn_diagnostics.o: mpas_ocn_thick_ale.o mpas_ocn_diagnostics_routines.o mpa
mpas_ocn_thick_ale.o: mpas_ocn_constants.o
-mpas_ocn_time_average.o:
-
mpas_ocn_time_average_coupled.o: mpas_ocn_constants.o
mpas_ocn_thick_hadv.o: mpas_ocn_constants.o
@@ -81,21 +98,27 @@ mpas_ocn_vel_hmix_leith.o: mpas_ocn_constants.o
mpas_ocn_vel_hmix_del4.o: mpas_ocn_constants.o
-mpas_ocn_vel_forcing.o: mpas_ocn_vel_forcing_windstress.o mpas_ocn_vel_forcing_rayleigh.o mpas_ocn_forcing.o mpas_ocn_constants.o
+mpas_ocn_vel_forcing.o: mpas_ocn_vel_forcing_surface_stress.o mpas_ocn_vel_forcing_rayleigh.o mpas_ocn_forcing.o mpas_ocn_constants.o
-mpas_ocn_vel_forcing_windstress.o: mpas_ocn_forcing.o mpas_ocn_constants.o
+mpas_ocn_vel_forcing_surface_stress.o: mpas_ocn_forcing.o mpas_ocn_constants.o
mpas_ocn_vel_forcing_rayleigh.o: mpas_ocn_constants.o
mpas_ocn_vel_coriolis.o: mpas_ocn_constants.o
-mpas_ocn_tracer_hmix.o: mpas_ocn_tracer_hmix_del2.o mpas_ocn_tracer_hmix_del4.o
+mpas_ocn_tracer_hmix.o: mpas_ocn_tracer_hmix_del2.o mpas_ocn_tracer_hmix_del4.o mpas_ocn_tracer_hmix_redi.o
mpas_ocn_tracer_hmix_del2.o: mpas_ocn_constants.o
mpas_ocn_tracer_hmix_del4.o: mpas_ocn_constants.o
-mpas_ocn_tracer_advection.o: mpas_ocn_constants.o
+mpas_ocn_tracer_advection.o: mpas_ocn_constants.o mpas_ocn_tracer_advection_mono.o mpas_ocn_tracer_advection_std.o
+
+mpas_ocn_tracer_advection_mono.o: mpas_ocn_constants.o
+
+mpas_ocn_tracer_advection_std.o: mpas_ocn_constants.o
+
+mpas_ocn_tracer_hmix_redi.o: mpas_ocn_constants.o
mpas_ocn_high_freq_thickness_hmix_del2.o: mpas_ocn_constants.o
@@ -103,7 +126,9 @@ mpas_ocn_tracer_nonlocalflux.o: mpas_ocn_constants.o
mpas_ocn_tracer_surface_flux.o: mpas_ocn_forcing.o mpas_ocn_constants.o
-mpas_ocn_tracer_short_wave_absorption.o: mpas_ocn_tracer_short_wave_absorption_jerlov.o mpas_ocn_constants.o
+mpas_ocn_tracer_short_wave_absorption.o: mpas_ocn_tracer_short_wave_absorption_jerlov.o mpas_ocn_tracer_short_wave_absorption_variable.o mpas_ocn_constants.o
+
+mpas_ocn_tracer_short_wave_absorption_variable.o: mpas_ocn_constants.o
mpas_ocn_tracer_short_wave_absorption_jerlov.o: mpas_ocn_constants.o
@@ -129,14 +154,39 @@ mpas_ocn_test.o: mpas_ocn_constants.o
mpas_ocn_constants.o:
-mpas_ocn_forcing.o: mpas_ocn_constants.o mpas_ocn_forcing_bulk.o mpas_ocn_forcing_restoring.o
+mpas_ocn_forcing.o: mpas_ocn_constants.o mpas_ocn_forcing_restoring.o
+
+mpas_ocn_surface_bulk_forcing.o:
+
+mpas_ocn_surface_land_ice_fluxes.o: mpas_ocn_constants.o
+
+mpas_ocn_frazil_forcing.o: mpas_ocn_constants.o
-mpas_ocn_forcing_bulk.o: mpas_ocn_constants.o
+mpas_ocn_effective_density_in_land_ice.o: mpas_ocn_constants.o
mpas_ocn_forcing_restoring.o: mpas_ocn_constants.o
mpas_ocn_sea_ice.o: mpas_ocn_constants.o
+mpas_ocn_tracer_surface_restoring.o: mpas_ocn_constants.o
+
+mpas_ocn_tracer_interior_restoring.o: mpas_ocn_constants.o
+
+mpas_ocn_tracer_exponential_decay.o: mpas_ocn_constants.o
+
+mpas_ocn_tracer_ideal_age.o: mpas_ocn_constants.o
+
+mpas_ocn_tracer_TTD.o: mpas_ocn_constants.o
+
+mpas_ocn_tracer_ecosys.o: mpas_ocn_constants.o
+
+mpas_ocn_tracer_DMS.o: mpas_ocn_constants.o
+
+mpas_ocn_tracer_MacroMolecules.o: mpas_ocn_constants.o
+
+mpas_ocn_tracer_surface_flux_to_tend.o: mpas_ocn_constants.o
+
+mpas_ocn_time_average_coupled.o: mpas_ocn_constants.o
clean:
$(RM) *.o *.i *.mod *.f90
diff --git a/src/core_ocean/shared/mpas_ocn_constants.F b/src/core_ocean/shared/mpas_ocn_constants.F
index ad5d1f4501..a1c057b422 100644
--- a/src/core_ocean/shared/mpas_ocn_constants.F
+++ b/src/core_ocean/shared/mpas_ocn_constants.F
@@ -32,7 +32,7 @@ module ocn_constants
private
save
- public :: ocn_constants_init
+ public :: ocn_constants_init, ocn_freezing_temperature
type (mpas_pool_type), public, pointer :: ocnConfigs
type (mpas_pool_type), public, pointer :: ocnPackages
@@ -64,6 +64,7 @@ module ocn_constants
T0_Kelvin ,&! zero point for Celsius
mpercm ,&! meters per m
cmperm ,&! m per meter
+ days_per_second ,&! days per second
salt_to_ppt ,&! salt (kg/kg) to ppt
ppt_to_salt ,&! salt ppt to kg/kg
mass_to_Sv ,&! mass flux to Sverdrups
@@ -87,7 +88,7 @@ module ocn_constants
!> \brief Initializes the ocean constants
!> \author Doug Jacobsen
!> \date 04/25/12
-!> \details
+!> \details
!> This routine sets up constants for use in the ocean model.
!
!-----------------------------------------------------------------------
@@ -96,9 +97,13 @@ subroutine ocn_constants_init(configPool, packagePool)!{{{
type (mpas_pool_type), pointer :: packagePool
integer :: n
+ real (kind=RKIND), pointer :: config_density0
+
ocnConfigs => configPool
ocnPackages => packagePool
+ call mpas_pool_get_config(configPool, 'config_density0', config_density0)
+
!-----------------------------------------------------------------------
!
! physical constants
@@ -109,7 +114,7 @@ subroutine ocn_constants_init(configPool, packagePool)!{{{
T0_Kelvin = 273.16_RKIND ! zero point for Celsius
rho_air = 1.2_RKIND ! ambient air density (kg/m^3)
- rho_sw = 1.026e3_RKIND ! density of salt water (kg/m^3)
+ rho_sw = config_density0 ! density of salt water (kg/m^3)
rho_fw = 1.0e3_RKIND ! avg. water density (kg/m^3)
rho_ice = 0.917e3_RKIND ! density of ice (kg/m^3)
cp_sw = 3.996e3_RKIND ! specific heat salt water
@@ -131,6 +136,7 @@ subroutine ocn_constants_init(configPool, packagePool)!{{{
!
!-----------------------------------------------------------------------
+ days_per_second = 1._RKIND/86400._RKIND ! days per second
salt_to_ppt = 1000._RKIND ! salt (kg/kg) to ppt
ppt_to_salt = 1.e-3_RKIND ! salt ppt to kg/kg
mass_to_Sv = 1.0e-12_RKIND ! mass flux to Sverdrups
@@ -155,7 +161,7 @@ subroutine ocn_constants_init(configPool, packagePool)!{{{
vonkar = SHR_CONST_KARMAN
stefan_boltzmann = SHR_CONST_STEBOL ! W/m^2/K^4
latent_heat_vapor_mks = SHR_CONST_LATVAP ! J/kg
- latent_heat_fusion_mks = SHR_CONST_LATICE ! J/kg
+ latent_heat_fusion_mks = SHR_CONST_LATICE ! J/kg
ocn_ref_salinity = SHR_CONST_OCN_REF_SAL ! psu
sea_ice_salinity = SHR_CONST_ICE_REF_SAL ! psu
#endif
@@ -257,6 +263,24 @@ subroutine ocn_constants_init(configPool, packagePool)!{{{
end subroutine ocn_constants_init!}}}
+!***********************************************************************
+!
+! function ocn_freezing_temperature
+!
+!> \brief Computes the freezing temperature of the ocean.
+!> \author Doug Jacobsen
+!> \date 08/29/2013
+!> \details
+!> This routine computes the freezing temperature of the ocean at a given
+!> salinity value.
+!
+!-----------------------------------------------------------------------
+ real (kind=RKIND) function ocn_freezing_temperature(salinity)!{{{
+ real (kind=RKIND) :: salinity !< Input: Salinity value of water for freezing temperature
+
+ ocn_freezing_temperature = -1.8_RKIND
+ end function ocn_freezing_temperature!}}}
+
!***********************************************************************
end module ocn_constants
diff --git a/src/core_ocean/shared/mpas_ocn_diagnostics.F b/src/core_ocean/shared/mpas_ocn_diagnostics.F
index 6bd850a9d7..b81564f86e 100644
--- a/src/core_ocean/shared/mpas_ocn_diagnostics.F
+++ b/src/core_ocean/shared/mpas_ocn_diagnostics.F
@@ -24,6 +24,7 @@ module ocn_diagnostics
use mpas_pool_routines
use mpas_constants
use mpas_timer
+ use mpas_threading
use mpas_vector_reconstruction
use ocn_constants
@@ -77,12 +78,13 @@ module ocn_diagnostics
!> \brief Computes diagnostic variables
!> \author Mark Petersen
!> \date 23 September 2011
-!> \details
+!> \details
!> This routine computes the diagnostic variables for the ocean
!
!-----------------------------------------------------------------------
- subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, timeLevelIn)!{{{
+ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, tracersPool, &!{{{
+ timeLevelIn)
real (kind=RKIND), intent(in) :: dt !< Input: Time step
type (mpas_pool_type), intent(in) :: statePool !< Input: State information
@@ -90,6 +92,7 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
type (mpas_pool_type), intent(in) :: meshPool !< Input: mesh information
type (mpas_pool_type), intent(inout) :: diagnosticsPool !< Input: diagnostic fields derived from State
type (mpas_pool_type), intent(in) :: scratchPool !< Input: scratch variables
+ type (mpas_pool_type), intent(in) :: tracersPool !< Input: tracer fields
integer, intent(in), optional :: timeLevelIn !< Input: Time level in state
integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j
@@ -101,7 +104,7 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
maxLevelVertexBot
integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, &
verticesOnEdge, edgesOnEdge, edgesOnVertex,boundaryCell, kiteIndexOnCell, &
- verticesOnCell, edgeSignOnVertex, edgeSignOnCell, edgesOnCell
+ verticesOnCell, edgeSignOnVertex, edgeSignOnCell, edgesOnCell, edgeMask
real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2, coef_3rd_order, r_tmp, &
invAreaCell1, invAreaCell2, invAreaTri1, invAreaTri2, invLength, layerThicknessVertex, coef, &
@@ -110,19 +113,19 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
real (kind=RKIND), dimension(:), allocatable:: pTop, div_hu,div_huTransport,div_huGMBolus
real (kind=RKIND), dimension(:), pointer :: &
- bottomDepth, fVertex, dvEdge, dcEdge, areaCell, areaTriangle, ssh, seaSurfacePressure
+ bottomDepth, fVertex, dvEdge, dcEdge, areaCell, areaTriangle, ssh, seaSurfacePressure, frazilSurfacePressure, &
+ pressureAdjustedSSH, gradSSH
real (kind=RKIND), dimension(:,:), pointer :: &
- weightsOnEdge, kiteAreasOnVertex, layerThicknessEdge, layerThickness, normalVelocity, normalTransportVelocity, normalGMBolusVelocity, tangentialVelocity, pressure,&
- circulation, kineticEnergyCell, montgomeryPotential, vertAleTransportTop, zMid, zTop, divergence, &
- relativeVorticity, relativeVorticityCell, &
- normalizedPlanetaryVorticityEdge, normalizedPlanetaryVorticityVertex, &
- normalizedRelativeVorticityEdge, normalizedRelativeVorticityVertex, normalizedRelativeVorticityCell, &
- density, displacedDensity, potentialDensity, temperature, salinity, kineticEnergyVertex, kineticEnergyVertexOnCells, &
- vertVelocityTop, vertTransportVelocityTop, vertGMBolusVelocityTop, BruntVaisalaFreqTop, &
- vorticityGradientNormalComponent, vorticityGradientTangentialComponent, gradSSH, RiTopOfCell, &
- inSituThermalExpansionCoeff, inSituSalineContractionCoeff
-
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers, derivTwo
+ weightsOnEdge, kiteAreasOnVertex, layerThicknessEdge, layerThickness, normalVelocity, normalTransportVelocity, &
+ normalGMBolusVelocity, tangentialVelocity, pressure, circulation, kineticEnergyCell, montgomeryPotential, &
+ vertAleTransportTop, zMid, zTop, divergence, relativeVorticity, relativeVorticityCell, &
+ normalizedPlanetaryVorticityEdge, normalizedPlanetaryVorticityVertex, normalizedRelativeVorticityEdge, &
+ normalizedRelativeVorticityVertex, normalizedRelativeVorticityCell, density, displacedDensity, potentialDensity, &
+ temperature, salinity, kineticEnergyVertex, kineticEnergyVertexOnCells, vertVelocityTop, vertTransportVelocityTop, &
+ vertGMBolusVelocityTop, BruntVaisalaFreqTop, vorticityGradientNormalComponent, vorticityGradientTangentialComponent, &
+ RiTopOfCell, inSituThermalExpansionCoeff, inSituSalineContractionCoeff
+
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers, derivTwo
character :: c1*6
real (kind=RKIND), dimension(:,:), pointer :: tracersSurfaceValue
@@ -137,28 +140,35 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
integer :: timeLevel
integer, pointer :: indexTemperature, indexSalinity
logical, pointer :: config_use_cvmix_kpp
- real (kind=RKIND), pointer :: config_density0, config_apvm_scale_factor, config_coef_3rd_order, config_cvmix_kpp_surface_layer_averaging
+ real (kind=RKIND), pointer :: config_apvm_scale_factor, config_coef_3rd_order, config_cvmix_kpp_surface_layer_averaging
character (len=StrKIND), pointer :: config_pressure_gradient_type
+ real (kind=RKIND), pointer :: config_flux_attenuation_coefficient
+ real (kind=RKIND), pointer :: config_flux_attenuation_coefficient_runoff
+ real (kind=RKIND), dimension(:), pointer :: surfaceFluxAttenuationCoefficient
+ real (kind=RKIND), dimension(:), pointer :: surfaceFluxAttenuationCoefficientRunoff
+
if (present(timeLevelIn)) then
timeLevel = timeLevelIn
else
timeLevel = 1
end if
- call mpas_pool_get_config(ocnConfigs, 'config_density0', config_density0)
call mpas_pool_get_config(ocnConfigs, 'config_apvm_scale_factor', config_apvm_scale_factor)
call mpas_pool_get_config(ocnConfigs, 'config_pressure_gradient_type', config_pressure_gradient_type)
call mpas_pool_get_config(ocnConfigs, 'config_coef_3rd_order', config_coef_3rd_order)
call mpas_pool_get_config(ocnConfigs, 'config_cvmix_kpp_surface_layer_averaging', config_cvmix_kpp_surface_layer_averaging)
call mpas_pool_get_config(ocnConfigs, 'config_use_cvmix_kpp', config_use_cvmix_kpp)
+ call mpas_pool_get_config(ocnConfigs, 'config_flux_attenuation_coefficient', config_flux_attenuation_coefficient)
+ call mpas_pool_get_config(ocnConfigs, 'config_flux_attenuation_coefficient_runoff', &
+ config_flux_attenuation_coefficient_runoff)
- call mpas_pool_get_dimension(statePool, 'index_temperature', indexTemperature)
- call mpas_pool_get_dimension(statePool, 'index_salinity', indexSalinity)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', indexTemperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', indexSalinity)
call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, timeLevel)
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, timeLevel)
- call mpas_pool_get_array(statePool, 'tracers', tracers, timeLevel)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, timeLevel)
call mpas_pool_get_array(statePool, 'ssh', ssh, timeLevel)
call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
@@ -186,6 +196,7 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
call mpas_pool_get_array(diagnosticsPool, 'normalTransportVelocity', normalTransportVelocity)
call mpas_pool_get_array(diagnosticsPool, 'gradSSH', gradSSH)
call mpas_pool_get_array(diagnosticsPool, 'RiTopOfCell', RiTopOfCell)
+ call mpas_pool_get_array(diagnosticsPool, 'pressureAdjustedSSH', pressureAdjustedSSH)
call mpas_pool_get_array(meshPool, 'weightsOnEdge', weightsOnEdge)
call mpas_pool_get_array(meshPool, 'kiteAreasOnVertex', kiteAreasOnVertex)
@@ -213,9 +224,11 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
call mpas_pool_get_array(meshPool, 'boundaryCell', boundaryCell)
call mpas_pool_get_array(meshPool, 'edgeSignOnVertex', edgeSignOnVertex)
call mpas_pool_get_array(meshPool, 'edgeSignOnCell', edgeSignOnCell)
+ call mpas_pool_get_array(meshPool, 'edgeMask', edgeMask)
call mpas_pool_get_array(forcingPool, 'seaSurfacePressure', seaSurfacePressure)
-
+ call mpas_pool_get_array(forcingPool, 'frazilSurfacePressure', frazilSurfacePressure)
+
call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
@@ -228,74 +241,105 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
call mpas_pool_get_array(diagnosticsPool, 'normalVelocitySurfaceLayer', normalVelocitySurfaceLayer)
call mpas_pool_get_array(diagnosticsPool, 'indexSurfaceLayerDepth', indexSurfaceLayerDepth)
+ call mpas_pool_get_array(diagnosticsPool, 'surfaceFluxAttenuationCoefficient', surfaceFluxAttenuationCoefficient)
+ call mpas_pool_get_array(diagnosticsPool, 'surfaceFluxAttenuationCoefficientRunoff', surfaceFluxAttenuationCoefficientRunoff)
!
! Compute height on cell edges at velocity locations
! Namelist options control the order of accuracy of the reconstructed layerThicknessEdge value
!
! initialize layerThicknessEdge to avoid divide by zero and NaN problems.
- layerThicknessEdge = -1.0e34
- coef_3rd_order = config_coef_3rd_order
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ layerThicknessEdge(:, iEdge) = -1.0e34_RKIND
+ end do
+ !$omp end do
+ coef_3rd_order = config_coef_3rd_order
+ !$omp do schedule(runtime) private(cell1, cell2, k)
do iEdge = 1, nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
do k = 1, maxLevelEdgeTop(iEdge)
- layerThicknessEdge(k,iEdge) = 0.5 * (layerThickness(k,cell1) + layerThickness(k,cell2))
+ layerThicknessEdge(k,iEdge) = 0.5_RKIND * (layerThickness(k,cell1) + layerThickness(k,cell2))
end do
end do
+ !$omp end do
!
! set the velocity and height at dummy address
! used -1e34 so error clearly occurs if these values are used.
!
+
+ !$omp single
normalVelocity(:,nEdges+1) = -1e34
layerThickness(:,nCells+1) = -1e34
- tracers(indexTemperature,:,nCells+1) = -1e34
- tracers(indexSalinity,:,nCells+1) = -1e34
+ activeTracers(indexTemperature,:,nCells+1) = -1e34
+ activeTracers(indexSalinity,:,nCells+1) = -1e34
+ !$omp end single
+
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ divergence(:, iCell) = 0.0_RKIND
+ vertVelocityTop(:, iCell) = 0.0_RKIND
+ kineticEnergyCell(:, iCell) = 0.0_RKIND
+ end do
+ !$omp end do
+
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ tangentialVelocity(:, iEdge) = 0.0_RKIND
+ end do
+ !$omp end do
- divergence(:,:) = 0.0
- vertVelocityTop(:,:)=0.0
- kineticEnergyCell(:,:) = 0.0
- tangentialVelocity(:,:) = 0.0
+ call mpas_threading_barrier()
call ocn_relativeVorticity_circulation(relativeVorticity, circulation, meshPool, normalVelocity, err)
- relativeVorticityCell(:,:) = 0.0
+ call mpas_threading_barrier()
+
+ !$omp do schedule(runtime) private(invAreaCell1, i, j, k, iVertex)
do iCell = 1, nCells
- invAreaCell1 = 1.0 / areaCell(iCell)
+ relativeVorticityCell(:,iCell) = 0.0_RKIND
+ invAreaCell1 = 1.0_RKIND / areaCell(iCell)
do i = 1, nEdgesOnCell(iCell)
j = kiteIndexOnCell(i, iCell)
iVertex = verticesOnCell(i, iCell)
do k = 1, maxLevelCell(iCell)
- relativeVorticityCell(k, iCell) = relativeVorticityCell(k, iCell) + kiteAreasOnVertex(j, iVertex) * relativeVorticity(k, iVertex) * invAreaCell1
+ relativeVorticityCell(k, iCell) = relativeVorticityCell(k, iCell) + kiteAreasOnVertex(j, iVertex) &
+ * relativeVorticity(k, iVertex) * invAreaCell1
end do
end do
end do
+ !$omp end do
!
! Compute divergence, kinetic energy, and vertical velocity
!
allocate(div_hu(nVertLevels),div_huTransport(nVertLevels),div_huGMBolus(nVertLevels))
+
+ !$omp do schedule(runtime) private(invAreaCell1, iEdge, r_tmp, i, k)
do iCell = 1, nCells
- div_hu(:) = 0.0
- div_huTransport(:) = 0.0
- div_huGMBolus(:) = 0.0
- invAreaCell1 = 1.0 / areaCell(iCell)
+ div_hu(:) = 0.0_RKIND
+ div_huTransport(:) = 0.0_RKIND
+ div_huGMBolus(:) = 0.0_RKIND
+ invAreaCell1 = 1.0_RKIND / areaCell(iCell)
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
do k = 1, maxLevelCell(iCell)
r_tmp = dvEdge(iEdge) * normalVelocity(k, iEdge) * invAreaCell1
divergence(k, iCell) = divergence(k, iCell) - edgeSignOnCell(i, iCell) * r_tmp
- div_hu(k) = div_hu(k) - layerThicknessEdge(k, iEdge) * edgeSignOnCell(i, iCell) * r_tmp
+ div_hu(k) = div_hu(k) - layerThicknessEdge(k, iEdge) * edgeSignOnCell(i, iCell) * r_tmp
kineticEnergyCell(k, iCell) = kineticEnergyCell(k, iCell) + 0.25 * r_tmp * dcEdge(iEdge) * normalVelocity(k,iEdge)
! Compute vertical velocity from the horizontal total transport
- div_huTransport(k) = div_huTransport(k) - layerThicknessEdge(k, iEdge) * edgeSignOnCell(i, iCell) * dvEdge(iEdge) * normalTransportVelocity(k, iEdge) * invAreaCell1
+ div_huTransport(k) = div_huTransport(k) - layerThicknessEdge(k, iEdge) * edgeSignOnCell(i, iCell) &
+ * dvEdge(iEdge) * normalTransportVelocity(k, iEdge) * invAreaCell1
! Compute vertical velocity from the horizontal GM Bolus velocity
- div_huGMBolus(k) = div_huGMBolus(k) - layerThicknessEdge(k, iEdge) * edgeSignOnCell(i, iCell) * dvEdge(iEdge) * normalGMBolusVelocity(k, iEdge) * invAreaCell1
+ div_huGMBolus(k) = div_huGMBolus(k) - layerThicknessEdge(k, iEdge) * edgeSignOnCell(i, iCell) * dvEdge(iEdge) &
+ * normalGMBolusVelocity(k, iEdge) * invAreaCell1
end do
end do
! Vertical velocity at bottom (maxLevelCell(iCell)+1) is zero, initialized above.
@@ -303,19 +347,23 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
vertVelocityTop(k,iCell) = vertVelocityTop(k+1,iCell) - div_hu(k)
vertTransportVelocityTop(k,iCell) = vertTransportVelocityTop(k+1,iCell) - div_huTransport(k)
vertGMBolusVelocityTop(k,iCell) = vertGMBolusVelocityTop(k+1,iCell) - div_huGMBolus(k)
- end do
+ end do
end do
+ !$omp end do
+
deallocate(div_hu,div_huTransport,div_huGMBolus)
+ !$omp do schedule(runtime) private(eoe, i, k)
do iEdge = 1, nEdges
! Compute v (tangential) velocities
do i = 1, nEdgesOnEdge(iEdge)
eoe = edgesOnEdge(i,iEdge)
- do k = 1, maxLevelEdgeTop(iEdge)
+ do k = 1, maxLevelEdgeTop(iEdge)
tangentialVelocity(k,iEdge) = tangentialVelocity(k,iEdge) + weightsOnEdge(i,iEdge) * normalVelocity(k, eoe)
end do
end do
end do
+ !$omp end do
!
! Compute kinetic energy
@@ -324,40 +372,52 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
call mpas_pool_get_field(scratchPool, 'kineticEnergyVertexOnCells', kineticEnergyVertexOnCellsField)
call mpas_allocate_scratch_field(kineticEnergyVertexField, .true.)
call mpas_allocate_scratch_field(kineticEnergyVertexOnCellsField, .true.)
+ call mpas_threading_barrier()
+
kineticEnergyVertex => kineticEnergyVertexField % array
kineticEnergyVertexOnCells => kineticEnergyVertexOnCellsField % array
- kineticEnergyVertex(:,:) = 0.0;
- kineticEnergyVertexOnCells(:,:) = 0.0
+
+ !$omp do schedule(runtime) private(i, iEdge, r_tmp, k)
do iVertex = 1, nVertices*ke_vertex_flag
+ kineticEnergyVertex(:, iVertex) = 0.0_RKIND
do i = 1, vertexDegree
iEdge = edgesOnVertex(i, iVertex)
- r_tmp = dcEdge(iEdge) * dvEdge(iEdge) * 0.25 / areaTriangle(iVertex)
+ r_tmp = dcEdge(iEdge) * dvEdge(iEdge) * 0.25_RKIND / areaTriangle(iVertex)
do k = 1, nVertLevels
kineticEnergyVertex(k, iVertex) = kineticEnergyVertex(k, iVertex) + r_tmp * normalVelocity(k, iEdge)**2
end do
end do
end do
+ !$omp end do
+ !$omp do schedule(runtime) private(invAreaCell1, i, j, iVertex, k)
do iCell = 1, nCells*ke_vertex_flag
- invAreaCell1 = 1.0 / areaCell(iCell)
+ kineticEnergyVertexOnCells(:, iCell) = 0.0_RKIND
+ invAreaCell1 = 1.0_RKIND / areaCell(iCell)
do i = 1, nEdgesOnCell(iCell)
j = kiteIndexOnCell(i, iCell)
iVertex = verticesOnCell(i, iCell)
do k = 1, nVertLevels
- kineticEnergyVertexOnCells(k, iCell) = kineticEnergyVertexOnCells(k, iCell) + kiteAreasOnVertex(j, iVertex) * kineticEnergyVertex(k, iVertex) * invAreaCell1
+ kineticEnergyVertexOnCells(k, iCell) = kineticEnergyVertexOnCells(k, iCell) + kiteAreasOnVertex(j, iVertex) &
+ * kineticEnergyVertex(k, iVertex) * invAreaCell1
end do
end do
end do
+ !$omp end do
!
! Compute kinetic energy in each cell by blending kineticEnergyCell and kineticEnergyVertexOnCells
!
+ !$omp do schedule(runtime) private(k)
do iCell = 1, nCells * ke_vertex_flag
do k = 1, nVertLevels
- kineticEnergyCell(k,iCell) = 5.0 / 8.0 * kineticEnergyCell(k,iCell) + 3.0 / 8.0 * kineticEnergyVertexOnCells(k,iCell)
+ kineticEnergyCell(k,iCell) = 5.0_RKIND / 8.0_RKIND * kineticEnergyCell(k,iCell) + 3.0_RKIND / 8.0_RKIND &
+ * kineticEnergyVertexOnCells(k,iCell)
end do
end do
+ !$omp end do
+ call mpas_threading_barrier()
call mpas_deallocate_scratch_field(kineticEnergyVertexField, .true.)
call mpas_deallocate_scratch_field(kineticEnergyVertexOnCellsField, .true.)
@@ -368,14 +428,19 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
call mpas_pool_get_field(scratchPool, 'normalizedPlanetaryVorticityVertex', normalizedPlanetaryVorticityVertexField)
call mpas_allocate_scratch_field(normalizedRelativeVorticityVertexField, .true.)
call mpas_allocate_scratch_field(normalizedPlanetaryVorticityVertexField, .true.)
+ call mpas_threading_barrier()
+
normalizedPlanetaryVorticityVertex => normalizedPlanetaryVorticityVertexField % array
normalizedRelativeVorticityVertex => normalizedRelativeVorticityVertexField % array
+
+ !$omp do schedule(runtime) private(invAreaTri1, k, layerThicknessVertex, i)
do iVertex = 1, nVertices
- invAreaTri1 = 1.0 / areaTriangle(iVertex)
+ invAreaTri1 = 1.0_RKIND / areaTriangle(iVertex)
do k = 1, maxLevelVertexBot(iVertex)
- layerThicknessVertex = 0.0
+ layerThicknessVertex = 0.0_RKIND
do i = 1, vertexDegree
- layerThicknessVertex = layerThicknessVertex + layerThickness(k,cellsOnVertex(i,iVertex)) * kiteAreasOnVertex(i,iVertex)
+ layerThicknessVertex = layerThicknessVertex + layerThickness(k,cellsOnVertex(i,iVertex)) &
+ * kiteAreasOnVertex(i,iVertex)
end do
layerThicknessVertex = layerThicknessVertex * invAreaTri1
@@ -383,21 +448,27 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
normalizedPlanetaryVorticityVertex(k,iVertex) = fVertex(iVertex) / layerThicknessVertex
end do
end do
+ !$omp end do
- normalizedRelativeVorticityEdge(:,:) = 0.0
- normalizedPlanetaryVorticityEdge(:,:) = 0.0
+ !$omp do schedule(runtime) private(vertex1, vertex2, k)
do iEdge = 1, nEdges
+ normalizedRelativeVorticityEdge(:, iEdge) = 0.0_RKIND
+ normalizedPlanetaryVorticityEdge(:, iEdge) = 0.0_RKIND
vertex1 = verticesOnEdge(1, iEdge)
vertex2 = verticesOnEdge(2, iEdge)
do k = 1, maxLevelEdgeBot(iEdge)
- normalizedRelativeVorticityEdge(k, iEdge) = 0.5 * (normalizedRelativeVorticityVertex(k, vertex1) + normalizedRelativeVorticityVertex(k, vertex2))
- normalizedPlanetaryVorticityEdge(k, iEdge) = 0.5 * (normalizedPlanetaryVorticityVertex(k, vertex1) + normalizedPlanetaryVorticityVertex(k, vertex2))
+ normalizedRelativeVorticityEdge(k, iEdge) = 0.5_RKIND * (normalizedRelativeVorticityVertex(k, vertex1) &
+ + normalizedRelativeVorticityVertex(k, vertex2))
+ normalizedPlanetaryVorticityEdge(k, iEdge) = 0.5_RKIND * (normalizedPlanetaryVorticityVertex(k, vertex1) &
+ + normalizedPlanetaryVorticityVertex(k, vertex2))
end do
end do
+ !$omp end do
- normalizedRelativeVorticityCell(:,:) = 0.0
+ !$omp do schedule(runtime) private(invAreaCell1, i, j, iVertex, k)
do iCell = 1, nCells
- invAreaCell1 = 1.0 / areaCell(iCell)
+ normalizedRelativeVorticityCell(:, iCell) = 0.0_RKIND
+ invAreaCell1 = 1.0_RKIND / areaCell(iCell)
do i = 1, nEdgesOnCell(iCell)
j = kiteIndexOnCell(i, iCell)
@@ -408,6 +479,7 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
end do
end do
end do
+ !$omp end do
! Diagnostics required for the Anticipated Potential Vorticity Method (apvm).
if (config_apvm_scale_factor>1e-10) then
@@ -416,16 +488,19 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
call mpas_pool_get_field(scratchPool, 'vorticityGradientTangentialComponent', vorticityGradientTangentialComponentField)
call mpas_allocate_scratch_field(vorticityGradientNormalComponentField, .true.)
call mpas_allocate_scratch_field(vorticityGradientTangentialComponentField, .true.)
+ call mpas_threading_barrier()
+
vorticityGradientNormalComponent => vorticityGradientNormalComponentField % array
vorticityGradientTangentialComponent => vorticityGradientTangentialComponentField % array
+ !$omp do schedule(runtime) private(cell1, cell2, vertex1, vertex2, invLength, k)
do iEdge = 1,nEdges
cell1 = cellsOnEdge(1, iEdge)
cell2 = cellsOnEdge(2, iEdge)
vertex1 = verticesOnedge(1, iEdge)
vertex2 = verticesOnedge(2, iEdge)
- invLength = 1.0 / dcEdge(iEdge)
+ invLength = 1.0_RKIND / dcEdge(iEdge)
! Compute gradient of PV in normal direction
! ( this computes the gradient for all edges bounding real cells )
do k=1,maxLevelEdgeTop(iEdge)
@@ -433,7 +508,7 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
(normalizedRelativeVorticityCell(k,cell2) - normalizedRelativeVorticityCell(k,cell1)) * invLength
enddo
- invLength = 1.0 / dvEdge(iEdge)
+ invLength = 1.0_RKIND / dvEdge(iEdge)
! Compute gradient of PV in the tangent direction
! ( this computes the gradient at all edges bounding real cells and distance-1 ghost cells )
do k = 1,maxLevelEdgeBot(iEdge)
@@ -442,10 +517,12 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
enddo
enddo
+ !$omp end do
!
! Modify PV edge with upstream bias.
!
+ !$omp do schedule(runtime) private(k)
do iEdge = 1,nEdges
do k = 1,maxLevelEdgeBot(iEdge)
normalizedRelativeVorticityEdge(k,iEdge) = normalizedRelativeVorticityEdge(k,iEdge) &
@@ -454,10 +531,15 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
+ tangentialVelocity(k,iEdge) * vorticityGradientTangentialComponent(k,iEdge) )
enddo
enddo
+ !$omp end do
+
+ call mpas_threading_barrier()
call mpas_deallocate_scratch_field(vorticityGradientNormalComponentField, .true.)
call mpas_deallocate_scratch_field(vorticityGradientTangentialComponentField, .true.)
endif
+
+ call mpas_threading_barrier()
call mpas_deallocate_scratch_field(normalizedRelativeVorticityVertexField, .true.)
call mpas_deallocate_scratch_field(normalizedPlanetaryVorticityVertexField, .true.)
@@ -471,19 +553,23 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
! only compute EOS derivatives if needed.
call mpas_pool_get_array(diagnosticsPool, 'inSituThermalExpansionCoeff',inSituThermalExpansionCoeff)
call mpas_pool_get_array(diagnosticsPool, 'inSituSalineContractionCoeff', inSituSalineContractionCoeff)
- call ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, 0, 'relative', density, err, &
+ call ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, scratchPool, 0, 'relative', density, err, &
inSituThermalExpansionCoeff, inSituSalineContractionCoeff, timeLevelIn=timeLevel)
else
- call ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, 0, 'relative', density, err, &
+ call ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, scratchPool, 0, 'relative', density, err, &
timeLevelIn=timeLevel)
endif
+ call mpas_threading_barrier()
! compute potentialDensity, the density displaced adiabatically to the mid-depth of top layer.
- call ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, 1, 'absolute', potentialDensity, err, timeLevelIn=timeLevel)
+ call ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, scratchPool, 1, 'absolute', potentialDensity, &
+ err, timeLevelIn=timeLevel)
- ! compute displacedDensity, density displaced adiabatically to the mid-depth one layer deeper.
+ ! compute displacedDensity, density displaced adiabatically to the mid-depth one layer deeper.
! That is, layer k has been displaced to the depth of layer k+1.
- call ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, 1, 'relative', displacedDensity, err, timeLevelIn=timeLevel)
+ call ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, scratchPool, 1, 'relative', displacedDensity, &
+ err, timeLevelIn=timeLevel)
+ call mpas_threading_barrier()
call mpas_timer_stop("equation of state")
@@ -496,12 +582,15 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
! use Montgomery Potential when layers are isopycnal.
! However, one may use 'pressure_and_zmid' when layers are isopycnal as well.
! Compute pressure at top of each layer, and then Montgomery Potential.
+
allocate(pTop(nVertLevels))
+
+ !$omp do schedule(runtime) private(k)
do iCell = 1, nCells
! assume atmospheric pressure at the surface is zero for now.
- pTop(1) = 0.0
- ! At top layer it is g*SSH, where SSH may be off by a
+ pTop(1) = 0.0_RKIND
+ ! At top layer it is g*SSH, where SSH may be off by a
! constant (ie, bottomDepth can be relative to top or bottom)
montgomeryPotential(1,iCell) = gravity &
* (bottomDepth(iCell) + sum(layerThickness(1:nVertLevels,iCell)))
@@ -511,24 +600,29 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
! from delta M = p delta / density
montgomeryPotential(k,iCell) = montgomeryPotential(k-1,iCell) &
- + pTop(k)*(1.0/density(k,iCell) - 1.0/density(k-1,iCell))
+ + pTop(k)*(1.0_RKIND/density(k,iCell) - 1.0_RKIND/density(k-1,iCell))
end do
end do
+ !$omp end do
+
deallocate(pTop)
else
+ !$omp do schedule(runtime) private(k)
do iCell = 1, nCells
! Pressure for generalized coordinates.
! Pressure at top surface may be due to atmospheric pressure
- ! or an ice-shelf depression.
- pressure(1,iCell) = seaSurfacePressure(iCell) + density(1,iCell)*gravity &
- * 0.5*layerThickness(1,iCell)
+ ! or an ice-shelf depression.
+ pressure(1,iCell) = 0.0_RKIND
+ if ( associated(frazilSurfacePressure) ) pressure(1,iCell) = pressure(1,iCell) + frazilSurfacePressure(iCell)
+ pressure(1,iCell) = pressure(1,iCell) + seaSurfacePressure(iCell)
+ pressure(1,iCell) = pressure(1,iCell) + density(1,iCell)*gravity*0.5_RKIND*layerThickness(1,iCell)
do k = 2, maxLevelCell(iCell)
pressure(k,iCell) = pressure(k-1,iCell) &
- + 0.5*gravity*( density(k-1,iCell)*layerThickness(k-1,iCell) &
+ + 0.5_RKIND*gravity*( density(k-1,iCell)*layerThickness(k-1,iCell) &
+ density(k ,iCell)*layerThickness(k ,iCell))
end do
@@ -537,12 +631,12 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
! Note the negative sign, since bottomDepth is positive
! and z-coordinates are negative below the surface.
k = maxLevelCell(iCell)
- zMid(k:nVertLevels,iCell) = -bottomDepth(iCell) + 0.5*layerThickness(k,iCell)
+ zMid(k:nVertLevels,iCell) = -bottomDepth(iCell) + 0.5_RKIND*layerThickness(k,iCell)
zTop(k:nVertLevels,iCell) = -bottomDepth(iCell) + layerThickness(k,iCell)
do k = maxLevelCell(iCell)-1, 1, -1
zMid(k,iCell) = zMid(k+1,iCell) &
- + 0.5*( layerThickness(k+1,iCell) &
+ + 0.5_RKIND*( layerThickness(k+1,iCell) &
+ layerThickness(k ,iCell))
zTop(k,iCell) = zTop(k+1,iCell) &
+ layerThickness(k ,iCell)
@@ -552,61 +646,85 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
ssh(iCell) = zTop(1,iCell)
end do
+ !$omp end do
endif
!
! Brunt-Vaisala frequency (this has units of s^{-2})
!
- coef = -gravity / config_density0
+ coef = -gravity / rho_sw
+ !$omp do schedule(runtime) private(k)
do iCell = 1, nCells
- BruntVaisalaFreqTop(1,iCell) = 0.0
+ BruntVaisalaFreqTop(1,iCell) = 0.0_RKIND
do k = 2, maxLevelCell(iCell)
- BruntVaisalaFreqTop(k,iCell) = coef * (displacedDensity(k-1,iCell) - density(k,iCell)) &
+ BruntVaisalaFreqTop(k,iCell) = coef * (displacedDensity(k-1,iCell) - density(k,iCell)) &
/ (zMid(k-1,iCell) - zMid(k,iCell))
end do
end do
+ !$omp end do
!
! Gradient Richardson number
!
- RiTopOfCell = 100.0
+ RiTopOfCell = 100.0_RKIND
+ !$omp do schedule(runtime) private(invAreaCell1, k, shearSquared, i, iEdge, factor, delU2, shearMean)
do iCell=1,nCells
- invAreaCell1 = 1.0 / areaCell(iCell)
+ invAreaCell1 = 1.0_RKIND / areaCell(iCell)
do k=2,maxLevelCell(iCell)
- shearSquared = 0.0
+ shearSquared = 0.0_RKIND
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
- factor = 0.5 * dcEdge(iEdge) * dvEdge(iEdge) * invAreaCell1
+ factor = 0.5_RKIND * dcEdge(iEdge) * dvEdge(iEdge) * invAreaCell1
delU2 = (normalVelocity(k-1,iEdge) - normalVelocity(k,iEdge))**2
shearSquared = shearSquared + factor * delU2
- enddo
+ enddo
shearMean = sqrt(shearSquared)
shearMean = shearMean / (zMid(k-1,iCell) - zMid(k,iCell))
- RiTopOfCell(k,iCell) = BruntVaisalaFreqTop(k,iCell) / (shearMean**2 + 1.0e-10)
+ RiTopOfCell(k,iCell) = BruntVaisalaFreqTop(k,iCell) / (shearMean**2 + 1.0e-10_RKIND)
end do
RiTopOfCell(1,iCell) = RiTopOfCell(2,iCell)
end do
+ !$omp end do
!
! extrapolate tracer values to ocean surface
! this eventually be a modelled process
! at present, just copy k=1 tracer values onto surface values
! field will be updated below is better approximations are available
- tracersSurfaceValue(:,:) = tracers(:,1,:)
- normalVelocitySurfaceLayer(:) = normalVelocity(1,:)
+
+!TDR need to consider how to handle tracersSurfaceValues
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ tracersSurfaceValue(:, iCell) = activeTracers(:,1, iCell)
+ end do
+ !$omp end do
+
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ normalVelocitySurfaceLayer(iEdge) = normalVelocity(1, iEdge)
+ end do
+ !$omp end do
!
! average tracer values over the ocean surface layer
! the ocean surface layer is generally assumed to be about 0.1 of the boundary layer depth
if(config_use_cvmix_kpp) then
- tracersSurfaceLayerValue(:,:) = 0.0
- indexSurfaceLayerDepth(:) = -9.e30
+
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ tracersSurfaceLayerValue(:, iCell) = 0.0_RKIND
+ indexSurfaceLayerDepth( iCell) = -9.e30
+ end do
+ !$omp end do
+
+ !$omp do schedule(runtime) private(surfaceLayerDepth, sumSurfaceLayer, k, rSurfaceLayer)
do iCell=1,nCells
surfaceLayerDepth = config_cvmix_kpp_surface_layer_averaging
- sumSurfaceLayer=0.0
+ sumSurfaceLayer=0.0_RKIND
do k=1,maxLevelCell(iCell)
sumSurfaceLayer = sumSurfaceLayer + layerThickness(k,iCell)
+ rSurfaceLayer = maxLevelCell(iCell)
if(sumSurfaceLayer.gt.surfaceLayerDepth) then
sumSurfaceLayer = sumSurfaceLayer - layerThickness(k,iCell)
rSurfaceLayer = int(k-1) + (surfaceLayerDepth-sumSurfaceLayer)/layerThickness(k,iCell)
@@ -615,23 +733,33 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
endif
end do
do k=1,int(rSurfaceLayer)
- tracersSurfaceLayerValue(:,iCell) = tracersSurfaceLayerValue(:,iCell) + tracers(:,k,iCell)*layerThickness(k,iCell)
+ tracersSurfaceLayerValue(:,iCell) = tracersSurfaceLayerValue(:,iCell) + activeTracers(:,k,iCell) &
+ * layerThickness(k,iCell)
enddo
- k=int(rSurfaceLayer)+1
- tracersSurfaceLayerValue(:,iCell) = tracersSurfaceLayerValue(:,iCell) + fraction(rSurfaceLayer)*tracers(:,k,iCell)*layerThickness(k,iCell)
+ k=min( int(rSurfaceLayer)+1, maxLevelCell(iCell) )
+ tracersSurfaceLayerValue(:,iCell) = tracersSurfaceLayerValue(:,iCell) + fraction(rSurfaceLayer) &
+ * activeTracers(:,k,iCell) * layerThickness(k,iCell)
tracersSurfaceLayerValue(:,iCell) = tracersSurfaceLayerValue(:,iCell) / surfaceLayerDepth
enddo
+ !$omp end do
!
! average normal velocity values over the ocean surface layer
! the ocean surface layer is generally assumed to be about 0.1 of the boundary layer depth
!
- normalVelocitySurfaceLayer(:) = 0.0_RKIND
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ normalVelocitySurfaceLayer(iEdge) = 0.0_RKIND
+ end do
+ !$omp end do
+
+ !$omp do schedule(runtime) private(cell1, cell2, surfaceLayerDepth, sumSurfaceLayer, k, rSurfaceLayer)
do iEdge=1,nEdges
cell1=cellsOnEdge(1,iEdge)
cell2=cellsOnEdge(2,iEdge)
surfaceLayerDepth = config_cvmix_kpp_surface_layer_averaging
- sumSurfaceLayer=0.0
+ sumSurfaceLayer=0.0_RKIND
+ rSurfaceLayer = min(1, maxLevelEdgeTop(iEdge))
do k=1,maxLevelEdgeTop(iEdge)
rSurfaceLayer = k
sumSurfaceLayer = sumSurfaceLayer + layerThicknessEdge(k,iEdge)
@@ -642,26 +770,56 @@ subroutine ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnostic
endif
end do
do k=1,int(rSurfaceLayer)
- normalVelocitySurfaceLayer(iEdge) = normalVelocitySurfaceLayer(iEdge) + normalVelocity(k,iEdge)*layerThicknessEdge(k,iEdge)
+ normalVelocitySurfaceLayer(iEdge) = normalVelocitySurfaceLayer(iEdge) + normalVelocity(k,iEdge) &
+ * layerThicknessEdge(k,iEdge)
enddo
k=int(rSurfaceLayer)+1
if(k.le.maxLevelEdgeTop(iEdge)) then
- normalVelocitySurfaceLayer(iEdge) = normalVelocitySurfaceLayer(iEdge) + fraction(rSurfaceLayer)*normalVelocity(k,iEdge)*layerThicknessEdge(k,iEdge)
+ normalVelocitySurfaceLayer(iEdge) = normalVelocitySurfaceLayer(iEdge) + fraction(rSurfaceLayer) &
+ * normalVelocity(k,iEdge) * layerThicknessEdge(k,iEdge)
normalVelocitySurfaceLayer(iEdge) = normalVelocitySurfaceLayer(iEdge) / surfaceLayerDepth
end if
enddo
+ !$omp end do
!
! compute fields used as intent(in) to CVMix/KPP
- call computeKPPInputFields(statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, timeLevel)
+ call ocn_compute_KPP_input_fields(statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, timeLevel)
endif
- do iEdge = 1, nEdgesSolve
+ ! compute the attenuation coefficient for surface fluxes
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ surfaceFluxAttenuationCoefficient(iCell) = config_flux_attenuation_coefficient
+ surfaceFluxAttenuationCoefficientRunoff(iCell) = config_flux_attenuation_coefficient_runoff
+ end do
+ !$omp end do
+
+ !
+ ! compute fields needed to compute land-ice fluxes, either in the ocean model or in the coupler
+ call mpas_timer_start("land_ice_diagnostic_fields", .false.)
+ call ocn_compute_land_ice_flux_input_fields(meshPool, statePool, forcingPool, scratchPool, &
+ diagnosticsPool, timeLevel)
+ call mpas_timer_stop("land_ice_diagnostic_fields")
+
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ pressureAdjustedSSH(iCell) = ssh(iCell) + ( seaSurfacePressure(iCell) / ( gravity * rho_sw ) )
+ end do
+ !$omp end do
+
+ !$omp do schedule(runtime) private(cell1, cell2)
+ do iEdge = 1, nEdges
cell1 = cellsOnEdge(1, iEdge)
cell2 = cellsOnEdge(2, iEdge)
- gradSSH(1, iEdge) = (ssh(cell2) - ssh(cell1)) / dcEdge(iEdge)
+ gradSSH(iEdge) = edgeMask(1, iEdge) * ( pressureAdjustedSSH(cell2) - pressureAdjustedSSH(cell1) ) / dcEdge(iEdge)
end do
+ !$omp end do
+
+ call mpas_threading_barrier()
+
+
end subroutine ocn_diagnostic_solve!}}}
@@ -672,12 +830,12 @@ end subroutine ocn_diagnostic_solve!}}}
!> \brief Computes vertical transport
!> \author Mark Petersen
!> \date August 2013
-!> \details
-!> This routine computes the vertical transport through the top of each
-!> cell.
+!> \details
+!> This routine computes the vertical transport through the top of each
+!> cell.
!
!-----------------------------------------------------------------------
- subroutine ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, oldLayerThickness, layerThicknessEdge, &
+ subroutine ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, scratchPool, oldLayerThickness, layerThicknessEdge, &
normalVelocity, oldSSH, dt, vertAleTransportTop, err, newHighFreqThickness)!{{{
!-----------------------------------------------------------------
@@ -692,6 +850,8 @@ subroutine ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, oldLayerT
type (mpas_pool_type), intent(in) :: &
verticalMeshPool !< Input: vertical mesh information
+ type (mpas_pool_type), intent(in) :: scratchPool !< Input: scratch variables
+
real (kind=RKIND), dimension(:,:), intent(in) :: &
oldLayerThickness !< Input: layer thickness at old time
@@ -733,13 +893,15 @@ subroutine ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, oldLayerT
maxLevelCell, maxLevelEdgeBot
integer, dimension(:,:), pointer :: edgesOnCell, edgeSignOnCell
- real (kind=RKIND) :: flux, invAreaCell
+ real (kind=RKIND) :: flux, invAreaCell, div_hu_btr
real (kind=RKIND), dimension(:), pointer :: dvEdge, areaCell
- real (kind=RKIND), dimension(:), allocatable :: &
- div_hu_btr !> barotropic divergence of (thickness*velocity)
- real (kind=RKIND), dimension(:,:), allocatable :: &
+ real (kind=RKIND), dimension(:), pointer :: &
+ projectedSSH !> projected SSH at new time
+ type (field1DReal), pointer :: projectedSSHField
+ real (kind=RKIND), dimension(:,:), pointer :: &
ALE_Thickness, & !> ALE thickness at new time
div_hu !> divergence of (thickness*velocity)
+ type (field2DReal), pointer :: ALE_ThicknessField, div_huField
character (len=StrKIND), pointer :: config_vert_coord_movement
@@ -759,41 +921,58 @@ subroutine ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, oldLayerT
call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
if (config_vert_coord_movement.eq.'impermeable_interfaces') then
- vertAleTransportTop=0.0
+ vertAleTransportTop=0.0_RKIND
return
end if
- allocate(div_hu(nVertLevels,nCells), div_hu_btr(nCells), ALE_Thickness(nVertLevels,nCells))
+
+ call mpas_pool_get_field(scratchPool, 'div_hu', div_huField)
+ call mpas_pool_get_field(scratchPool, 'projectedSSH', projectedSSHField)
+ call mpas_pool_get_field(scratchPool, 'ALE_Thickness', ALE_ThicknessField)
+ call mpas_allocate_scratch_field(div_huField, .true.)
+ call mpas_allocate_scratch_field(projectedSSHField, .true.)
+ call mpas_allocate_scratch_field(ALE_ThicknessField, .true.)
+
+ call mpas_threading_barrier()
+
+ div_hu => div_huField % array
+ projectedSSH => projectedSSHField % array
+ ALE_Thickness => ALE_ThicknessField % array
!
! thickness-weighted divergence and barotropic divergence
!
! See Ringler et al. (2010) jcp paper, eqn 19, 21, and fig. 3.
+ !$omp do schedule(runtime) private(invAreaCell, i, iEdge, k, flux, div_hu_btr)
do iCell = 1, nCells
- div_hu(:,iCell) = 0.0
- div_hu_btr(iCell) = 0.0
- invAreaCell = 1.0 / areaCell(iCell)
+ div_hu(:,iCell) = 0.0_RKIND
+ div_hu_btr = 0.0_RKIND
+ invAreaCell = 1.0_RKIND / areaCell(iCell)
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
do k = 1, maxLevelEdgeBot(iEdge)
- flux = layerThicknessEdge(k, iEdge) * normalVelocity(k, iEdge) * dvEdge(iEdge) * edgeSignOnCell(i, iCell) * invAreaCell
+ flux = layerThicknessEdge(k, iEdge) * normalVelocity(k, iEdge) * dvEdge(iEdge) * edgeSignOnCell(i, iCell) &
+ * invAreaCell
div_hu(k,iCell) = div_hu(k,iCell) - flux
- div_hu_btr(iCell) = div_hu_btr(iCell) - flux
+ div_hu_btr = div_hu_btr - flux
end do
end do
-
- enddo
+ projectedSSH(iCell) = oldSSH(iCell) - dt*div_hu_btr
+ end do
+ !$omp end do
!
! Compute desired thickness at new time
!
if (present(newHighFreqThickness)) then
- call ocn_ALE_thickness(meshPool, verticalMeshPool, oldSSH, div_hu_btr, dt, ALE_thickness, err, newHighFreqThickness)
+ call ocn_ALE_thickness(meshPool, verticalMeshPool, projectedSSH, ALE_thickness, err, newHighFreqThickness)
else
- call ocn_ALE_thickness(meshPool, verticalMeshPool, oldSSH, div_hu_btr, dt, ALE_thickness, err)
+ call ocn_ALE_thickness(meshPool, verticalMeshPool, projectedSSH, ALE_thickness, err)
endif
+ call mpas_threading_barrier()
+
!
! Vertical transport through layer interfaces
!
@@ -801,16 +980,21 @@ subroutine ocn_vert_transport_velocity_top(meshPool, verticalMeshPool, oldLayerT
! Here we are using solving the continuity equation for vertAleTransportTop ($w^t$),
! and using ALE_Thickness for thickness at the new time.
+ !$omp do schedule(runtime) private(k)
do iCell = 1,nCells
- vertAleTransportTop(1,iCell) = 0.0
- vertAleTransportTop(maxLevelCell(iCell)+1,iCell) = 0.0
+ vertAleTransportTop(1,iCell) = 0.0_RKIND
+ vertAleTransportTop(maxLevelCell(iCell)+1,iCell) = 0.0_RKIND
do k = maxLevelCell(iCell),2,-1
vertAleTransportTop(k,iCell) = vertAleTransportTop(k+1,iCell) - div_hu(k,iCell) &
- (ALE_Thickness(k,iCell) - oldLayerThickness(k,iCell))/dt
end do
end do
+ !$omp end do
- deallocate(div_hu, div_hu_btr, ALE_Thickness)
+ call mpas_threading_barrier()
+ call mpas_deallocate_scratch_field(div_huField, .true.)
+ call mpas_deallocate_scratch_field(projectedSSHField, .true.)
+ call mpas_deallocate_scratch_field(ALE_ThicknessField, .true.)
end subroutine ocn_vert_transport_velocity_top!}}}
@@ -821,7 +1005,7 @@ end subroutine ocn_vert_transport_velocity_top!}}}
!> \brief Computes f u_perp
!> \author Mark Petersen
!> \date 23 September 2011
-!> \details
+!> \details
!> This routine computes f u_perp for the ocean
!
!-----------------------------------------------------------------------
@@ -850,6 +1034,7 @@ subroutine ocn_fuperp(statePool, meshPool, timeLevelIn)!{{{
end if
call mpas_timer_start("ocn_fuperp")
+ call mpas_threading_barrier()
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, timeLevel)
call mpas_pool_get_array(statePool, 'normalBaroclinicVelocity', normalBaroclinicVelocity, timeLevel)
@@ -865,23 +1050,29 @@ subroutine ocn_fuperp(statePool, meshPool, timeLevelIn)!{{{
call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
+ !DWJ: ADD OMP (Only needed for split explicit)
+
!
! Put f*normalBaroclinicVelocity^{perp} in u as a work variable
!
+ !$omp do schedule(runtime) private(cell1, cell2, k, eoe)
do iEdge = 1, nEdgesSolve
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
do k = 1, maxLevelEdgeTop(iEdge)
- normalVelocity(k,iEdge) = 0.0
+ normalVelocity(k,iEdge) = 0.0_RKIND
do j = 1,nEdgesOnEdge(iEdge)
eoe = edgesOnEdge(j,iEdge)
- normalVelocity(k,iEdge) = normalVelocity(k,iEdge) + weightsOnEdge(j,iEdge) * normalBaroclinicVelocity(k,eoe) * fEdge(eoe)
+ normalVelocity(k,iEdge) = normalVelocity(k,iEdge) + weightsOnEdge(j,iEdge) * normalBaroclinicVelocity(k,eoe) &
+ * fEdge(eoe)
end do
end do
end do
+ !$omp end do
+ call mpas_threading_barrier()
call mpas_timer_stop("ocn_fuperp")
end subroutine ocn_fuperp!}}}
@@ -893,7 +1084,7 @@ end subroutine ocn_fuperp!}}}
!> \brief filters barotropic mode out of the velocity variable.
!> \author Mark Petersen
!> \date 23 September 2011
-!> \details
+!> \details
!> This routine filters barotropic mode out of the velocity variable.
!
!-----------------------------------------------------------------------
@@ -914,7 +1105,6 @@ subroutine ocn_filter_btr_mode_vel(statePool, diagnosticsPool, meshPool, timeLev
call mpas_timer_start("ocn_filter_btr_mode_vel")
-
if (present(timeLevelIn)) then
timeLevel = timeLevelIn
else
@@ -929,10 +1119,11 @@ subroutine ocn_filter_btr_mode_vel(statePool, diagnosticsPool, meshPool, timeLev
call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+ !$omp do schedule(runtime) private(normalThicknessFluxSum, thicknessSum, k, vertSum)
do iEdge = 1, nEdges
- ! thicknessSum is initialized outside the loop because on land boundaries
- ! maxLevelEdgeTop=0, but I want to initialize thicknessSum with a
+ ! thicknessSum is initialized outside the loop because on land boundaries
+ ! maxLevelEdgeTop=0, but I want to initialize thicknessSum with a
! nonzero value to avoid a NaN.
normalThicknessFluxSum = layerThicknessEdge(1,iEdge) * normalVelocity(1,iEdge)
thicknessSum = layerThicknessEdge(1,iEdge)
@@ -947,6 +1138,9 @@ subroutine ocn_filter_btr_mode_vel(statePool, diagnosticsPool, meshPool, timeLev
normalVelocity(k,iEdge) = normalVelocity(k,iEdge) - vertSum
enddo
enddo ! iEdge
+ !$omp end do
+
+ call mpas_threading_barrier()
call mpas_timer_stop("ocn_filter_btr_mode_vel")
@@ -959,7 +1153,7 @@ end subroutine ocn_filter_btr_mode_vel!}}}
!> \brief ocn_filters barotropic mode out of the velocity tendency
!> \author Mark Petersen
!> \date 23 September 2011
-!> \details
+!> \details
!> This routine filters barotropic mode out of the velocity tendency.
!
!-----------------------------------------------------------------------
@@ -996,10 +1190,11 @@ subroutine ocn_filter_btr_mode_tend_vel(tendPool, statePool, diagnosticsPool, me
call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+ !$omp do schedule(runtime) private(normalThicknessFluxSum, thicknessSum, vertSum, k)
do iEdge = 1, nEdges
- ! thicknessSum is initialized outside the loop because on land boundaries
- ! maxLevelEdgeTop=0, but I want to initialize thicknessSum with a
+ ! thicknessSum is initialized outside the loop because on land boundaries
+ ! maxLevelEdgeTop=0, but I want to initialize thicknessSum with a
! nonzero value to avoid a NaN.
normalThicknessFluxSum = layerThicknessEdge(1,iEdge) * tend_normalVelocity(1,iEdge)
thicknessSum = layerThicknessEdge(1,iEdge)
@@ -1014,6 +1209,7 @@ subroutine ocn_filter_btr_mode_tend_vel(tendPool, statePool, diagnosticsPool, me
tend_normalVelocity(k,iEdge) = tend_normalVelocity(k,iEdge) - vertSum
enddo
enddo ! iEdge
+ !$omp end do
call mpas_timer_stop("ocn_filter_btr_mode_tend_vel")
@@ -1026,7 +1222,7 @@ end subroutine ocn_filter_btr_mode_tend_vel!}}}
!> \brief Initializes flags used within diagnostics routines.
!> \author Mark Petersen
!> \date 4 November 2011
-!> \details
+!> \details
!> This routine initializes flags related to quantities computed within
!> other diagnostics routines.
!
@@ -1055,7 +1251,7 @@ subroutine ocn_diagnostics_init(err)!{{{
fCoef = 1
elseif (trim(config_time_integrator) == 'split_explicit' &
.or.trim(config_time_integrator) == 'unsplit_explicit') then
- ! For split explicit, PV is eta/h because the Coriolis term
+ ! For split explicit, PV is eta/h because the Coriolis term
! is added separately to the momentum tendencies.
fCoef = 0
end if
@@ -1064,9 +1260,9 @@ end subroutine ocn_diagnostics_init!}}}
!***********************************************************************
!
-! routine computeKPPInputFields
+! routine ocn_compute_KPP_input_fields
!
-!> \brief
+!> \brief
!> Compute fields necessary to drive the CVMix KPP module
!> \author Todd Ringler
!> \date 20 August 2013
@@ -1080,7 +1276,7 @@ end subroutine ocn_diagnostics_init!}}}
!
!-----------------------------------------------------------------------
- subroutine computeKPPInputFields(statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, timeLevelIn)!{{{
+ subroutine ocn_compute_KPP_input_fields(statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, timeLevelIn)!{{{
type (mpas_pool_type), intent(in) :: statePool !< Input/Output: State information
type (mpas_pool_type), intent(in) :: forcingPool !< Input: Forcing information
@@ -1089,6 +1285,10 @@ subroutine computeKPPInputFields(statePool, forcingPool, meshPool, diagnosticsPo
type (mpas_pool_type), intent(in) :: scratchPool !< Input: scratch variables
integer, intent(in), optional :: timeLevelIn
+ ! pool pointers
+ type (mpas_pool_type), pointer :: tracersSurfaceFluxPool
+ type (mpas_pool_type), pointer :: tracersPool
+
! scalars
integer, pointer :: nCells, nVertLevels
@@ -1100,27 +1300,31 @@ subroutine computeKPPInputFields(statePool, forcingPool, meshPool, diagnosticsPo
real (kind=RKIND), dimension(:), pointer :: dcEdge, dvEdge, areaCell
real (kind=RKIND), dimension(:), pointer :: penetrativeTemperatureFlux, surfaceThicknessFlux, &
surfaceBuoyancyForcing, surfaceFrictionVelocity, penetrativeTemperatureFluxOBL, &
- normalVelocitySurfaceLayer
- real (kind=RKIND), dimension(:), pointer :: surfaceWindStress, surfaceWindStressMagnitude
+ normalVelocitySurfaceLayer, surfaceThicknessFluxRunoff
+ real (kind=RKIND), pointer :: config_flux_attenuation_coefficient, config_flux_attenuation_coefficient_runoff
+
+ real (kind=RKIND), dimension(:), pointer :: surfaceStress, surfaceStressMagnitude
real (kind=RKIND), dimension(:,:), pointer :: &
- layerThickness, zMid, zTop, tracersSurfaceValues, densitySurfaceDisplaced, density, &
- normalVelocity, surfaceTracerFlux, thermalExpansionCoeff, salineContractionCoeff
+ layerThickness, zMid, zTop, densitySurfaceDisplaced, density, &
+ normalVelocity, activeTracersSurfaceFlux, thermalExpansionCoeff, salineContractionCoeff, &
+ activeTracersSurfaceFluxRunoff, nonLocalSurfaceTracerFlux
real (kind=RKIND), dimension(:), pointer :: &
indexSurfaceLayerDepth
- real (kind=RKIND), dimension(:,:), pointer :: &
+ real (kind=RKIND), dimension(:,:,:), pointer :: &
+ activeTracers
+
+ real (kind=RKIND), dimension(:,:), pointer :: &
bulkRichardsonNumberBuoy, bulkRichardsonNumberShear
! local
integer :: iCell, iEdge, i, k, err, timeLevel
integer, pointer :: indexTempFlux, indexSaltFlux
- real (kind=RKIND) :: numerator, denominator, turbulentVelocitySquared
- real (kind=RKIND) :: buoyContribution, shearContribution, factor, deltaVelocitySquared, delU2, invAreaCell
- real (kind=RKIND), dimension(:), allocatable :: buoySmoothed, shearSmoothed
+ real (kind=RKIND) :: numerator, denominator, turbulentVelocitySquared, fracAbsorbed, fracAbsorbedRunoff
+ real (kind=RKIND) :: factor, deltaVelocitySquared, delU2, invAreaCell
type (field2DReal), pointer :: densitySurfaceDisplacedField, thermalExpansionCoeffField, salineContractionCoeffField
- real (kind=RKIND), pointer :: config_density0
if (present(timeLevelIn)) then
timeLevel = timeLevelIn
@@ -1128,16 +1332,19 @@ subroutine computeKPPInputFields(statePool, forcingPool, meshPool, diagnosticsPo
timeLevel = 1
end if
- call mpas_pool_get_config(ocnConfigs, 'config_density0', config_density0)
-
+ call mpas_pool_get_subpool(forcingPool, 'tracersSurfaceFlux', tracersSurfaceFluxPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_config(ocnConfigs, 'config_flux_attenuation_coefficient', config_flux_attenuation_coefficient)
+ call mpas_pool_get_config(ocnConfigs, 'config_flux_attenuation_coefficient_runoff', &
+ config_flux_attenuation_coefficient_runoff)
! set the parameter turbulentVelocitySquared
turbulentVelocitySquared = 0.001_RKIND
! set scalar values
call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
- call mpas_pool_get_dimension(forcingPool, 'index_surfaceTemperatureFlux', indexTempFlux)
- call mpas_pool_get_dimension(forcingPool, 'index_surfaceSalinityFlux', indexSaltFlux)
+ call mpas_pool_get_dimension(tracersSurfaceFluxPool, 'index_temperatureSurfaceFlux', indexTempFlux)
+ call mpas_pool_get_dimension(tracersSurfaceFluxPool, 'index_salinitySurfaceFlux', indexSaltFlux)
! set pointers into state, mesh, diagnostics and scratch
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, timeLevel)
@@ -1153,7 +1360,6 @@ subroutine computeKPPInputFields(statePool, forcingPool, meshPool, diagnosticsPo
call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
call mpas_pool_get_array(diagnosticsPool, 'zTop', zTop)
call mpas_pool_get_array(diagnosticsPool, 'density', density)
- call mpas_pool_get_array(diagnosticsPool, 'tracersSurfaceValue ', tracersSurfaceValues)
call mpas_pool_get_array(diagnosticsPool, 'surfaceFrictionVelocity', surfaceFrictionVelocity)
call mpas_pool_get_array(diagnosticsPool, 'penetrativeTemperatureFluxOBL', penetrativeTemperatureFluxOBL)
call mpas_pool_get_array(diagnosticsPool, 'bulkRichardsonNumberBuoy', bulkRichardsonNumberBuoy)
@@ -1161,13 +1367,17 @@ subroutine computeKPPInputFields(statePool, forcingPool, meshPool, diagnosticsPo
call mpas_pool_get_array(diagnosticsPool, 'indexSurfaceLayerDepth', indexSurfaceLayerDepth)
call mpas_pool_get_array(diagnosticsPool, 'surfaceBuoyancyForcing', surfaceBuoyancyForcing)
call mpas_pool_get_array(diagnosticsPool, 'normalVelocitySurfaceLayer', normalVelocitySurfaceLayer)
+ call mpas_pool_get_array(tracersSurfaceFluxPool, 'nonLocalSurfaceTracerFlux', nonLocalSurfaceTracerFlux)
call mpas_pool_get_array(forcingPool, 'surfaceThicknessFlux', surfaceThicknessFlux)
- call mpas_pool_get_array(forcingPool, 'surfaceTracerFlux', surfaceTracerFlux)
+ call mpas_pool_get_array(forcingPool, 'surfaceThicknessFluxRunoff', surfaceThicknessFluxRunoff)
call mpas_pool_get_array(forcingPool, 'penetrativeTemperatureFlux', penetrativeTemperatureFlux)
- call mpas_pool_get_array(forcingPool, 'surfaceWindStress', surfaceWindStress)
- call mpas_pool_get_array(forcingPool, 'surfaceWindStressMagnitude', surfaceWindStressMagnitude)
+ call mpas_pool_get_array(forcingPool, 'surfaceStress', surfaceStress)
+ call mpas_pool_get_array(forcingPool, 'surfaceStressMagnitude', surfaceStressMagnitude)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+ call mpas_pool_get_array(tracersSurfaceFluxPool, 'activeTracersSurfaceFlux', activeTracersSurfaceFlux)
+ call mpas_pool_get_array(tracersSurfaceFluxPool, 'activeTracersSurfaceFluxRunoff', activeTracersSurfaceFluxRunoff)
! allocate scratch space displaced density computation
call mpas_pool_get_field(scratchPool, 'densitySurfaceDisplaced', densitySurfaceDisplacedField)
call mpas_pool_get_field(scratchPool, 'thermalExpansionCoeff', thermalExpansionCoeffField)
@@ -1175,101 +1385,362 @@ subroutine computeKPPInputFields(statePool, forcingPool, meshPool, diagnosticsPo
call mpas_allocate_scratch_field(densitySurfaceDisplacedField, .true.)
call mpas_allocate_scratch_field(thermalExpansionCoeffField, .true.)
call mpas_allocate_scratch_field(salineContractionCoeffField, .true.)
+ call mpas_threading_barrier()
+
densitySurfaceDisplaced => densitySurfaceDisplacedField % array
thermalExpansionCoeff => thermalExpansionCoeffField % array
salineContractionCoeff => salineContractionCoeffField % array
- ! allocate local work space
- allocate(buoySmoothed(nVertLevels))
- allocate(shearSmoothed(nVertLevels))
-
! compute EOS by displacing SST/SSS to every vertical layer in column
- call ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, 0, 'surfaceDisplaced', densitySurfaceDisplaced, err, &
- thermalExpansionCoeff, salineContractionCoeff, timeLevel)
+ call ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, scratchPool, 0, 'surfaceDisplaced', &
+ densitySurfaceDisplaced, err, thermalExpansionCoeff, salineContractionCoeff, &
+ timeLevel)
+ !$omp do schedule(runtime) private(invAreaCell, deltaVelocitySquared, i, iEdge, factor, delU2, fracAbsorbed, &
+ !$omp fracAbsorbedRunoff)
do iCell = 1, nCells
- invAreaCell = 1.0 / areaCell(iCell)
+ invAreaCell = 1.0_RKIND / areaCell(iCell)
- ! compute surface buoyancy forcing based on surface fluxes of mass, temperature, salinity and frazil (frazil to be added later)
+ ! compute surface buoyancy forcing based on surface fluxes of mass, temperature, salinity and frazil
+ ! (frazil to be added later)
! since this computation is confusing, variables, units and sign convention is repeated here
! everything below should be consistent with that specified in Registry
- ! everything below should be consistent with the CVMix/KPP documentation: https://www.dropbox.com/s/6hqgc0rsoa828nf/cvmix_20aug2013.pdf
+ ! everything below should be consistent with the CVMix/KPP documentation:
+ ! https://www.dropbox.com/s/6hqgc0rsoa828nf/cvmix_20aug2013.pdf
!
! surfaceThicknessFlux: surface mass flux, m/s, positive into ocean
- ! surfaceTracerFlux(indexTempFlux): non-penetrative temperature flux, C m/s, positive into ocean
+ ! activeTracersSurfaceFlux(indexTempFlux): non-penetrative temperature flux, C m/s, positive into ocean
! penetrativeTemperatureFlux: penetrative surface temperature flux at ocean surface, positive into ocean
- ! surfaceTracerFlux(indexSaltFlux): salinity flux, PSU m/s, positive into ocean
+ ! activeTracersSurfaceFlux(indexSaltFlux): salinity flux, PSU m/s, positive into ocean
! penetrativeTemperatureFluxOBL: penetrative temperature flux computed at z=OBL, positive down
!
! note: the following fields used the CVMix/KPP computation of buoyancy forcing are not included here
! 1. Tm: temperature associated with surfaceThicknessFlux, C (here we assume Tm == temperatureSurfaceValue)
- ! 2. Sm: salinity associated with surfaceThicknessFlux, PSU (here we assume Sm == salinitySurfaceValue and account for salinity flux in surfaceTracerFlux array)
+ ! 2. Sm: salinity associated with surfaceThicknessFlux, PSU (here we assume Sm == salinitySurfaceValue and account for
+ ! salinity flux in activeTracersSurfaceFlux array)
!
- surfaceBuoyancyForcing(iCell) = thermalExpansionCoeff (1,iCell) * &
- (surfaceTracerFlux(indexTempFlux,iCell) + penetrativeTemperatureFlux(iCell) - penetrativeTemperatureFluxOBL(iCell)) &
- - salineContractionCoeff(1,iCell) * surfaceTracerFlux(indexSaltFlux,iCell)
-
- ! at this point, surfaceBuoyancyForcing has units of m/s
+
+ ! Compute fraction of thickness flux that is in the top model layer
+ fracAbsorbed = 1.0_RKIND - exp( max(-layerThickness(1, iCell) / config_flux_attenuation_coefficient, -100.0_RKIND) )
+ fracAbsorbedRunoff = 1.0_RKIND - exp( max(-layerThickness(1, iCell) / config_flux_attenuation_coefficient_runoff, &
+ -100.0_RKIND) )
+ ! Store the total tracer flux below in nonLocalSurfaceTemperatureFlux for use in the CVMix nonlocal
+ ! transport code. This includes tracer forcing due to thickness
+
+ nonLocalSurfaceTracerFlux(indexTempFlux, iCell) = activeTracersSurfaceFlux(indexTempFlux,iCell) &
+ + penetrativeTemperatureFlux(iCell) - penetrativeTemperatureFluxOBL(iCell) - fracAbsorbed * &
+ surfaceThicknessFlux(iCell) * activeTracers(indexTempFlux,1,iCell) + &
+ activeTracersSurfaceFluxRunoff(indexTempFlux,iCell) * fracAbsorbedRunoff
+
+ nonLocalSurfaceTracerFlux(indexSaltFlux,iCell) = activeTracersSurfaceFlux(indexSaltFlux,iCell) &
+ - fracAbsorbed * surfaceThicknessFlux(iCell) * activeTracers(indexSaltFlux,1,iCell)
+
+ surfaceBuoyancyForcing(iCell) = thermalExpansionCoeff (1,iCell) &
+ * nonLocalSurfaceTracerFlux(indexTempFlux,iCell) &
+ - salineContractionCoeff(1,iCell) * nonLocalSurfaceTracerFlux(indexSaltFlux,iCell)
+
+ ! at this point, surfaceBuoyancyForcing has units of m/s
! change into units of m^2/s^3 (which can be thought of as the flux of buoyancy, units of buoyancy * velocity )
surfaceBuoyancyForcing(iCell) = surfaceBuoyancyForcing(iCell) * gravity
- ! compute magnitude of surface windstress
- deltaVelocitySquared = 0.0
+ ! compute magnitude of surface stress
+ deltaVelocitySquared = 0.0_RKIND
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
- factor = 0.5 * dcEdge(iEdge) * dvEdge(iEdge) * invAreaCell
- delU2 = (surfaceWindStress(iEdge))**2
+ factor = 0.5_RKIND * dcEdge(iEdge) * dvEdge(iEdge) * invAreaCell
+ delU2 = (surfaceStress(iEdge))**2
deltaVelocitySquared = deltaVelocitySquared + factor * delU2
enddo
- surfacewindStressMagnitude(iCell) = sqrt(deltaVelocitySquared)
+ surfaceStressMagnitude(iCell) = sqrt(deltaVelocitySquared)
! compute surface friction velocity
- surfaceFrictionVelocity(iCell) = sqrt(surfacewindStressMagnitude(iCell) / config_density0)
+ surfaceFrictionVelocity(iCell) = sqrt(surfaceStressMagnitude(iCell) / rho_sw)
- ! zero the bulk Richardson number within the ocean surface layer
- ! this prevent CVMix/KPP from mis-diagnosing the OBL to be within the surface layer
- bulkRichardsonNumberBuoy (:,iCell) = 1.0e8_RKIND
- bulkRichardsonNumberShear(:,iCell) = 1.0_RKIND
- ! loop over vertical to compute bulk Richardson number
- do k=1,maxLevelCell(iCell)
+ enddo
+ !$omp end do
- ! find deltaVelocitySquared defined at cell centers based on velocity at levels 1 and k
- deltaVelocitySquared = 0.0_RKIND
- do i = 1, nEdgesOnCell(iCell)
- iEdge = edgesOnCell(i, iCell)
- factor = 0.5 * dcEdge(iEdge) * dvEdge(iEdge) * invAreaCell
- delU2 = (normalVelocitySurfaceLayer(iEdge) - normalVelocity(k,iEdge))**2
- deltaVelocitySquared = deltaVelocitySquared + factor * delU2
- enddo
+ call mpas_threading_barrier()
+
+ ! deallocate scratch space
+ call mpas_deallocate_scratch_field(thermalExpansionCoeffField, .true.)
+ call mpas_deallocate_scratch_field(salineContractionCoeffField, .true.)
- buoyContribution = gravity * (density(k,iCell) - densitySurfaceDisplaced(k,iCell)) / config_density0
- shearContribution = max(deltaVelocitySquared,1.0e-15_RKIND)
+ end subroutine ocn_compute_KPP_input_fields!}}}
- ! store the buoyancy and resolved shear contributions to bulk Richardson number
- bulkRichardsonNumberBuoy(k,iCell) = buoyContribution
- bulkRichardsonNumberShear(k,iCell) = shearContribution
- enddo ! do k=1,maxLevelCell(iCell)
+!***********************************************************************
+!
+! routine ocn_compute_land_ice_flux_input_fields
+!
+!> \brief Builds the forcing array for land-ice forcing
+!> \author Xylar Asay-Davis
+!> \date 09/14/2015
+!> \details
+!> This routine builds surface flux arrays related to land-ice forcing.
+!
+!-----------------------------------------------------------------------
- ! set bulkRichardsonNumberBuoy to a negative value within surface layer to prevent CVMix/KPP from
- ! incorrectly diagnosing OBL to be within surface layer
- ! require boundary layer to be below the top layer
- k=max(int(indexSurfaceLayerDepth(iCell)),1)
- bulkRichardsonNumberBuoy(1:k,iCell) = 0.0_RKIND
+ subroutine ocn_compute_land_ice_flux_input_fields(meshPool, statePool, &
+ forcingPool, scratchPool, diagnosticsPool, timeLevel)!{{{
- enddo
+ type (mpas_pool_type), intent(in) :: meshPool !< Input: Mesh information
+ type (mpas_pool_type), intent(in) :: statePool !< Input: State information
+ type (mpas_pool_type), intent(in) :: forcingPool !< Input: Forcing information
+ type (mpas_pool_type), intent(in) :: scratchPool !< Input/Output: scratch variables
+ type (mpas_pool_type), intent(inout) :: diagnosticsPool !< Input/Output: Diagnostics information
- ! deallocate scratch space
- call mpas_deallocate_scratch_field(densitySurfaceDisplacedField, .true.)
- call mpas_deallocate_scratch_field(thermalExpansionCoeffField, .true.)
- call mpas_deallocate_scratch_field(salineContractionCoeffField, .true.)
+ integer, intent(in) :: timeLevel
- ! deallocate local work space
- deallocate(buoySmoothed)
- deallocate(shearSmoothed)
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mpas_pool_type), pointer :: tracersPool
+
+ integer :: iCell, iEdge, cell1, cell2, iLevel, i
+ integer, pointer :: nCells, nEdges
- end subroutine computeKPPInputFields!}}}
+ integer, dimension(:,:), pointer :: cellsOnCell, cellsOnEdge, cellMask
+
+ integer, dimension(:), pointer :: maxLevelCell, nEdgesOnCell
+
+ integer, pointer :: indexT, indexS, indexBLT, indexBLS, indexHeatTrans, indexSaltTrans
+
+ character (len=StrKIND), pointer :: config_land_ice_flux_formulation, config_land_ice_flux_mode
+
+ real (kind=RKIND), pointer :: config_land_ice_flux_boundaryLayerThickness, &
+ config_land_ice_flux_boundaryLayerNeighborWeight, &
+ config_land_ice_flux_topDragCoeff, &
+ config_land_ice_flux_rms_tidal_velocity, &
+ config_land_ice_flux_jenkins_heat_transfer_coefficient, &
+ config_land_ice_flux_jenkins_salt_transfer_coefficient, &
+ config_land_ice_flux_attenuation_coefficient
+
+ real (kind=RKIND) :: blThickness, dz, weightSum, h_nu, Gamma_turb, landIceEdgeFraction, velocityMagnitude
+
+ real (kind=RKIND), dimension(:), pointer :: landIceFraction, &
+ landIceFrictionVelocity, &
+ topDrag, &
+ topDragMagnitude, &
+ fCell, &
+ blTempScratch, blSaltScratch, &
+ surfaceFluxAttenuationCoefficient
+
+ real (kind=RKIND), dimension(:,:), pointer :: kineticEnergyCell, layerThickness, normalVelocity, &
+ landIceBoundaryLayerTracers, landIceTracerTransferVelocities
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
+ type (field1DReal), pointer :: boundaryLayerTemperatureField, boundaryLayerSalinityField
+
+ logical :: jenkinsOn, hollandJenkinsOn
+
+ ! constants for Holland and Jenkins 1999 parameterization of the boundary layer
+ real (kind=RKIND), parameter :: &
+ Pr = 13.8_RKIND, & ! the Prandtl number
+ Sc = 2432.0_RKIND, & ! the Schmidt number
+ nuSaltWater = 1.95e-6_RKIND, & ! molecular viscosity of sea water (m^2/s)
+ kVonKarman = 0.4_RKIND, & ! the von Karman constant
+ xiN = 0.052_RKIND ! dimensionless planetary boundary layer constant
+
+
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_mode', config_land_ice_flux_mode)
+ if ( trim(config_land_ice_flux_mode) == 'off') then
+ return
+ end if
+
+
+ jenkinsOn = .false.
+ hollandJenkinsOn = .false.
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_formulation', config_land_ice_flux_formulation)
+ if ( trim(config_land_ice_flux_formulation) == 'Jenkins' ) then
+ jenkinsOn = .true.
+ else if ( trim(config_land_ice_flux_formulation) == 'HollandJenkins' ) then
+ hollandJenkinsOn = .true.
+ end if
+
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_topDragCoeff', config_land_ice_flux_topDragCoeff)
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_boundaryLayerThickness', &
+ config_land_ice_flux_boundaryLayerThickness)
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_boundaryLayerNeighborWeight', &
+ config_land_ice_flux_boundaryLayerNeighborWeight)
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_rms_tidal_velocity', config_land_ice_flux_rms_tidal_velocity)
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_attenuation_coefficient', &
+ config_land_ice_flux_attenuation_coefficient)
+
+ if(jenkinsOn) then
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_jenkins_heat_transfer_coefficient', &
+ config_land_ice_flux_jenkins_heat_transfer_coefficient)
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_jenkins_salt_transfer_coefficient', &
+ config_land_ice_flux_jenkins_salt_transfer_coefficient)
+ end if
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+
+ call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell)
+ call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell)
+ call mpas_pool_get_array(meshPool, 'cellMask', cellMask)
+
+ call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, timeLevel)
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, timeLevel)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, timeLevel)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', indexT)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', indexS)
+
+ call mpas_pool_get_array(forcingPool, 'landIceFraction', landIceFraction)
+
+ call mpas_pool_get_array(diagnosticsPool, 'kineticEnergyCell', kineticEnergyCell)
+
+ call mpas_pool_get_array(diagnosticsPool, 'landIceFrictionVelocity', landIceFrictionVelocity)
+ call mpas_pool_get_array(diagnosticsPool, 'topDrag', topDrag)
+ call mpas_pool_get_array(diagnosticsPool, 'topDragMagnitude', topDragMagnitude)
+
+ call mpas_pool_get_array(diagnosticsPool, 'landIceBoundaryLayerTracers', landIceBoundaryLayerTracers)
+ call mpas_pool_get_dimension(diagnosticsPool, 'index_landIceBoundaryLayerTemperature', indexBLT)
+ call mpas_pool_get_dimension(diagnosticsPool, 'index_landIceBoundaryLayerSalinity', indexBLS)
+
+ if(jenkinsOn .or. hollandJenkinsOn) then
+ call mpas_pool_get_array(diagnosticsPool, 'landIceTracerTransferVelocities', landIceTracerTransferVelocities)
+ call mpas_pool_get_dimension(diagnosticsPool, 'index_landIceHeatTransferVelocity', indexHeatTrans)
+ call mpas_pool_get_dimension(diagnosticsPool, 'index_landIceSaltTransferVelocity', indexSaltTrans)
+ end if
+ call mpas_pool_get_array(diagnosticsPool, 'surfaceFluxAttenuationCoefficient', surfaceFluxAttenuationCoefficient)
+
+ call mpas_pool_get_field(scratchPool, 'boundaryLayerTemperatureScratch', boundaryLayerTemperatureField)
+ call mpas_pool_get_field(scratchPool, 'boundaryLayerSalinityScratch', boundaryLayerSalinityField)
+ call mpas_allocate_scratch_field(boundaryLayerTemperatureField, .true.)
+ call mpas_allocate_scratch_field(boundaryLayerSalinityField, .true.)
+ call mpas_threading_barrier()
+ blTempScratch => boundaryLayerTemperatureField % array
+ blSaltScratch => boundaryLayerSalinityField % array
+
+ if(hollandJenkinsOn) then
+ call mpas_pool_get_array(meshPool, 'fCell', fCell)
+ end if
+
+ ! Compute top drag
+ !$omp do schedule(runtime) private(cell1, cell2, velocityMagnitude, landIceEdgeFraction)
+ do iEdge = 1, nEdges
+ cell1 = cellsOnEdge(1, iEdge)
+ cell2 = cellsOnEdge(2, iEdge)
+
+ ! top drag tau = - CD*|u|*u, where |u| = sqrt(2*KE) = sqrt(KE1 + KE2) from the neighboring cells
+ velocityMagnitude = sqrt(kineticEnergyCell(1,cell1) + kineticEnergyCell(1,cell2))
+ landIceEdgeFraction = 0.5_RKIND*(landIceFraction(cell1)+landIceFraction(cell2))
+
+ topDrag(iEdge) = - rho_sw * landIceEdgeFraction * config_land_ice_flux_topDragCoeff &
+ * velocityMagnitude * normalVelocity(1,iEdge)
+
+ end do
+ !$omp end do
+
+ ! compute top drag magnitude and friction velocity at cell centers
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ ! the magnitude of the top drag is CD*u**2 = CD*(2*KE)
+ topDragMagnitude(iCell) = rho_sw * landIceFraction(iCell) &
+ * 2.0_RKIND * config_land_ice_flux_topDragCoeff * kineticEnergyCell(1,iCell)
+
+ ! the friction velocity is the square root of the top drag + variance of tidal velocity
+ ! (computed regardless of land-ice coverage)
+ landIceFrictionVelocity(iCell) = sqrt(config_land_ice_flux_topDragCoeff * (2.0_RKIND * kineticEnergyCell(1,iCell) &
+ + config_land_ice_flux_rms_tidal_velocity))
+ end do
+ !$omp end do
+
+
+
+ ! average temperature and salinity over horizontal neighbors and the sub-ice-shelf boundary layer
+ !$omp do schedule(runtime) private(blThickness, iLevel, dz)
+ do iCell = 1, nCells
+ blThickness = 0.0_RKIND
+ blTempScratch(iCell) = 0.0_RKIND
+ blSaltScratch(iCell) = 0.0_RKIND
+ do iLevel = 1, maxLevelCell(iCell)
+ dz = min(layerThickness(iLevel,iCell),config_land_ice_flux_boundaryLayerThickness-blThickness)
+ if(dz <= 0.0_RKIND) exit
+ blTempScratch(iCell) = blTempScratch(iCell) + activeTracers(indexT, iLevel, iCell)*dz
+ blSaltScratch(iCell) = blSaltScratch(iCell) + activeTracers(indexS, iLevel, iCell)*dz
+ blThickness = blThickness + dz
+ end do
+ if(blThickness > 0.0_RKIND) then
+ blTempScratch(iCell) = blTempScratch(iCell)/blThickness
+ blSaltScratch(iCell) = blSaltScratch(iCell)/blThickness
+ end if
+ end do
+ !$omp end do
+
+ !$omp do schedule(runtime) private(weightSum, i, cell2)
+ do iCell = 1, nCells
+ landIceBoundaryLayerTracers(indexBLT, iCell) = blTempScratch(iCell)
+ landIceBoundaryLayerTracers(indexBLS, iCell) = blSaltScratch(iCell)
+ if(config_land_ice_flux_boundaryLayerNeighborWeight > 0.0_RKIND) then
+ weightSum = 1.0_RKIND
+ do i = 1, nEdgesOnCell(iCell)
+ cell2 = cellsOnCell(i,iCell)
+
+ landIceBoundaryLayerTracers(indexBLT, iCell) = landIceBoundaryLayerTracers(indexBLT, iCell) &
+ + cellMask(1,cell2)*config_land_ice_flux_boundaryLayerNeighborWeight*blTempScratch(cell2)
+ landIceBoundaryLayerTracers(indexBLS, iCell) = landIceBoundaryLayerTracers(indexBLS, iCell) &
+ + cellMask(1,cell2)*config_land_ice_flux_boundaryLayerNeighborWeight*blSaltScratch(cell2)
+ weightSum = weightSum + cellMask(1,cell2)*config_land_ice_flux_boundaryLayerNeighborWeight
+ end do
+ landIceBoundaryLayerTracers(:, iCell) = landIceBoundaryLayerTracers(:, iCell)/weightSum
+ end if
+ end do
+ !$omp end do
+
+ if(jenkinsOn) then
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ ! transfer coefficients from namelist
+ landIceTracerTransferVelocities(indexHeatTrans, iCell) = landIceFrictionVelocity(iCell) &
+ * config_land_ice_flux_jenkins_heat_transfer_coefficient
+ landIceTracerTransferVelocities(indexSaltTrans, iCell) = landIceFrictionVelocity(iCell) &
+ * config_land_ice_flux_jenkins_salt_transfer_coefficient
+ end do
+ !$omp end do
+ else if(hollandJenkinsOn) then
+ !$omp do schedule(runtime) private(h_nu, Gamma_turb)
+ do iCell = 1, nCells
+ ! friction-velocity dependent non-dimensional transfer coefficients from
+ ! Holland and Jenkins 1999, (14)-(16) with eta_* = 1
+ h_nu = 5.0_RKIND*nuSaltWater/landIceFrictionVelocity(iCell) ! uStar should never be zero because of tidal term
+
+ Gamma_turb = 1.0_RKIND/(2.0_RKIND*xiN) - 1.0_RKIND/kVonKarman
+ if(abs(fCell(iCell)) > 0.0_RKIND) then
+ Gamma_turb = Gamma_turb + 1.0_RKIND/kVonKarman*log(landIceFrictionVelocity(iCell) &
+ *xiN/(abs(fCell(iCell))*h_nu))
+ end if
+
+ landIceTracerTransferVelocities(indexHeatTrans, iCell) = 1.0_RKIND/(Gamma_turb + 12.5_RKIND &
+ * Pr**(2.0_RKIND/3.0_RKIND) - 6.0_RKIND)
+ landIceTracerTransferVelocities(indexSaltTrans, iCell) = 1.0_RKIND/(Gamma_turb + 12.5_RKIND &
+ * Sc**(2.0_RKIND/3.0_RKIND) - 6.0_RKIND)
+ end do
+ !$omp end do
+ end if
+
+ call mpas_threading_barrier()
+ call mpas_deallocate_scratch_field(boundaryLayerTemperatureField, .true.)
+ call mpas_deallocate_scratch_field(boundaryLayerSalinityField, .true.)
+
+ ! recompute the spatially-varying attenuation coefficient based on landIceFraction
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ surfaceFluxAttenuationCoefficient(iCell) = landIceFraction(iCell)*config_land_ice_flux_attenuation_coefficient &
+ + (1.0_RKIND - landIceFraction(iCell))*surfaceFluxAttenuationCoefficient(iCell)
+ end do
+ !$omp end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_compute_land_ice_flux_input_fields!}}}
!***********************************************************************
!
@@ -1278,20 +1749,21 @@ end subroutine computeKPPInputFields!}}}
!> \brief Computes cell-centered vector diagnostics
!> \author Mark Petersen
!> \date May 2014
-!> \details
+!> \details
!> This routine computes cell-centered vector diagnostics
!
!-----------------------------------------------------------------------
- subroutine ocn_reconstruct_gm_vectors(diagnosticsPool, meshPool)
+ subroutine ocn_reconstruct_gm_vectors(diagnosticsPool, meshPool) !{{{
type (mpas_pool_type), intent(in) :: meshPool !< Input: mesh information
type (mpas_pool_type), intent(in) :: diagnosticsPool !< Input: Diagnostic information
real (kind=RKIND), dimension(:,:), pointer :: &
- normalTransportVelocity, transportVelocityX, transportVelocityY, transportVelocityZ, transportVelocityZonal, transportVelocityMeridional, &
- normalGMBolusVelocity, GMBolusVelocityX, GMBolusVelocityY, GMBolusVelocityZ, GMBolusVelocityZonal, GMBolusVelocityMeridional, &
- relativeSlopeTopOfEdge, relativeSlopeTopOfCellX, relativeSlopeTopOfCellY, relativeSlopeTopOfCellZ, relativeSlopeTopOfCellZonal, relativeSlopeTopOfCellMeridional, &
+ normalTransportVelocity, transportVelocityX, transportVelocityY, transportVelocityZ, transportVelocityZonal, &
+ transportVelocityMeridional, normalGMBolusVelocity, GMBolusVelocityX, GMBolusVelocityY, GMBolusVelocityZ, &
+ GMBolusVelocityZonal, GMBolusVelocityMeridional, relativeSlopeTopOfEdge, relativeSlopeTopOfCellX, &
+ relativeSlopeTopOfCellY, relativeSlopeTopOfCellZ, relativeSlopeTopOfCellZonal, relativeSlopeTopOfCellMeridional, &
gmStreamFuncTopOfEdge, GMStreamFuncX, GMStreamFuncY, GMStreamFuncZ, GMStreamFuncZonal, GMStreamFuncMeridional
call mpas_pool_get_array(diagnosticsPool, 'normalTransportVelocity', normalTransportVelocity)
@@ -1322,6 +1794,8 @@ subroutine ocn_reconstruct_gm_vectors(diagnosticsPool, meshPool)
call mpas_pool_get_array(diagnosticsPool, 'GMStreamFuncZonal', GMStreamFuncZonal)
call mpas_pool_get_array(diagnosticsPool, 'GMStreamFuncMeridional', GMStreamFuncMeridional)
+ !$omp sections
+ !$omp section
call mpas_reconstruct(meshPool, normalTransportVelocity, &
transportVelocityX, &
transportVelocityY, &
@@ -1330,6 +1804,7 @@ subroutine ocn_reconstruct_gm_vectors(diagnosticsPool, meshPool)
transportVelocityMeridional &
)
+ !$omp section
call mpas_reconstruct(meshPool, normalGMBolusVelocity, &
GMBolusVelocityX, &
GMBolusVelocityY, &
@@ -1338,6 +1813,7 @@ subroutine ocn_reconstruct_gm_vectors(diagnosticsPool, meshPool)
GMBolusVelocityMeridional &
)
+ !$omp section
call mpas_reconstruct(meshPool, relativeSlopeTopOfEdge, &
relativeSlopeTopOfCellX, &
relativeSlopeTopOfCellY, &
@@ -1346,6 +1822,7 @@ subroutine ocn_reconstruct_gm_vectors(diagnosticsPool, meshPool)
relativeSlopeTopOfCellMeridional &
)
+ !$omp section
call mpas_reconstruct(meshPool, gmStreamFuncTopOfEdge, &
GMStreamFuncX, &
GMStreamFuncY, &
@@ -1353,6 +1830,7 @@ subroutine ocn_reconstruct_gm_vectors(diagnosticsPool, meshPool)
GMStreamFuncZonal, &
GMStreamFuncMeridional &
)
+ !$omp end sections
end subroutine ocn_reconstruct_gm_vectors!}}}
diff --git a/src/core_ocean/shared/mpas_ocn_diagnostics_routines.F b/src/core_ocean/shared/mpas_ocn_diagnostics_routines.F
index 02bc956bcf..bbf502c935 100644
--- a/src/core_ocean/shared/mpas_ocn_diagnostics_routines.F
+++ b/src/core_ocean/shared/mpas_ocn_diagnostics_routines.F
@@ -59,7 +59,7 @@ module ocn_diagnostics_routines
!> \brief Computes relative vorticity and circulation
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date November 2013
-!> \details
+!> \details
!> Computes relative vorticity and circulation
!
!-----------------------------------------------------------------------
@@ -85,10 +85,10 @@ subroutine ocn_relativeVorticity_circulation(relativeVorticity, circulation, mes
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(out) :: &
- relativeVorticity
+ relativeVorticity
real (kind=RKIND), dimension(:,:), intent(out) :: &
- circulation
+ circulation
integer, intent(out) :: err !< Output: error flag
@@ -120,21 +120,22 @@ subroutine ocn_relativeVorticity_circulation(relativeVorticity, circulation, mes
err = 0
- circulation(:,:) = 0.0
- relativeVorticity(:,:) = 0.0
+ !$omp do schedule(runtime) private(invAreaTri1, i, iEdge, k, r_tmp)
do iVertex = 1, nVertices
- invAreaTri1 = 1.0 / areaTriangle(iVertex)
+ circulation(:, iVertex) = 0.0_RKIND
+ relativeVorticity(:, iVertex) = 0.0_RKIND
+ invAreaTri1 = 1.0_RKIND / areaTriangle(iVertex)
do i = 1, vertexDegree
iEdge = edgesOnVertex(i, iVertex)
do k = 1, maxLevelVertexBot(iVertex)
r_tmp = dcEdge(iEdge) * normalVelocity(k, iEdge)
- circulation(k, iVertex) = circulation(k, iVertex) + edgeSignOnVertex(i, iVertex) * r_tmp
+ circulation(k, iVertex) = circulation(k, iVertex) + edgeSignOnVertex(i, iVertex) * r_tmp
relativeVorticity(k, iVertex) = relativeVorticity(k, iVertex) + edgeSignOnVertex(i, iVertex) * r_tmp * invAreaTri1
end do
end do
end do
-
+ !$omp end do
!--------------------------------------------------------------------
diff --git a/src/core_ocean/shared/mpas_ocn_effective_density_in_land_ice.F b/src/core_ocean/shared/mpas_ocn_effective_density_in_land_ice.F
new file mode 100644
index 0000000000..e04bac3dc1
--- /dev/null
+++ b/src/core_ocean/shared/mpas_ocn_effective_density_in_land_ice.F
@@ -0,0 +1,186 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_effective_density_in_land_ice
+!
+!> \brief MPAS ocean effective density in land ice
+!> \author Xylar Asay-Davis
+!> \date 10/03/2015
+!> \details
+!> This module contains routines for computing the effective seawater
+!> density in land ice using Arhimedes' principle.
+!
+!-----------------------------------------------------------------------
+
+module ocn_effective_density_in_land_ice
+
+ use mpas_constants
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+
+ use ocn_constants
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_effective_density_in_land_ice_update
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_effective_density_in_land_ice_update
+!
+!> \brief updates effective density in land ice
+!> \author Xylar Asay-Davis
+!> \date 10/03/2015
+!> \details
+!> This routine updates the value of the effective seawater density
+!> displaced by land ice, based on Archimedes' principle. The effective
+!> density is smoothed and extrapolated by averaging with nearest neighbors
+!> (cellsOnCell).
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_effective_density_in_land_ice_update(meshPool, forcingPool, statePool, scratchPool, ierr)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(in) :: meshPool !< Input: mesh information
+ type (mpas_pool_type), intent(in) :: forcingPool !< Input: Forcing information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(inout) :: statePool !< Input/Output: state information
+ type (mpas_pool_type), intent(inout) :: scratchPool !< Input/Output: scratch information
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: ierr !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ character (len=StrKIND), pointer :: config_land_ice_flux_mode
+
+ real (kind=RKIND), dimension(:), pointer :: landIceFraction, &
+ seaSurfacePressure, ssh, &
+ effectiveDensityCur, &
+ effectiveDensityNew, &
+ effectiveDensityScratch
+
+ type (field1DReal), pointer :: effectiveDensityField
+
+ real (kind=RKIND) :: weightSum
+
+ integer :: iCell, cell2, i
+ integer, pointer :: nCells, nEdges
+
+ integer, dimension(:,:), pointer :: cellsOnCell, cellMask
+
+ integer, dimension(:), pointer :: nEdgesOnCell
+
+ ierr = 0
+
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_mode', config_land_ice_flux_mode)
+ if ( (trim(config_land_ice_flux_mode) .ne. 'coupled') ) then
+ return
+ end if
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell)
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell)
+ call mpas_pool_get_array(meshPool, 'cellMask', cellMask)
+
+ call mpas_pool_get_array(forcingPool, 'landIceFraction', landIceFraction)
+ call mpas_pool_get_array(forcingPool, 'seaSurfacePressure', seaSurfacePressure)
+ call mpas_pool_get_array(statePool, 'ssh', ssh, 2)
+ call mpas_pool_get_array(statePool, 'effectiveDensityInLandIce', effectiveDensityCur, 1)
+ call mpas_pool_get_array(statePool, 'effectiveDensityInLandIce', effectiveDensityNew, 2)
+
+ call mpas_pool_get_field(scratchPool, 'effectiveDensityScratch', effectiveDensityField)
+ call mpas_allocate_scratch_field(effectiveDensityField, .true.)
+ effectiveDensityScratch => effectiveDensityField % array
+
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ ! TODO: should only apply to floating land ice, once wetting/drying is supported
+ if(landIceFraction(iCell) >= 0.5_RKIND) then
+ ! there is sufficient land ice to update the effective density
+ effectiveDensityScratch(iCell) = -seaSurfacePressure(iCell)/(ssh(iCell)*gravity)
+ else
+ ! we copy the previous effective density
+ effectiveDensityScratch(iCell) = effectiveDensityCur(iCell)
+ end if
+ end do
+ !$omp end do
+
+ !$omp do schedule(runtime) private(weightSum, i, cell2)
+ do iCell = 1, nCells
+ ! smooth/extrapolate by averaging with nearest neighbors
+ weightSum = 1.0_RKIND
+ effectiveDensityNew(iCell) = effectiveDensityScratch(iCell)
+ do i = 1, nEdgesOnCell(iCell)
+ cell2 = cellsOnCell(i,iCell)
+ effectiveDensityNew(iCell) = effectiveDensityNew(iCell) &
+ + cellMask(1,cell2)*effectiveDensityScratch(cell2)
+ weightSum = weightSum + cellMask(1,cell2)
+ end do
+ effectiveDensityNew(iCell) = effectiveDensityNew(iCell)/weightSum
+ end do
+ !$omp end do
+ call mpas_deallocate_scratch_field(effectiveDensityField, .true.)
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_effective_density_in_land_ice_update !}}}
+
+!***********************************************************************
+
+end module ocn_effective_density_in_land_ice
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_equation_of_state.F b/src/core_ocean/shared/mpas_ocn_equation_of_state.F
index f8df5baa78..3dfccaf8d0 100644
--- a/src/core_ocean/shared/mpas_ocn_equation_of_state.F
+++ b/src/core_ocean/shared/mpas_ocn_equation_of_state.F
@@ -67,26 +67,27 @@ module ocn_equation_of_state
!> \brief Calls equation of state
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> This routine calls the equation of state to update the density
!
!-----------------------------------------------------------------------
- subroutine ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, k_displaced, displacement_type, density, err, &
- thermalExpansionCoeff, salineContractionCoeff, timeLevelIn)!{{{
+ subroutine ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, scratchPool, k_displaced, & !{{{
+ displacement_type, density, err, thermalExpansionCoeff, &
+ salineContractionCoeff, timeLevelIn)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This module contains routines necessary for computing the density
! from model temperature and salinity using an equation of state.
!
! Input: mesh - mesh metadata
- ! s - state: tracers
- ! k_displaced
+ ! s - state: activeTracers
+ ! k_displaced
!
- ! If k_displaced==0, density is returned with no displacement
+ ! If k_displaced==0, density is returned with no displacement
!
! If k_displaced~=0, density is returned, and is for
- ! a parcel adiabatically displaced from its original level to level
- ! k_displaced. When using the linear EOS, state % displacedDensity is
+ ! a parcel adiabatically displaced from its original level to level
+ ! k_displaced. When using the linear EOS, state % displacedDensity is
! still filled, but depth (i.e. pressure) does not modify the output.
!
! Output: s - state: computed density
@@ -96,7 +97,9 @@ subroutine ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, k
type (mpas_pool_type), intent(in) :: statePool
type (mpas_pool_type), intent(inout) :: diagnosticsPool
type (mpas_pool_type), intent(in) :: meshPool
+ type (mpas_pool_type), intent(in) :: scratchPool !< Input/Output: Scratch structure
integer, intent(in), optional :: timeLevelIn
+ type (mpas_pool_type), pointer :: tracersPool
integer :: k_displaced
character(len=*), intent(in) :: displacement_type
real (kind=RKIND), dimension(:,:), intent(out) :: density
@@ -107,7 +110,7 @@ subroutine ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, k
integer, dimension(:), pointer :: maxLevelCell
real (kind=RKIND), dimension(:,:), pointer :: tracersSurfaceValue
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
integer :: iCell, k
integer, pointer :: indexT, indexS
type (dm_info) :: dminfo
@@ -122,19 +125,22 @@ subroutine ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, k
end if
call mpas_pool_get_array(diagnosticsPool, 'tracersSurfaceValue', tracersSurfaceValue)
- call mpas_pool_get_array(statePool, 'tracers', tracers, timeLevel)
- call mpas_pool_get_dimension(statePool, 'index_temperature', indexT)
- call mpas_pool_get_dimension(statePool, 'index_salinity', indexS)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, timeLevel)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', indexT)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', indexS)
if (linearEos) then
- call ocn_equation_of_state_linear_density(meshPool, k_displaced, displacement_type, indexT, indexS, tracers, density, err, &
- tracersSurfaceValue, thermalExpansionCoeff, salineContractionCoeff)
+ call ocn_equation_of_state_linear_density(meshPool, k_displaced, displacement_type, indexT, indexS, &
+ activeTracers, density, err, tracersSurfaceValue, &
+ thermalExpansionCoeff, salineContractionCoeff)
elseif (jmEos) then
- call ocn_equation_of_state_jm_density(meshPool, k_displaced, displacement_type, indexT, indexS, tracers, density, err, &
- tracersSurfaceValue, thermalExpansionCoeff, salineContractionCoeff)
+ call ocn_equation_of_state_jm_density(meshPool, scratchPool, k_displaced, displacement_type, indexT, indexS, &
+ activeTracers, density, err, tracersSurfaceValue, thermalExpansionCoeff, &
+ salineContractionCoeff)
endif
@@ -147,11 +153,11 @@ end subroutine ocn_equation_of_state_density!}}}
!> \brief Initializes ocean momentum horizontal mixing quantities
!> \author Mark Petersen
!> \date September 2011
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity mixing in the ocean. Since a variety of
+!> \details
+!> This routine initializes a variety of quantities related to
+!> horizontal velocity mixing in the ocean. Since a variety of
!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
+!> individual init routines for each parameterization.
!
!----------------------------------------------------------------------
diff --git a/src/core_ocean/shared/mpas_ocn_equation_of_state_jm.F b/src/core_ocean/shared/mpas_ocn_equation_of_state_jm.F
index e769be8dc0..fa134749d5 100644
--- a/src/core_ocean/shared/mpas_ocn_equation_of_state_jm.F
+++ b/src/core_ocean/shared/mpas_ocn_equation_of_state_jm.F
@@ -63,24 +63,24 @@ module ocn_equation_of_state_jm
!> \brief Calls JM equation of state
!> \author Mark Petersen and Todd Ringler
!> \date September 2011, updated August 2013
-!> \details
-!> This routine uses a JM equation of state to update the density.
+!> \details
+!> This routine uses a JM equation of state to update the density.
!>
-!> Density can be computed in-situ using k_displaced=0 and
+!> Density can be computed in-situ using k_displaced=0 and
!> displacement_type = 'relative'.
!>
-!> Potential density (referenced to top layer) can be computed
+!> Potential density (referenced to top layer) can be computed
!> using k_displaced=1 and displacement_type = 'absolute'.
!>
-!> The density of SST/SSS after adiabatic displacement to each layer
+!> The density of SST/SSS after adiabatic displacement to each layer
!> can be computed using displacement_type = 'surfaceDisplaced'.
!>
-!> When using displacement_type = 'surfaceDisplaced', k_displaced is
+!> When using displacement_type = 'surfaceDisplaced', k_displaced is
!> ignored and tracersSurfaceLayerValue must be present.
!
!-----------------------------------------------------------------------
- subroutine ocn_equation_of_state_jm_density(meshPool, k_displaced, displacement_type, &
+ subroutine ocn_equation_of_state_jm_density(meshPool, scratchPool, k_displaced, displacement_type, &
indexT, indexS, tracers, density, err, &
tracersSurfaceLayerValue, thermalExpansionCoeff, salineContractionCoeff)!{{{
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -93,11 +93,11 @@ subroutine ocn_equation_of_state_jm_density(meshPool, k_displaced, displacement_
!
! Input: mesh - mesh metadata
! s - state: tracers
- ! k_displaced
+ ! k_displaced
! If k_displaced=0, density is returned with no displacement
! If k_displaced>0,the density returned is that for a parcel
- ! adiabatically displaced from its original level to level
+ ! adiabatically displaced from its original level to level
! k_displaced.
!
@@ -107,6 +107,7 @@ subroutine ocn_equation_of_state_jm_density(meshPool, k_displaced, displacement_
implicit none
type (mpas_pool_type), intent(in) :: meshPool
+ type (mpas_pool_type), intent(in) :: scratchPool !< Input/Output: Scratch structure
integer, intent(in) :: k_displaced, indexT, indexS
character(len=*), intent(in) :: displacement_type
real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers
@@ -117,13 +118,12 @@ subroutine ocn_equation_of_state_jm_density(meshPool, k_displaced, displacement_
thermalExpansionCoeff, &! Thermal expansion coefficient (alpha), defined as $-1/\rho d\rho/dT$ (note negative sign)
salineContractionCoeff ! Saline contraction coefficient (beta), defined as $1/\rho d\rho/dS$
- type (dm_info) :: dminfo
integer :: iEdge, iCell, iVertex, k, k_displaced_local
integer, pointer :: nCells, nEdges, nVertices, nVertLevels
integer, dimension(:), pointer :: maxLevelCell
character(len=60) :: displacement_type_local
- real (kind=RKIND) :: &
+ real (kind=RKIND) :: &
depth, &
DRDT0, &! d(density)/d(temperature), for surface
DRDS0, &! d(density)/d(salinity ), for surface
@@ -137,14 +137,14 @@ subroutine ocn_equation_of_state_jm_density(meshPool, k_displaced, displacement_
refBottomDepth, pRefEOS
real (kind=RKIND), dimension(:), allocatable :: &
p, p2 ! temporary pressure scalars
- real (kind=RKIND), dimension(:,:), allocatable :: &
+ real (kind=RKIND), dimension(:), pointer :: &
TQ,SQ, &! adjusted T,S
BULK_MOD, &! Bulk modulus
SQR,DENOMK, &! work arrays
RHO_S, &! density at the surface
WORK1, WORK2, WORK3, WORK4, T2
- real (kind=RKIND), dimension(:,:,:), allocatable :: &
- tracerTS
+ real (kind=RKIND), dimension(:), allocatable :: &
+ tracerTemp, tracerSalt
!-----------------------------------------------------------------------
!
@@ -155,126 +155,108 @@ subroutine ocn_equation_of_state_jm_density(meshPool, k_displaced, displacement_
!*** for density of fresh water (standard UNESCO)
real (kind=RKIND), parameter :: &
- unt0 = 999.842594, &
- unt1 = 6.793952e-2, &
- unt2 = -9.095290e-3, &
- unt3 = 1.001685e-4, &
- unt4 = -1.120083e-6, &
- unt5 = 6.536332e-9
-
+ unt0 = 999.842594_RKIND, &
+ unt1 = 6.793952e-2_RKIND, &
+ unt2 = -9.095290e-3_RKIND, &
+ unt3 = 1.001685e-4_RKIND, &
+ unt4 = -1.120083e-6_RKIND, &
+ unt5 = 6.536332e-9_RKIND
+
!*** for dependence of surface density on salinity (UNESCO)
real (kind=RKIND), parameter :: &
- uns1t0 = 0.824493 , &
- uns1t1 = -4.0899e-3, &
- uns1t2 = 7.6438e-5, &
- uns1t3 = -8.2467e-7, &
- uns1t4 = 5.3875e-9, &
- unsqt0 = -5.72466e-3, &
- unsqt1 = 1.0227e-4, &
- unsqt2 = -1.6546e-6, &
- uns2t0 = 4.8314e-4
-
+ uns1t0 = 0.824493_RKIND , &
+ uns1t1 = -4.0899e-3_RKIND, &
+ uns1t2 = 7.6438e-5_RKIND, &
+ uns1t3 = -8.2467e-7_RKIND, &
+ uns1t4 = 5.3875e-9_RKIND, &
+ unsqt0 = -5.72466e-3_RKIND, &
+ unsqt1 = 1.0227e-4_RKIND, &
+ unsqt2 = -1.6546e-6_RKIND, &
+ uns2t0 = 4.8314e-4_RKIND
+
!*** from Table A1 of Jackett and McDougall
-
+
real (kind=RKIND), parameter :: &
- bup0s0t0 = 1.965933e+4, &
- bup0s0t1 = 1.444304e+2, &
- bup0s0t2 = -1.706103 , &
- bup0s0t3 = 9.648704e-3, &
- bup0s0t4 = -4.190253e-5
-
+ bup0s0t0 = 1.965933e+4_RKIND, &
+ bup0s0t1 = 1.444304e+2_RKIND, &
+ bup0s0t2 = -1.706103_RKIND , &
+ bup0s0t3 = 9.648704e-3_RKIND, &
+ bup0s0t4 = -4.190253e-5_RKIND
+
real (kind=RKIND), parameter :: &
- bup0s1t0 = 5.284855e+1, &
- bup0s1t1 = -3.101089e-1, &
- bup0s1t2 = 6.283263e-3, &
- bup0s1t3 = -5.084188e-5
-
+ bup0s1t0 = 5.284855e+1_RKIND, &
+ bup0s1t1 = -3.101089e-1_RKIND, &
+ bup0s1t2 = 6.283263e-3_RKIND, &
+ bup0s1t3 = -5.084188e-5_RKIND
+
real (kind=RKIND), parameter :: &
- bup0sqt0 = 3.886640e-1, &
- bup0sqt1 = 9.085835e-3, &
- bup0sqt2 = -4.619924e-4
-
+ bup0sqt0 = 3.886640e-1_RKIND, &
+ bup0sqt1 = 9.085835e-3_RKIND, &
+ bup0sqt2 = -4.619924e-4_RKIND
+
real (kind=RKIND), parameter :: &
- bup1s0t0 = 3.186519 , &
- bup1s0t1 = 2.212276e-2, &
- bup1s0t2 = -2.984642e-4, &
- bup1s0t3 = 1.956415e-6
-
+ bup1s0t0 = 3.186519_RKIND , &
+ bup1s0t1 = 2.212276e-2_RKIND, &
+ bup1s0t2 = -2.984642e-4_RKIND, &
+ bup1s0t3 = 1.956415e-6_RKIND
+
real (kind=RKIND), parameter :: &
- bup1s1t0 = 6.704388e-3, &
- bup1s1t1 = -1.847318e-4, &
- bup1s1t2 = 2.059331e-7, &
- bup1sqt0 = 1.480266e-4
-
+ bup1s1t0 = 6.704388e-3_RKIND, &
+ bup1s1t1 = -1.847318e-4_RKIND, &
+ bup1s1t2 = 2.059331e-7_RKIND, &
+ bup1sqt0 = 1.480266e-4_RKIND
+
real (kind=RKIND), parameter :: &
- bup2s0t0 = 2.102898e-4, &
- bup2s0t1 = -1.202016e-5, &
- bup2s0t2 = 1.394680e-7, &
- bup2s1t0 = -2.040237e-6, &
- bup2s1t1 = 6.128773e-8, &
- bup2s1t2 = 6.207323e-10
-
+ bup2s0t0 = 2.102898e-4_RKIND, &
+ bup2s0t1 = -1.202016e-5_RKIND, &
+ bup2s0t2 = 1.394680e-7_RKIND, &
+ bup2s1t0 = -2.040237e-6_RKIND, &
+ bup2s1t1 = 6.128773e-8_RKIND, &
+ bup2s1t2 = 6.207323e-10_RKIND
+
integer :: k_test, k_ref
-
+
err = 0
-
+
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
-! allocate local T,S tracer field
- allocate(tracerTS(2,nVertLevels,nCells+1))
+ allocate(tracerTemp(nVertLevels))
+ allocate(tracerSalt(nVertLevels))
-! fill tracerTS
- if (displacement_type == 'surfaceDisplaced') then
- if(present(tracersSurfaceLayerValue)) then
- do k=1,nVertLevels
- tracerTS(1,k,:) = tracersSurfaceLayerValue(indexT,:)
- tracerTS(2,k,:) = tracersSurfaceLayerValue(indexS,:)
- enddo
- displacement_type_local = 'relative'
- k_displaced_local = 0
- else
- write (stderrUnit,*) 'Abort: tracersSurfaceLayerValue must be present'
- call mpas_dmpar_abort(dminfo)
- endif
- else
- tracerTS(1,:,:) = tracers(indexT,:,:)
- tracerTS(2,:,:) = tracers(indexS,:,:)
- displacement_type_local = trim(displacement_type)
- k_displaced_local = k_displaced
- endif
! Jackett and McDougall
- tmin = -2.0 ! valid pot. temp. range
- tmax = 40.0
- smin = 0.0 ! valid salinity, in psu
- smax = 42.0
+ tmin = -2.0_RKIND ! valid pot. temp. range
+ tmax = 40.0_RKIND
+ smin = 0.0_RKIND ! valid salinity, in psu
+ smax = 42.0_RKIND
! This function computes pressure in bars from depth in meters
-! using a mean density derived from depth-dependent global
-! average temperatures and salinities from Levitus 1994, and
+! using a mean density derived from depth-dependent global
+! average temperatures and salinities from Levitus 1994, and
! integrating using hydrostatic balance.
allocate(pRefEOS(nVertLevels),p(nVertLevels),p2(nVertLevels))
- allocate(TQ(nVertLevels,nCells),SQ(nVertLevels,nCells),BULK_MOD(nVertLevels,nCells),SQR(nVertLevels,nCells),DENOMK(nVertLevels,nCells), RHO_S(nVertLevels,nCells), &
- WORK1(nVertLevels,nCells), WORK2(nVertLevels,nCells), WORK3(nVertLevels,nCells), WORK4(nVertLevels,nCells), T2(nVertLevels,nCells))
+ allocate(SQ(nVertLevels), TQ(nVertLevels), SQR(nVertLevels), T2(nVertLevels), WORK1(nVertLevels), &
+ WORK2(nVertLevels), RHO_S(nVertLevels), WORK3(nVertLevels), WORK4(nVertLevels), &
+ BULK_MOD(nVertLevels), DENOMK(nVertLevels))
! This could be put in the init routine.
! Note I am using refBottomDepth, so pressure on top level does
! not include SSH contribution. I am not sure if that matters, but
! POP does it the same way.
- depth = 0.5*refBottomDepth(1)
- pRefEOS(1) = 0.059808*(exp(-0.025*depth) - 1.0) &
- + 0.100766*depth + 2.28405e-7*depth**2
+ depth = 0.5_RKIND*refBottomDepth(1)
+ pRefEOS(1) = 0.059808_RKIND*(exp(-0.025_RKIND*depth) - 1.0_RKIND) &
+ + 0.100766_RKIND*depth + 2.28405e-7_RKIND*depth**2
do k = 2,nVertLevels
- depth = 0.5*(refBottomDepth(k)+refBottomDepth(k-1))
- pRefEOS(k) = 0.059808*(exp(-0.025*depth) - 1.0) &
- + 0.100766*depth + 2.28405e-7*depth**2
+ depth = 0.5_RKIND*(refBottomDepth(k)+refBottomDepth(k-1))
+ pRefEOS(k) = 0.059808_RKIND*(exp(-0.025_RKIND*depth) - 1.0_RKIND) &
+ + 0.100766_RKIND*depth + 2.28405e-7_RKIND*depth**2
enddo
! If k_displaced=0, in-situ density is returned (no displacement)
@@ -286,14 +268,26 @@ subroutine ocn_equation_of_state_jm_density(meshPool, k_displaced, displacement_
! referenced to level k_displaced for all k
! NOTE: k_displaced = 0 or > nVertLevels is incompatible with 'absolute'
! so abort if necessary
+ if (displacement_type == 'surfaceDisplaced') then
+ if(present(tracersSurfaceLayerValue)) then
+ displacement_type_local = 'relative'
+ k_displaced_local = 0
+ else
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: tracersSurfaceLayerValue must be present when displacement_type is ' &
+ // '''surfaceDisplaced'' in JM EOS')
+ endif
+ else
+ displacement_type_local = trim(displacement_type)
+ k_displaced_local = k_displaced
+ endif
if (displacement_type_local == 'absolute' .and. &
(k_displaced_local <= 0 .or. k_displaced_local > nVertLevels) ) then
write (stderrUnit,*) 'Abort: In equation_of_state_jm', &
' k_displaced must be between 1 and nVertLevels for ', &
- 'displacement_type = absolute'
- call mpas_dmpar_abort(dminfo)
+ 'displacement_type = absolute.'
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: k_displaced value invalide for JM EOS')
endif
if (k_displaced_local == 0) then
@@ -315,97 +309,125 @@ subroutine ocn_equation_of_state_jm_density(meshPool, k_displaced, displacement_
enddo
endif
+ !$omp do schedule(runtime) private(k, DRDT0, DKDT, DRHODT, DRDS0, DKDS, DRHODS)
do iCell=1,nCells
+ if (displacement_type == 'surfaceDisplaced') then
+ if(present(tracersSurfaceLayerValue)) then
+ do k=1,nVertLevels
+ tracerTemp(k) = tracersSurfaceLayerValue(indexT,iCell)
+ tracerSalt(k) = tracersSurfaceLayerValue(indexS,iCell)
+ enddo
+ else
+ write (stderrUnit,*) 'Abort: tracersSurfaceLayerValue must be present'
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: tracersSurfaceLayerValue must be present in JM EOS call')
+ endif
+ else
+ do k = 1, nVertLevels
+ tracerTemp(k) = tracers(indexT, k, iCell)
+ tracerSalt(k) = tracers(indexS, k, iCell)
+ end do
+ endif
+
do k=1,maxLevelCell(iCell)
- SQ(k,iCell) = max(min(tracerTS(2,k,iCell),smax),smin)
- TQ(k,iCell) = max(min(tracerTS(1,k,iCell),tmax),tmin)
-
- SQR(k,iCell) = sqrt(SQ(k,iCell))
- T2(k,iCell) = TQ(k,iCell)*TQ(k,iCell)
+ SQ(k) = max(min(tracerSalt(k),smax),smin)
+ TQ(k) = max(min(tracerTemp(k),tmax),tmin)
+
+ SQR(k) = sqrt(SQ(k))
+ T2(k) = TQ(k)*TQ(k)
!***
!*** first calculate surface (p=0) values from UNESCO eqns.
!***
- WORK1(k,iCell) = uns1t0 + uns1t1*TQ(k,iCell) + &
- (uns1t2 + uns1t3*TQ(k,iCell) + uns1t4*T2(k,iCell))*T2(k,iCell)
- WORK2(k,iCell) = SQR(k,iCell)*(unsqt0 + unsqt1*TQ(k,iCell) + unsqt2*T2(k,iCell))
+ WORK1(k) = uns1t0 + uns1t1*TQ(k) + &
+ (uns1t2 + uns1t3*TQ(k) + uns1t4*T2(k))*T2(k)
+ WORK2(k) = SQR(k)*(unsqt0 + unsqt1*TQ(k) + unsqt2*T2(k))
- RHO_S(k,iCell) = unt1*TQ(k,iCell) + (unt2 + unt3*TQ(k,iCell) + (unt4 + unt5*TQ(k,iCell))*T2(k,iCell))*T2(k,iCell) &
- + (uns2t0*SQ(k,iCell) + WORK1(k,iCell) + WORK2(k,iCell))*SQ(k,iCell)
+ RHO_S(k) = unt1*TQ(k) + (unt2 + unt3*TQ(k) + (unt4 + unt5*TQ(k))*T2(k))*T2(k) &
+ + (uns2t0*SQ(k) + WORK1(k) + WORK2(k))*SQ(k)
!***
- !*** now calculate bulk modulus at pressure p from
+ !*** now calculate bulk modulus at pressure p from
!*** Jackett and McDougall formula
!***
- WORK3(k,iCell) = bup0s1t0 + bup0s1t1*TQ(k,iCell) + &
- (bup0s1t2 + bup0s1t3*TQ(k,iCell))*T2(k,iCell) + &
- p(k) *(bup1s1t0 + bup1s1t1*TQ(k,iCell) + bup1s1t2*T2(k,iCell)) + &
- p2(k)*(bup2s1t0 + bup2s1t1*TQ(k,iCell) + bup2s1t2*T2(k,iCell))
- WORK4(k,iCell) = SQR(k,iCell)*(bup0sqt0 + bup0sqt1*TQ(k,iCell) + bup0sqt2*T2(k,iCell) + &
+ WORK3(k) = bup0s1t0 + bup0s1t1*TQ(k) + &
+ (bup0s1t2 + bup0s1t3*TQ(k))*T2(k) + &
+ p(k) *(bup1s1t0 + bup1s1t1*TQ(k) + bup1s1t2*T2(k)) + &
+ p2(k)*(bup2s1t0 + bup2s1t1*TQ(k) + bup2s1t2*T2(k))
+ WORK4(k) = SQR(k)*(bup0sqt0 + bup0sqt1*TQ(k) + bup0sqt2*T2(k) + &
bup1sqt0*p(k))
-
- BULK_MOD(k,iCell) = bup0s0t0 + bup0s0t1*TQ(k,iCell) + &
- (bup0s0t2 + bup0s0t3*TQ(k,iCell) + bup0s0t4*T2(k,iCell))*T2(k,iCell) + &
- p(k) *(bup1s0t0 + bup1s0t1*TQ(k,iCell) + &
- (bup1s0t2 + bup1s0t3*TQ(k,iCell))*T2(k,iCell)) + &
- p2(k)*(bup2s0t0 + bup2s0t1*TQ(k,iCell) + bup2s0t2*T2(k,iCell)) + &
- SQ(k,iCell)*(WORK3(k,iCell) + WORK4(k,iCell))
-
- DENOMK(k,iCell) = 1.0/(BULK_MOD(k,iCell) - p(k))
-
- density(k,iCell) = (unt0 + RHO_S(k,iCell))*BULK_MOD(k,iCell)*DENOMK(k,iCell)
- end do
- end do
+ BULK_MOD(k) = bup0s0t0 + bup0s0t1*TQ(k) + &
+ (bup0s0t2 + bup0s0t3*TQ(k) + bup0s0t4*T2(k))*T2(k) + &
+ p(k) *(bup1s0t0 + bup1s0t1*TQ(k) + &
+ (bup1s0t2 + bup1s0t3*TQ(k))*T2(k)) + &
+ p2(k)*(bup2s0t0 + bup2s0t1*TQ(k) + bup2s0t2*T2(k)) + &
+ SQ(k)*(WORK3(k) + WORK4(k))
- if (present(thermalExpansionCoeff)) then
- do iCell=1,nCells
- do k=1,maxLevelCell(iCell)
- DRDT0 = unt1 + 2.0*unt2*TQ(k,iCell) + &
- (3.0*unt3 + 4.0*unt4*TQ(k,iCell) + 5.0*unt5*T2(k,iCell))*T2(k,iCell) + &
- (uns1t1 + 2.0*uns1t2*TQ(k,iCell) + &
- (3.0*uns1t3 + 4.0*uns1t4*TQ(k,iCell))*T2(k,iCell) + &
- (unsqt1 + 2.0*unsqt2*TQ(k,iCell))*SQR(k,iCell) )*SQ(k,iCell)
+ DENOMK(k) = 1.0/(BULK_MOD(k) - p(k))
- DKDT = bup0s0t1 + 2.0*bup0s0t2*TQ(k,iCell) + &
- (3.0*bup0s0t3 + 4.0*bup0s0t4*TQ(k,iCell))*T2(k,iCell) + &
- p(k) *(bup1s0t1 + 2.0*bup1s0t2*TQ(k,iCell) + 3.0*bup1s0t3*T2(k,iCell)) + &
- p2(k)*(bup2s0t1 + 2.0*bup2s0t2*TQ(k,iCell)) + &
- SQ(k,iCell)*(bup0s1t1 + 2.0*bup0s1t2*TQ(k,iCell) + 3.0*bup0s1t3*T2(k,iCell) + &
- p(k) *(bup1s1t1 + 2.0*bup1s1t2*TQ(k,iCell)) + &
- p2(k) *(bup2s1t1 + 2.0*bup2s1t2*TQ(k,iCell)) + &
- SQR(k,iCell)*(bup0sqt1 + 2.0*bup0sqt2*TQ(k,iCell)))
+ density(k, iCell) = (unt0 + RHO_S(k))*BULK_MOD(k)*DENOMK(k)
- DRHODT = (DENOMK(k,iCell)*(DRDT0*BULK_MOD(k,iCell) - &
- p(k)*(unt0+RHO_S(k,iCell))*DKDT*DENOMK(k,iCell)))
+ end do
+ if (present(thermalExpansionCoeff)) then
+ do k=1,maxLevelCell(iCell)
+ DRDT0 = unt1 + 2.0_RKIND*unt2*TQ(k) + &
+ (3.0_RKIND*unt3 + 4.0_RKIND*unt4*TQ(k) + 5.0_RKIND*unt5*T2(k))*T2(k) + &
+ (uns1t1 + 2.0_RKIND*uns1t2*TQ(k) + &
+ (3.0_RKIND*uns1t3 + 4.0_RKIND*uns1t4*TQ(k))*T2(k) + &
+ (unsqt1 + 2.0_RKIND*unsqt2*TQ(k))*SQR(k) )*SQ(k)
+
+ DKDT = bup0s0t1 + 2.0_RKIND*bup0s0t2*TQ(k) + &
+ (3.0_RKIND*bup0s0t3 + 4.0_RKIND*bup0s0t4*TQ(k))*T2(k) + &
+ p(k) *(bup1s0t1 + 2.0_RKIND*bup1s0t2*TQ(k) + 3.0_RKIND*bup1s0t3*T2(k)) + &
+ p2(k)*(bup2s0t1 + 2.0_RKIND*bup2s0t2*TQ(k)) + &
+ SQ(k)*(bup0s1t1 + 2.0_RKIND*bup0s1t2*TQ(k) + 3.0_RKIND*bup0s1t3*T2(k) + &
+ p(k) *(bup1s1t1 + 2.0_RKIND*bup1s1t2*TQ(k)) + &
+ p2(k) *(bup2s1t1 + 2.0_RKIND*bup2s1t2*TQ(k)) + &
+ SQR(k)*(bup0sqt1 + 2.0_RKIND*bup0sqt2*TQ(k)))
+
+ DRHODT = (DENOMK(k)*(DRDT0*BULK_MOD(k) - &
+ p(k)*(unt0+RHO_S(k))*DKDT*DENOMK(k)))
thermalExpansionCoeff(k,iCell) = -DRHODT/density(k,iCell)
-
end do
- end do
- endif
+ end if
- if (present(salineContractionCoeff)) then
- do iCell=1,nCells
+ if (present(salineContractionCoeff)) then
do k=1,maxLevelCell(iCell)
- DRDS0 = 2.0*uns2t0*SQ(k,iCell) + WORK1(k,iCell) + 1.5*WORK2(k,iCell)
- DKDS = WORK3(k,iCell) + 1.5*WORK4(k,iCell)
+ DRDS0 = 2.0_RKIND*uns2t0*SQ(k) + WORK1(k) + 1.5_RKIND*WORK2(k)
+ DKDS = WORK3(k) + 1.5_RKIND*WORK4(k)
- DRHODS = DENOMK(k,iCell)*(DRDS0*BULK_MOD(k,iCell) - &
- p(k)*(unt0+RHO_S(k,iCell))*DKDS*DENOMK(k,iCell))
+ DRHODS = DENOMK(k)*(DRDS0*BULK_MOD(k) - &
+ p(k)*(unt0+RHO_S(k))*DKDS*DENOMK(k))
salineContractionCoeff(k,iCell) = DRHODS/density(k,iCell)
end do
- end do
- endif
+
+ end if
+ end do
+ !$omp end do
+
+ call mpas_threading_barrier()
deallocate(pRefEOS,p,p2)
- deallocate(tracerTS)
- deallocate(TQ,SQ,T2,BULK_MOD,SQR,DENOMK,RHO_S, WORK1, WORK2, WORK3, WORK4)
+ deallocate(tracerTemp)
+ deallocate(tracerSalt)
+
+ deallocate(SQ)
+ deallocate(TQ)
+ deallocate(SQR)
+ deallocate(T2)
+ deallocate(WORK1)
+ deallocate(WORK2)
+ deallocate(RHO_S)
+ deallocate(WORK3)
+ deallocate(WORK4)
+ deallocate(BULK_MOD)
+ deallocate(DENOMK)
end subroutine ocn_equation_of_state_jm_density!}}}
@@ -416,11 +438,11 @@ end subroutine ocn_equation_of_state_jm_density!}}}
!> \brief Initializes ocean momentum horizontal mixing quantities
!> \author Mark Petersen
!> \date September 2011
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity mixing in the ocean. Since a variety of
+!> \details
+!> This routine initializes a variety of quantities related to
+!> horizontal velocity mixing in the ocean. Since a variety of
!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
+!> individual init routines for each parameterization.
!
!-----------------------------------------------------------------------
diff --git a/src/core_ocean/shared/mpas_ocn_equation_of_state_linear.F b/src/core_ocean/shared/mpas_ocn_equation_of_state_linear.F
index 7de9681a47..f79bd84105 100644
--- a/src/core_ocean/shared/mpas_ocn_equation_of_state_linear.F
+++ b/src/core_ocean/shared/mpas_ocn_equation_of_state_linear.F
@@ -70,13 +70,14 @@ module ocn_equation_of_state_linear
!> \brief Calls equation of state
!> \author Mark Petersen, Todd Ringler
!> \date September 2011
-!> \details
+!> \details
!> This routine uses a linear equation of state to update the density
!
!-----------------------------------------------------------------------
- subroutine ocn_equation_of_state_linear_density(meshPool, k_displaced, displacement_type, indexT, indexS, tracers, density, err, &
- tracersSurfaceLayerValue, thermalExpansionCoeff, salineContractionCoeff)!{{{
+ subroutine ocn_equation_of_state_linear_density(meshPool, k_displaced, displacement_type, indexT, indexS, tracers, & !{{{
+ density, err, tracersSurfaceLayerValue, thermalExpansionCoeff, &
+ salineContractionCoeff)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This module contains routines necessary for computing the density
! from model temperature and salinity using an equation of state.
@@ -137,11 +138,12 @@ subroutine ocn_equation_of_state_linear_density(meshPool, k_displaced, displacem
write (stderrUnit,*) 'Abort: In equation_of_state_jm', &
' k_displaced must be between 1 and nVertLevels for ', &
'displacement_type = absolute'
- call mpas_dmpar_abort(dminfo)
+ call mpas_dmpar_global_abort('MPAS-ocean: Abort: In equation_of_state_jm')
endif
! if surfaceDisplaced, then compute density at all levels based on surface values
if (displacement_type_local == 'surfaceDisplaced') then
+ !$omp do schedule(runtime) private(k)
do iCell = 1, nCells
do k = 1, maxLevelCell(iCell)
! Linear equation of state
@@ -150,12 +152,14 @@ subroutine ocn_equation_of_state_linear_density(meshPool, k_displaced, displacem
+ config_eos_linear_beta * (tracersSurfaceLayerValue(indexS,iCell) - config_eos_linear_Sref)
end do
end do
+ !$omp end do
endif
! if absolute, then compute density at all levels based on pressure of k_displaced value
! but since linear EOS does not (at present) have a pressure dependency, this just returns density
if (displacement_type_local == 'absolute') then
+ !$omp do schedule(runtime) private(k)
do iCell = 1, nCells
do k = 1, maxLevelCell(iCell)
! Linear equation of state
@@ -164,11 +168,13 @@ subroutine ocn_equation_of_state_linear_density(meshPool, k_displaced, displacem
+ config_eos_linear_beta * (tracers(indexS,k,iCell) - config_eos_linear_Sref)
end do
end do
+ !$omp end do
endif
! if relative, then compute density at all levels based on k+k_displaced pressure value
! but since (at present) linear EOS has not dependence on pressure, it returns density
if (displacement_type_local == 'relative') then
+ !$omp do schedule(runtime) private(k)
do iCell = 1, nCells
do k = 1, maxLevelCell(iCell)
! Linear equation of state
@@ -177,22 +183,27 @@ subroutine ocn_equation_of_state_linear_density(meshPool, k_displaced, displacem
+ config_eos_linear_beta * (tracers(indexS,k,iCell) - config_eos_linear_Sref)
end do
end do
+ !$omp end do
endif
if (present(thermalExpansionCoeff)) then
+ !$omp do schedule(runtime) private(k)
do iCell = 1, nCells
do k = 1, maxLevelCell(iCell)
thermalExpansionCoeff(k,iCell) = config_eos_linear_alpha / density(k,iCell)
end do
end do
+ !$omp end do
endif
if (present(salineContractionCoeff)) then
+ !$omp do schedule(runtime) private(k)
do iCell = 1, nCells
do k = 1, maxLevelCell(iCell)
salineContractionCoeff(k,iCell) = config_eos_linear_beta / density(k,iCell)
end do
end do
+ !$omp end do
endif
end subroutine ocn_equation_of_state_linear_density!}}}
@@ -204,11 +215,11 @@ end subroutine ocn_equation_of_state_linear_density!}}}
!> \brief Initializes ocean momentum horizontal mixing quantities
!> \author Mark Petersen, Todd Ringler
!> \date September 2011
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity mixing in the ocean. Since a variety of
+!> \details
+!> This routine initializes a variety of quantities related to
+!> horizontal velocity mixing in the ocean. Since a variety of
!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
+!> individual init routines for each parameterization.
!
!-----------------------------------------------------------------------
diff --git a/src/core_ocean/shared/mpas_ocn_forcing.F b/src/core_ocean/shared/mpas_ocn_forcing.F
index 80986b6273..56a1690098 100644
--- a/src/core_ocean/shared/mpas_ocn_forcing.F
+++ b/src/core_ocean/shared/mpas_ocn_forcing.F
@@ -25,14 +25,15 @@ module ocn_forcing
use mpas_timekeeping
use mpas_io_units
use mpas_dmpar
- use ocn_forcing_bulk
- use ocn_forcing_restoring
use ocn_constants
implicit none
private
save
+ ! TRACER-CLEAN-UP
+ ! Need to figure out what to do with absorption coefficient computation.
+
!--------------------------------------------------------------------
!
! Public parameters
@@ -45,8 +46,7 @@ module ocn_forcing
!
!--------------------------------------------------------------------
- public :: ocn_forcing_build_arrays, &
- ocn_forcing_init, &
+ public :: ocn_forcing_init, &
ocn_forcing_build_fraction_absorbed_array, &
ocn_forcing_transmission
@@ -56,103 +56,11 @@ module ocn_forcing
!
!--------------------------------------------------------------------
- real (kind=RKIND) :: attenuationCoefficient
-
- logical :: restoringOn, bulkOn
-
!***********************************************************************
contains
!***********************************************************************
-!
-! routine ocn_forcing_build_arrays
-!
-!> \brief Determines the forcing arrays.
-!> \author Doug Jacobsen
-!> \date 12/13/12
-!> \details
-!> This routine computes the forcing arrays used later in MPAS.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_forcing_build_arrays(meshPool, statePool, forcingPool, err, timeLevelIn)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mpas_pool_type), intent(in) :: &
- statePool, & !< Input: State information
- meshPool !< Input: mesh information
-
- integer, intent(in), optional :: timeLevelIn
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- type (mpas_pool_type), intent(inout) :: forcingPool !< Input: Forcing information
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: Error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: timeLevel
- integer, pointer :: indexTemperature, indexSalinity
- integer, pointer :: indexSurfaceTemperatureFlux, indexSurfaceSalinityFlux
-
- real (kind=RKIND), dimension(:), pointer :: temperatureRestore, salinityRestore
- real (kind=RKIND), dimension(:,:), pointer :: surfaceTracerFlux
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers
-
- if (present(timeLevelIn)) then
- timeLevel = timeLevelIn
- else
- timeLevel = 1
- end if
-
- if ( bulkOn ) then
- call ocn_forcing_bulk_build_arrays(meshPool, forcingPool, err)
- end if
-
- if ( restoringOn ) then
- call mpas_pool_get_dimension(statePool, 'index_temperature', indexTemperature)
- call mpas_pool_get_dimension(statePool, 'index_salinity', indexSalinity)
-
- call mpas_pool_get_dimension(forcingPool, 'index_surfaceTemperatureFlux', indexSurfaceTemperatureFlux)
- call mpas_pool_get_dimension(forcingPool, 'index_surfaceSalinityFlux', indexSurfaceSalinityFlux)
-
- call mpas_pool_get_array(statePool, 'tracers', tracers, timeLevel)
-
- call mpas_pool_get_array(meshPool, 'temperatureRestore', temperatureRestore)
- call mpas_pool_get_array(meshPool, 'salinityRestore', salinityRestore)
-
- call mpas_pool_get_array(forcingPool, 'surfaceTracerFlux', surfaceTracerFlux)
-
- call ocn_forcing_restoring_build_arrays(meshPool, indexTemperature, indexSalinity, &
- indexSurfaceTemperatureFlux, indexSurfaceSalinityFlux, &
- tracers, temperatureRestore, salinityRestore, &
- surfaceTracerFlux, err)
- end if
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_forcing_build_arrays!}}}
!***********************************************************************
!
@@ -161,7 +69,7 @@ end subroutine ocn_forcing_build_arrays!}}}
!> \brief Initializes forcing module
!> \author Doug Jacobsen
!> \date 12/13/12
-!> \details
+!> \details
!> This routine initializes the forcing modules.
!
!-----------------------------------------------------------------------
@@ -170,37 +78,7 @@ subroutine ocn_forcing_init(err)!{{{
integer, intent(out) :: err !< Output: error flag
- integer :: err1
-
- character (len=StrKIND), pointer :: config_forcing_type
- real (kind=RKIND), pointer :: config_flux_attenuation_coefficient
-
err = 0
- err1 = 0
-
- call mpas_pool_get_config(ocnConfigs, 'config_flux_attenuation_coefficient', config_flux_attenuation_coefficient)
- call mpas_pool_get_config(ocnConfigs, 'config_forcing_type', config_forcing_type)
-
- attenuationCoefficient = config_flux_attenuation_coefficient
-
- if ( config_forcing_type == trim('bulk') ) then
- call ocn_forcing_bulk_init(err1)
- bulkOn = .true.
- restoringOn = .false.
- else if ( config_forcing_type == trim('restoring') ) then
- call ocn_forcing_restoring_init(err1)
- restoringOn = .true.
- bulkOn = .false.
- else if ( config_forcing_type == trim('off') ) then
- restoringOn = .false.
- bulkOn = .false.
- else
- write(stderrUnit, *) "ERROR: config_forcing_type not one of 'bulk' 'restoring', or 'off'."
- err = 1
- call mpas_dmpar_global_abort("ERROR: config_forcing_type not one of 'bulk', 'restoring', or 'off'.")
- end if
-
- err = ior(err,err1)
end subroutine ocn_forcing_init!}}}
@@ -211,15 +89,16 @@ end subroutine ocn_forcing_init!}}}
!> \brief fraction absorbed coefficient array for surface forcing.
!> \author Doug Jacobsen
!> \date 10/03/2013
-!> \details
+!> \details
!> This subroutine builds the fractionAbsorbed coefficient array for use in
!> applying surface fluxes deeper than the surface layer.
!
!-----------------------------------------------------------------------
- subroutine ocn_forcing_build_fraction_absorbed_array(meshPool, statePool, forcingPool, err, timeLevelIn)!{{{
+ subroutine ocn_forcing_build_fraction_absorbed_array(meshPool, statePool, diagnosticsPool, forcingPool, err, timeLevelIn)!{{{
type (mpas_pool_type), intent(in) :: meshPool !< Input: Mesh information
type (mpas_pool_type), intent(in) :: statePool !< Input: State information
+ type (mpas_pool_type), intent(in) :: diagnosticsPool !< Input: Diagnostics information
type (mpas_pool_type), intent(inout) :: forcingPool !< Input/Output: Forcing information
integer, intent(out) :: err !< Output: Error code
integer, intent(in), optional :: timeLevelIn
@@ -232,7 +111,9 @@ subroutine ocn_forcing_build_fraction_absorbed_array(meshPool, statePool, forcin
real (kind=RKIND) :: zTop, zBot, transmissionCoeffTop, transmissionCoeffBot
- real (kind=RKIND), dimension(:,:), pointer :: layerThickness, fractionAbsorbed
+ real (kind=RKIND), dimension(:), pointer :: surfaceFluxAttenuationCoefficient
+ real (kind=RKIND), dimension(:), pointer :: surfaceFluxAttenuationCoefficientRunoff
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness, fractionAbsorbed, fractionAbsorbedRunoff
integer :: iCell, k, timeLevel
integer, pointer :: nCells
@@ -253,14 +134,19 @@ subroutine ocn_forcing_build_fraction_absorbed_array(meshPool, statePool, forcin
call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, timeLevel)
+ call mpas_pool_get_array(diagnosticsPool, 'surfaceFluxAttenuationCoefficient', surfaceFluxAttenuationCoefficient)
+ call mpas_pool_get_array(diagnosticsPool, 'surfaceFluxAttenuationCoefficientRunoff', &
+ surfaceFluxAttenuationCoefficientRunoff)
+
call mpas_pool_get_array(forcingPool, 'fractionAbsorbed', fractionAbsorbed)
+ call mpas_pool_get_array(forcingPool, 'fractionAbsorbedRunoff', fractionAbsorbedRunoff)
do iCell = 1, nCells
zTop = 0.0_RKIND
- transmissionCoeffTop = ocn_forcing_transmission(zTop)
+ transmissionCoeffTop = ocn_forcing_transmission(zTop, surfaceFluxAttenuationCoefficient(iCell))
do k = 1, maxLevelCell(iCell)
zBot = zTop - layerThickness(k,iCell)
- transmissionCoeffBot = ocn_forcing_transmission(zBot)
+ transmissionCoeffBot = ocn_forcing_transmission(zBot, surfaceFluxAttenuationCoefficient(iCell))
fractionAbsorbed(k, iCell) = transmissionCoeffTop - transmissionCoeffBot
@@ -269,6 +155,22 @@ subroutine ocn_forcing_build_fraction_absorbed_array(meshPool, statePool, forcin
end do
end do
+! now do river runoff separately
+
+ do iCell = 1, nCells
+ zTop = 0.0_RKIND
+ transmissionCoeffTop = ocn_forcing_transmission(zTop, surfaceFluxAttenuationCoefficientRunoff(iCell))
+ do k = 1, maxLevelCell(iCell)
+ zBot = zTop - layerThickness(k,iCell)
+ transmissionCoeffBot = ocn_forcing_transmission(zBot, surfaceFluxAttenuationCoefficientRunoff(iCell))
+
+ fractionAbsorbedRunoff(k, iCell) = transmissionCoeffTop - transmissionCoeffBot
+
+ zTop = zBot
+ transmissionCoeffTop = transmissionCoeffBot
+ end do
+ end do
+
end subroutine ocn_forcing_build_fraction_absorbed_array!}}}
!***********************************************************************
@@ -278,17 +180,17 @@ end subroutine ocn_forcing_build_fraction_absorbed_array!}}}
!> \brief Transmission coefficient for surface forcing.
!> \author Doug Jacobsen
!> \date 05/03/2013
-!> \details
+!> \details
!> This function computes and returns the transmission coefficient for surface
!> forcing based on depth. It uses an exponential decay function to determine the
!> coefficients.
!
!-----------------------------------------------------------------------
- real (kind=RKIND) function ocn_forcing_transmission(z)!{{{
- real (kind=RKIND), intent(in) :: z
+ real (kind=RKIND) function ocn_forcing_transmission(z, attenuationCoefficient)!{{{
+ real (kind=RKIND), intent(in) :: z, attenuationCoefficient
- ocn_forcing_transmission = exp( z / attenuationCoefficient )
+ ocn_forcing_transmission = exp( max(z / attenuationCoefficient, -100.0_RKIND) )
end function ocn_forcing_transmission!}}}
diff --git a/src/core_ocean/shared/mpas_ocn_forcing_bulk.F b/src/core_ocean/shared/mpas_ocn_forcing_bulk.F
deleted file mode 100644
index bce3cb0794..0000000000
--- a/src/core_ocean/shared/mpas_ocn_forcing_bulk.F
+++ /dev/null
@@ -1,220 +0,0 @@
-! 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
-!
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! ocn_forcing_bulk
-!
-!> \brief MPAS ocean bulk forcing
-!> \author Doug Jacobsen
-!> \date 04/25/12
-!> \details
-!> This module contains routines for building the forcing arrays,
-!> if bulk forcing is used.
-!
-!-----------------------------------------------------------------------
-
-module ocn_forcing_bulk
-
- use mpas_kind_types
- use mpas_derived_types
- use mpas_pool_routines
- use mpas_timekeeping
- use ocn_constants
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: ocn_forcing_bulk_build_arrays, &
- ocn_forcing_bulk_init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- real (kind=RKIND) :: refDensity
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine ocn_forcing_bulk_build_arrays
-!
-!> \brief Determines the forcing array used for the bulk forcing.
-!> \author Doug Jacobsen
-!> \date 04/25/12
-!> \details
-!> This routine computes the forcing arrays used later in MPAS.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_forcing_bulk_build_arrays(meshPool, forcingPool, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
- type (mpas_pool_type), intent(in) :: meshPool !< Input: mesh information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
- type (mpas_pool_type), intent(inout) :: forcingPool !< Input: Forcing information
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: Error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: iEdge, cell1, cell2
- integer :: iCell, k
- integer, pointer :: index_temperature_flux, index_salinity_flux
- integer, pointer :: nCells, nEdges
-
- integer, dimension(:,:), pointer :: cellsOnEdge
-
- real (kind=RKIND) :: meridionalAverage, zonalAverage
- real (kind=RKIND), dimension(:), pointer :: angleEdge
- real (kind=RKIND), dimension(:), pointer :: windStressZonal, windStressMeridional
- real (kind=RKIND), dimension(:), pointer :: latentHeatFlux, sensibleHeatFlux, longWaveHeatFluxUp, longWaveHeatFluxDown, evaporationFlux, seaIceHeatFlux, snowFlux
- real (kind=RKIND), dimension(:), pointer :: seaIceFreshWaterFlux, seaIceSalinityFlux, riverRunoffFlux, iceRunoffFlux
- real (kind=RKIND), dimension(:), pointer :: shortWaveHeatFlux, penetrativeTemperatureFlux
-
- real (kind=RKIND), dimension(:), pointer :: rainFlux
- real (kind=RKIND), dimension(:), pointer :: seaSurfacePressure, iceFraction
-
- real (kind=RKIND), dimension(:), pointer :: surfaceThicknessFlux, surfaceWindStress, surfaceWindStressMagnitude
- real (kind=RKIND), dimension(:,:), pointer :: surfaceTracerFlux
-
- err = 0
-
- call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
- call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
-
- call mpas_pool_get_array(meshPool, 'angleEdge', angleEdge)
- call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
-
- call mpas_pool_get_dimension(forcingPool, 'index_surfaceTemperatureFlux', index_temperature_flux)
- call mpas_pool_get_dimension(forcingPool, 'index_surfaceSalinityFlux', index_salinity_flux)
-
- call mpas_pool_get_array(forcingPool, 'surfaceWindStress', surfaceWindStress)
- call mpas_pool_get_array(forcingPool, 'surfaceWindStressMagnitude', surfaceWindStressMagnitude)
- call mpas_pool_get_array(forcingPool, 'windStressZonal', windStressZonal)
- call mpas_pool_get_array(forcingPool, 'windStressMeridional', windStressMeridional)
- call mpas_pool_get_array(forcingPool, 'latentHeatFlux', latentHeatFlux)
- call mpas_pool_get_array(forcingPool, 'sensibleHeatFlux', sensibleHeatFlux)
- call mpas_pool_get_array(forcingPool, 'longWaveHeatFluxUp', longWaveHeatFluxUp)
- call mpas_pool_get_array(forcingPool, 'longWaveHeatFluxDown', longWaveHeatFluxDown)
- call mpas_pool_get_array(forcingPool, 'evaporationFlux', evaporationFlux)
- call mpas_pool_get_array(forcingPool, 'seaIceHeatFlux', seaIceHeatFlux)
- call mpas_pool_get_array(forcingPool, 'snowFlux', snowFlux)
- call mpas_pool_get_array(forcingPool, 'shortWaveHeatFlux', shortWaveHeatFlux)
-
- call mpas_pool_get_array(forcingPool, 'seaIceFreshWaterFlux', seaIceFreshWaterFlux)
- call mpas_pool_get_array(forcingPool, 'seaIceSalinityFlux', seaIceSalinityFlux)
- call mpas_pool_get_array(forcingPool, 'riverRunoffFlux', riverRunoffFlux)
- call mpas_pool_get_array(forcingPool, 'iceRunoffFlux', iceRunoffFlux)
-
- call mpas_pool_get_array(forcingPool, 'rainFlux', rainFlux)
-
- call mpas_pool_get_array(forcingPool, 'seaSurfacePressure', seaSurfacePressure)
- call mpas_pool_get_array(forcingPool, 'iceFraction', iceFraction)
-
- call mpas_pool_get_array(forcingPool, 'surfaceThicknessFlux', surfaceThicknessFlux)
- call mpas_pool_get_array(forcingPool, 'surfaceTracerFlux', surfaceTracerFlux)
- call mpas_pool_get_array(forcingPool, 'penetrativeTemperatureFlux', penetrativeTemperatureFlux)
-
- ! Convert CESM wind stress to MPAS-O windstress
- do iEdge = 1, nEdges
- cell1 = cellsOnEdge(1, iEdge)
- cell2 = cellsOnEdge(2, iEdge)
-
- zonalAverage = 0.5 * (windStressZonal(cell1) + windStressZonal(cell2))
- meridionalAverage = 0.5 * (windStressMeridional(cell1) + windStressMeridional(cell2))
-
- surfaceWindStress(iEdge) = cos(angleEdge(iEdge)) * zonalAverage + sin(angleEdge(iEdge)) * meridionalAverage
- end do
-
-
- ! Build surface fluxes at cell centers
- do iCell = 1, nCells
- surfaceWindStressMagnitude(iCell) = sqrt(windStressZonal(iCell)**2 + windStressMeridional(iCell)**2)
- surfaceTracerFlux(index_temperature_flux, iCell) = (latentHeatFlux(iCell) + sensibleHeatFlux(iCell) + longWaveHeatFluxUp(iCell) + longWaveHeatFluxDown(iCell) &
- + seaIceHeatFlux(iCell) - (snowFlux(iCell) + iceRunoffFlux(iCell)) * latent_heat_fusion_mks) * hflux_factor
-
- surfaceTracerFlux(index_salinity_flux, iCell) = seaIceSalinityFlux(iCell) * sflux_factor
-
- surfaceThicknessFlux(iCell) = ( snowFlux(iCell) + rainFlux(iCell) + evaporationFlux(iCell) + seaIceFreshWaterFlux(iCell) + iceRunoffFlux(iCell) + riverRunoffFlux(iCell) ) / refDensity
- end do
-
- penetrativeTemperatureFlux = shortWaveHeatFlux * hflux_factor
-
- end subroutine ocn_forcing_bulk_build_arrays!}}}
-
-!***********************************************************************
-!
-! routine ocn_forcing_bulk_init
-!
-!> \brief Initializes bulk forcing module
-!> \author Doug Jacobsen
-!> \date 04/25/12
-!> \details
-!> This routine initializes the bulk forcing module.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_forcing_bulk_init(err)!{{{
-
- integer, intent(out) :: err !< Output: error flag
-
- real (kind=RKIND), pointer :: config_density0
-
- err = 0
-
-
- call mpas_pool_get_config(ocnConfigs, 'config_density0', config_density0)
-
- refDensity = config_density0
-
- end subroutine ocn_forcing_bulk_init!}}}
-
-!***********************************************************************
-
-end module ocn_forcing_bulk
-
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_forcing_restoring.F b/src/core_ocean/shared/mpas_ocn_forcing_restoring.F
deleted file mode 100644
index b7377d105d..0000000000
--- a/src/core_ocean/shared/mpas_ocn_forcing_restoring.F
+++ /dev/null
@@ -1,180 +0,0 @@
-! 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
-!
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! ocn_forcing_restoring
-!
-!> \brief MPAS ocean restoring
-!> \author Doug Jacobsen
-!> \date 10/28/2013
-!> \details
-!> This module contains routines for building surface flux arrays based on restoring.
-!
-!-----------------------------------------------------------------------
-
-module ocn_forcing_restoring
-
- use mpas_derived_types
- use mpas_pool_routines
- use ocn_constants
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: ocn_forcing_restoring_build_arrays, &
- ocn_forcing_restoring_init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- real (kind=RKIND) :: temperatureTimeScale, salinityTimeScale !< restoring timescales
- real (kind=RKIND) :: temperatureLengthScale, salinityLengthScale !< restoring timescales
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine ocn_forcing_restoring_build_arrays
-!
-!> \brief Builds the forcing array for restoring
-!> \author Doug Jacobsen
-!> \date 10/29/2013
-!> \details
-!> This routine builds the forcing array based on surface restoring.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_forcing_restoring_build_arrays(meshPool, indexT, indexS, indexTFlux, indexSFlux, tracers, temperatureRestoring, salinityRestoring, surfaceTracerFluxes, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mpas_pool_type), intent(in) :: &
- meshPool !< Input: mesh information
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracer quantities
-
- real (kind=RKIND), dimension(:), intent(in) :: &
- temperatureRestoring, & !< Input: Restoring values for temperature
- salinityRestoring !< Input: Restoring values for salinity
-
- integer, intent(in) :: indexT !< Input: index for temperature
- integer, intent(in) :: indexS !< Input: index for salinity
- integer, intent(in) :: indexTFlux !< Input: index for temperature flux
- integer, intent(in) :: indexSFlux !< Input: index for salinity flux
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(out) :: &
- surfaceTracerFluxes !< Input: tracer quantities
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< Output: Error flag
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: iCell, k
- integer, pointer :: nCells
-
- real (kind=RKIND) :: invTemp, invSalinity
-
- err = 0
-
- call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
-
- invTemp = 1.0 / (temperatureTimeScale * 86400.0)
- invSalinity = 1.0 / (salinityTimeScale * 86400.0)
-
- k = 1 ! restoring only in top layer
- do iCell=1,nCells
- surfaceTracerFluxes(indexTFlux, iCell) = - temperatureLengthScale * (tracers(indexT, k, iCell) - temperatureRestoring(iCell)) * invTemp
- surfaceTracerFluxes(indexSFlux, iCell) = - salinityLengthScale * (tracers(indexS, k, iCell) - salinityRestoring(iCell)) * invSalinity
- enddo
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_forcing_restoring_build_arrays!}}}
-
-!***********************************************************************
-!
-! routine ocn_forcing_restoring_init
-!
-!> \brief Initializes ocean surface restoring
-!> \author Doug Jacobsen
-!> \date 10/29/2013
-!> \details
-!> This routine initializes a variety of quantities related to
-!> restoring in the ocean.
-!
-!-----------------------------------------------------------------------
-
- subroutine ocn_forcing_restoring_init(err)!{{{
-
- integer, intent(out) :: err !< Output: error flag
-
- real (kind=RKIND), pointer :: config_restoreT_timescale, config_restoreT_lengthscale
- real (kind=RKIND), pointer :: config_restoreS_timescale, config_restoreS_lengthscale
-
- err = 0
-
- call mpas_pool_get_config(ocnConfigs, 'config_restoreT_timescale', config_restoreT_timescale)
- call mpas_pool_get_config(ocnConfigs, 'config_restoreT_lengthscale', config_restoreT_lengthscale)
- call mpas_pool_get_config(ocnConfigs, 'config_restoreS_timescale', config_restoreS_timescale)
- call mpas_pool_get_config(ocnConfigs, 'config_restoreS_lengthscale', config_restoreS_lengthscale)
-
- temperatureTimeScale = config_restoreT_timescale
- salinityTimeScale = config_restoreS_timescale
- temperatureLengthScale = config_restoreT_lengthscale
- salinityLengthScale = config_restoreS_lengthscale
-
- !--------------------------------------------------------------------
-
- end subroutine ocn_forcing_restoring_init!}}}
-
-!***********************************************************************
-
-end module ocn_forcing_restoring
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_frazil_forcing.F b/src/core_ocean/shared/mpas_ocn_frazil_forcing.F
new file mode 100644
index 0000000000..beffd951b0
--- /dev/null
+++ b/src/core_ocean/shared/mpas_ocn_frazil_forcing.F
@@ -0,0 +1,574 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_frazil_forcing
+!
+!> \brief MPAS ocean frazil formation module
+!> \author Todd Ringler
+!> \date 10/19/2015
+!> \details
+!> This module contains routines for the formation of frazil ice.
+!
+!-----------------------------------------------------------------------
+
+module ocn_frazil_forcing
+
+ use mpas_kind_types
+ use mpas_constants
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_timekeeping
+ use mpas_timer
+ use ocn_constants
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_frazil_forcing_build_arrays, &
+ ocn_frazil_forcing_tracers, &
+ ocn_frazil_forcing_layer_thickness, &
+ ocn_frazil_forcing_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: frazilFormationOn
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_frazil_forcing_tracers
+!
+!> \brief Determines the tracer tendency due to frazil
+!> \author Todd Ringler
+!> \date 18 October 2015
+!> \details
+!> This routine adds to the tracer tendency arrays
+!> used to compute tracer at n+1.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_frazil_forcing_tracers(meshPool, tracersPool, groupName, forcingPool, tracersTend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+ character (len=*) :: groupName !< Input: Name of tracer group
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(inout) :: meshPool !< Input/Output: mesh information
+ type (mpas_pool_type), intent(inout) :: tracersPool !< Input/Output: tracer tendency pool
+ type (mpas_pool_type), intent(inout) :: forcingPool !< Input/Output: forcing pool holding frazil-induced tendencies
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: tracersTend
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ if ( .not. frazilFormationOn ) return
+
+ if ( trim(groupName) == 'activeTracers' ) then
+ call ocn_frazil_forcing_active_tracers(meshPool, tracersPool, forcingPool, tracersTend, err)
+ end if
+
+ end subroutine ocn_frazil_forcing_tracers!}}}
+
+!***********************************************************************
+!
+! routine ocn_frazil_forcing_layer_thickness
+!
+!> \brief Add tendency due to frazil processes
+!> \author Todd Ringler
+!> \date 18 October 2015
+!> \details
+!> This routine adds a tendency to layer thickness due to frazil formation
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_frazil_forcing_layer_thickness(meshPool, forcingPool, layerThicknessTend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(in) :: meshPool !< Input: mesh information
+ type (mpas_pool_type), intent(in) :: forcingPool !< Input: Forcing information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+ real (kind=RKIND), intent(inout), dimension(:,:) :: layerThicknessTend
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iCell, k
+ integer, pointer :: nCells
+ integer, dimension(:), pointer :: maxLevelCell
+ real (kind=RKIND), dimension(:,:), pointer :: frazilLayerThicknessTendency
+
+ err = 0
+
+ if ( .not. frazilFormationOn ) return
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(forcingPool, 'frazilLayerThicknessTendency', frazilLayerThicknessTendency)
+
+ ! Build surface fluxes at cell centers
+ !$omp do schedule(runtime) private(k)
+ do iCell = 1, nCells
+ do k = 1, maxLevelCell(iCell)
+ layerThicknessTend(k,iCell) = layerThicknessTend(k,iCell) + frazilLayerThicknessTendency(k,iCell)
+ end do
+ end do
+ !$omp end do
+
+ end subroutine ocn_frazil_forcing_layer_thickness!}}}
+
+
+!***********************************************************************
+!
+! routine ocn_frazil_forcing_active_tracers
+!
+!> \brief Adds the active tracers forcing due to frazil
+!> \author Todd Ringler
+!> \date 18 October 2015
+!> \details
+!> This routine adds the active tracers forcing due to frazil
+!> from which tracer tendencies are computed later.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_frazil_forcing_active_tracers(meshPool, tracersPool, forcingPool, activeTracersTend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(in) :: meshPool !< Input: mesh information
+ type (mpas_pool_type), intent(inout) :: tracersPool !< Input: tracer tendency pool
+ type (mpas_pool_type), intent(inout) :: forcingPool !< Input: Forcing information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: activeTracersTend
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iCell, k
+ integer, pointer :: nCells
+ integer, pointer :: indexTemperature
+ integer, pointer :: indexSalinity
+ integer, pointer, dimension(:) :: maxLevelCell
+
+ real (kind=RKIND), dimension(:,:), pointer :: frazilTemperatureTendency
+ real (kind=RKIND), dimension(:,:), pointer :: frazilSalinityTendency
+
+ err = 0
+
+ if ( .not. frazilFormationOn ) return
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', indexTemperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', indexSalinity)
+
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(forcingPool, 'frazilTemperatureTendency', frazilTemperatureTendency)
+ call mpas_pool_get_array(forcingPool, 'frazilSalinityTendency', frazilSalinityTendency)
+
+ ! add to surface fluxes at cell centers
+ !$omp do schedule(runtime) private(k)
+ do iCell = 1, nCells
+ do k = 1, maxLevelCell(iCell)
+ activeTracersTend(indexTemperature,k,iCell) = activeTracersTend(indexTemperature,k,iCell) &
+ + frazilTemperatureTendency(k,iCell)
+ activeTracersTend(indexSalinity,k,iCell) = activeTracersTend(indexSalinity,k,iCell) + frazilSalinityTendency(k,iCell)
+ end do
+ end do
+ !$omp end do
+
+ end subroutine ocn_frazil_forcing_active_tracers!}}}
+
+
+!***********************************************************************
+!
+! routine ocn_frazil_forcing_build_arrays
+!
+!> \brief Performs the formation of frazil within the ocean.
+!> \author Todd Ringler
+!> \date 10/19/2015
+!> \details
+!> ocn_frazil_forcing_build_arrays computes the tendencies to layer thickness, temperature and salinity
+!> due to the creation and possible melting of frazil ice
+!>
+!> these tendencies can be retrieved at any point by calling into ocn_frazil_forcing_{tracers, thickness} routines
+!>
+!> the pressure exerted by the frazil on the ocean "surface" is added to the pressure computation in diagnostics
+!>
+!> this routine should be call at the beginning of whatever time stepping method is utilized
+!> and the tendencies should be retieved when building up the RHS of the thickess, temperature
+!> and salinity equations.
+!>
+!> this routine is only applicable to the surface pressure, thickness and active tracer fields
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_frazil_forcing_build_arrays(domain, meshPool, forcingPool, diagnosticsPool, statePool, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mpas_pool_type), pointer, intent(in) :: meshPool !< Input: Mesh information
+ type (mpas_pool_type), pointer, intent(in) :: diagnosticsPool !< Input: Diagnostic information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+ type (domain_type), intent(inout) :: domain
+ type (mpas_pool_type), pointer, intent(inout) :: statePool !< Input: State information
+ type (mpas_pool_type), pointer, intent(inout) :: forcingPool !< Input: Forcing information
+ integer, intent(inout) :: err !< Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), pointer :: tracersPool
+
+ real (kind=RKIND), dimension(:,:), pointer :: frazilLayerThicknessTendency
+ real (kind=RKIND), dimension(:,:), pointer :: frazilTemperatureTendency
+ real (kind=RKIND), dimension(:,:), pointer :: frazilSalinityTendency
+ real (kind=RKIND), dimension(:), pointer :: frazilSurfacePressure
+
+ integer :: iCell, k
+ integer, pointer :: nCells, nVertLevels
+ real (kind=RKIND) :: dt, columnTemperatureMin
+
+ type (MPAS_timeInterval_type) :: timeStep
+ real (kind=RKIND), pointer :: config_frazil_heat_of_fusion
+ real (kind=RKIND), pointer :: config_frazil_sea_ice_density
+ real (kind=RKIND), pointer :: config_frazil_fractional_thickness_limit
+ real (kind=RKIND), pointer :: config_frazil_maximum_depth
+ real (kind=RKIND), pointer :: config_specific_heat_sea_water
+ real (kind=RKIND), pointer :: config_frazil_ice_reference_salinity
+ real (kind=RKIND), pointer :: config_frazil_maximum_freezing_temperature
+ logical, pointer :: config_frazil_use_surface_pressure
+
+ real (kind=RKIND) :: newFrazilIceThickness
+ real (kind=RKIND) :: sumNewFrazilIceThickness
+ real (kind=RKIND) :: meltedFrazilIceThickness
+ real (kind=RKIND) :: oceanFreezingTemperature
+
+ real (kind=RKIND), pointer, dimension(:) :: accumulatedFrazilIceMassNew
+ real (kind=RKIND), pointer, dimension(:) :: accumulatedFrazilIceMassOld
+ real (kind=RKIND), pointer, dimension(:,:) :: zMid
+ real (kind=RKIND), pointer, dimension(:,:) :: layerThickness
+ real (kind=RKIND), pointer, dimension(:,:) :: density
+ real (kind=RKIND), pointer, dimension(:,:,:) :: activeTracers
+
+ integer, dimension(:), pointer :: maxLevelCell
+ integer, pointer :: indexTemperature !< index in tracers array for temperature
+ integer, pointer :: indexSalinity !< index in tracers array for salinity
+ integer :: kBottomFrazil ! k index where testing for frazil begins
+
+ real (kind=RKIND) :: potential ! scalar holding freezing/melt potential
+ real (kind=RKIND) :: freezingEnergy ! energy available for freezing, positive definite
+ real (kind=RKIND) :: meltingEnergy ! energy available for melting, positive definite
+
+ ! if frazil is not enabled, return
+ if(.not. frazilFormationOn) return
+
+ call mpas_timer_start("frazil")
+
+ ! get pool pointers
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
+ ! get dimensions
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', indexTemperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', indexSalinity)
+
+ ! get mesh information
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+
+ ! get arrays
+ ! note: state information is used to produce tendencies, so always grab "new" time level
+ call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
+ call mpas_pool_get_array(statePool, 'accumulatedFrazilIceMass', accumulatedFrazilIceMassNew, 2)
+ call mpas_pool_get_array(statePool, 'accumulatedFrazilIceMass', accumulatedFrazilIceMassOld, 1)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, 1)
+ call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
+ call mpas_pool_get_array(diagnosticsPool, 'density', density)
+ call mpas_pool_get_array(forcingPool, 'frazilTemperatureTendency', frazilTemperatureTendency)
+ call mpas_pool_get_array(forcingPool,'frazilSalinityTendency', frazilSalinityTendency)
+ call mpas_pool_get_array(forcingPool,'frazilLayerThicknessTendency', frazilLayerThicknessTendency)
+ call mpas_pool_get_array(forcingPool,'frazilSurfacePressure', frazilSurfacePressure)
+
+ ! get configure parameters
+ call mpas_pool_get_config(ocnConfigs, 'config_frazil_maximum_depth', config_frazil_maximum_depth)
+ call mpas_pool_get_config(ocnConfigs, 'config_frazil_fractional_thickness_limit', config_frazil_fractional_thickness_limit)
+ call mpas_pool_get_config(ocnConfigs, 'config_specific_heat_sea_water', config_specific_heat_sea_water)
+ call mpas_pool_get_config(ocnConfigs, 'config_frazil_heat_of_fusion', config_frazil_heat_of_fusion)
+ call mpas_pool_get_config(ocnConfigs, 'config_frazil_sea_ice_density', config_frazil_sea_ice_density)
+ call mpas_pool_get_config(ocnConfigs, 'config_frazil_ice_reference_salinity', config_frazil_ice_reference_salinity)
+ call mpas_pool_get_config(ocnConfigs, 'config_frazil_use_surface_pressure', config_frazil_use_surface_pressure)
+ call mpas_pool_get_config(ocnConfigs, 'config_frazil_maximum_freezing_temperature', &
+ config_frazil_maximum_freezing_temperature)
+
+ ! get time step in units of seconds
+ timeStep = mpas_get_clock_timestep(domain % clock, ierr=err)
+ call mpas_get_timeInterval(timeStep, dt=dt)
+
+ ! initialize frazil tendency fields
+ frazilTemperatureTendency = 0.0_RKIND
+ frazilSalinityTendency = 0.0_RKIND
+ frazilLayerThicknessTendency = 0.0_RKIND
+
+ ! loop over all columns
+ !$omp do schedule(runtime) private(kBottomFrazil, k, columnTemperatureMin, sumNewFrazilIceThickness, &
+ !$omp oceanFreezingTemperature, potential, freezingEnergy, meltingEnergy, &
+ !$omp newFrazilIceThickness, meltedFrazilIceThickness)
+ do iCell=1,nCells
+
+ ! find deepest level where frazil can be created
+ kBottomFrazil=maxLevelCell(iCell)
+ do k=maxLevelCell(iCell), 1, -1
+ if(-zMid(k,iCell).lt.config_frazil_maximum_depth) then
+ kBottomFrazil=k
+ exit
+ endif
+ enddo
+
+ ! find minimum temperature between 1:kBottomFrazil
+ columnTemperatureMin = 1.0e30_RKIND
+ do k=1,kBottomFrazil
+ if ( activeTracers(indexTemperature,k,iCell) .lt. columnTemperatureMin ) then
+ columnTemperatureMin = activeTracers(indexTemperature,k,iCell)
+ end if
+ enddo
+
+ ! test min temperature agains max freezing temperature to see if we should even consider creating frazil
+ if(columnTemperatureMin.gt.config_frazil_maximum_freezing_temperature) cycle
+
+ ! initialize the sum of new frazil ice created
+ sumNewFrazilIceThickness = 0.0_RKIND
+
+ ! loop from maximum depth of frazil creation to surface
+ do k = kBottomFrazil, 1, -1
+
+ ! get freezing temperature
+ oceanFreezingTemperature = ocn_freezing_temperature(activeTracers(indexSalinity,k,iCell))
+
+ potential = layerThickness(k,iCell) * config_specific_heat_sea_water &
+ * rho_sw * (activeTracers(indexTemperature,k,iCell) - oceanFreezingTemperature)
+
+ freezingEnergy = max(0.0_RKIND, -potential)
+ meltingEnergy = max(0.0_RKIND, potential)
+
+ if (freezingEnergy > 0) then
+
+ ! new frazil ice formation measured in meters
+ newFrazilIceThickness = freezingEnergy / (config_frazil_heat_of_fusion * config_frazil_sea_ice_density)
+
+ ! limit the frazil formed appropriately
+ newFrazilIceThickness = min(newFrazilIceThickness, layerThickness(k,iCell) * config_frazil_fractional_thickness_limit)
+
+ ! compute tendency to thickness, temperature and salinity
+ ! layerTendency is scaled so that mass of ice created == mass of ocean water removed
+
+ ! layer thickness decreased due to creation of frazil
+ ! note: -- this has to be density (not rho_sw) to keep buoyancy equal
+ frazilLayerThicknessTendency(k,iCell) = - newFrazilIceThickness * config_frazil_sea_ice_density / density(k,iCell) / dt
+
+ ! salt is extracted with the frazil
+ frazilSalinityTendency(k,iCell) = - newFrazilIceThickness * config_frazil_ice_reference_salinity / dt
+
+ ! ocean fluid temperature is warmed due to creation of frazil
+ frazilTemperatureTendency(k,iCell) = + ( newFrazilIceThickness * config_frazil_heat_of_fusion &
+ * config_frazil_sea_ice_density ) / (config_specific_heat_sea_water * rho_sw) / dt
+
+ ! keep track of sum of frazil ice
+ sumNewFrazilIceThickness = sumNewFrazilIceThickness + newFrazilIceThickness
+
+ else
+
+ ! ocean water is warm enough to melt frazil
+
+ ! test to see if there is frazil to be melted
+ if (sumNewFrazilIceThickness > 0.0_RKIND) then
+
+ ! Frazil melting
+ meltedFrazilIceThickness = meltingEnergy / (config_frazil_heat_of_fusion * config_frazil_sea_ice_density)
+
+ ! limit melting by what there is to melt
+ meltedFrazilIceThickness = min(meltedFrazilIceThickness, sumNewFrazilIceThickness)
+
+ ! limit melting by fraction of layer thickness
+ meltedFrazilIceThickness = min(meltedFrazilIceThickness, layerThickness(k,iCell) &
+ * config_frazil_fractional_thickness_limit)
+
+ ! compute tendency to thickness, temperature and salinity
+
+ ! layer thickness increases due to melting of frazil
+ ! note -- scaling by local ocean density to mimimize surface pressure forcing errors
+ frazilLayerThicknessTendency(k,iCell) = + meltedFrazilIceThickness * config_frazil_sea_ice_density &
+ / density(k,iCell) / dt
+
+ ! salt is released into ocean with the melting frazil
+ frazilSalinityTendency(k,iCell) = + meltedFrazilIceThickness * config_frazil_ice_reference_salinity / dt
+
+ ! ocean fluid temperature is cooled due to melting of frazil
+ frazilTemperatureTendency(k,iCell) = - ( meltedFrazilIceThickness * config_frazil_heat_of_fusion &
+ * config_frazil_sea_ice_density ) / (config_specific_heat_sea_water * rho_sw) &
+ / dt
+
+ ! keep track of new frazil ice
+ sumNewFrazilIceThickness = sumNewFrazilIceThickness - meltedFrazilIceThickness
+
+ endif ! if (sumNewFrazilIceThickness > 0.0_RKIND)
+
+ endif ! if (freezingEnergy < 0)
+
+ enddo ! do k=kBottom,1-1
+
+ ! accumulate frazil mass to column total
+ ! note: the accumulatedFrazilIceMass (at both time levels) is reset to zero after being sent to the coupler
+ accumulatedFrazilIceMassNew(iCell) = accumulatedFrazilIceMassOld(iCell) + sumNewFrazilIceThickness &
+ * config_frazil_sea_ice_density
+
+ enddo ! do iCell = 1, nCells
+ !$omp end do
+
+ if ( config_frazil_use_surface_pressure ) then
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ frazilSurfacePressure(iCell) = accumulatedFrazilIceMassNew(iCell) * gravity
+ end do
+ !$omp end do
+ end if
+
+ call mpas_timer_stop("frazil")
+
+ end subroutine ocn_frazil_forcing_build_arrays!}}}
+
+!***********************************************************************
+!
+! routine ocn_frazil_forcing_init
+!
+!> \brief Initializes ocean frazil ice module.
+!> \author Todd Ringler
+!> \date 10/19/2015
+!> \details
+!> This routine initializes the ocean frazil ice module and variables..
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_frazil_forcing_init(err)!{{{
+
+ integer, intent(out) :: err !< Output: error flag
+ logical, pointer :: config_use_frazil_ice_formation
+
+ err = 0
+
+ call mpas_pool_get_config(ocnConfigs, 'config_use_frazil_ice_formation', config_use_frazil_ice_formation)
+
+ frazilFormationOn = .false.
+
+ if(config_use_frazil_ice_formation) then
+ frazilFormationOn = .true.
+ end if
+
+ end subroutine ocn_frazil_forcing_init!}}}
+
+!***********************************************************************
+
+end module ocn_frazil_forcing
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_gm.F b/src/core_ocean/shared/mpas_ocn_gm.F
index c06c9f1ef6..d1fe14c10b 100644
--- a/src/core_ocean/shared/mpas_ocn_gm.F
+++ b/src/core_ocean/shared/mpas_ocn_gm.F
@@ -11,11 +11,12 @@ module ocn_gm
use mpas_pool_routines
use mpas_timer
use mpas_constants
-
+ use mpas_threading
+
use ocn_constants
implicit none
- private
+ private
save
!--------------------------------------------------------------------
@@ -41,12 +42,12 @@ module ocn_gm
private :: tridiagonal_solve
! Config options
- real (kind=RKIND), pointer :: config_gravWaveSpeed_trunc, config_standardGM_tracer_kappa, config_density0, &
+ real (kind=RKIND), pointer :: config_gravWaveSpeed_trunc, config_standardGM_tracer_kappa, &
config_max_relative_slope, config_Redi_kappa
logical, pointer :: config_use_standardGM
logical, pointer :: config_disable_redi_k33
- real (kind=RKIND), parameter :: epsGM = 1.0e-12
+ real (kind=RKIND), parameter :: epsGM = 1.0e-12_RKIND
!***********************************************************************
@@ -59,7 +60,7 @@ module ocn_gm
!> \brief Computes GM Bolus velocity
!> \author Qingshan Chen, Mark Petersen, Todd Ringler
!> \date January 2013
-!> \details
+!> \details
!> This routine is the main driver for the Gent-McWilliams (GM) parameterization.
!> It computes horizontal and vertical density gradients, the slope
!> of isopycnal surfaces, and solves a boundary value problem in each column
@@ -92,29 +93,28 @@ subroutine ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
!
!-----------------------------------------------------------------
- real(kind=RKIND), dimension(:,:), pointer :: density, displacedDensity, zMid, normalGMBolusVelocity, hEddyFlux, layerThicknessEdge, &
- gradDensityEdge, gradDensityTopOfEdge, gradDensityConstZTopOfEdge, gradZMidEdge, &
- gradZMidTopOfEdge, relativeSlopeTopOfEdge, relativeSlopeTopOfCell, k33, gmStreamFuncTopOfEdge, BruntVaisalaFreqTop, gmStreamFuncTopOfCell, &
- dDensityDzTopOfEdge, dDensityDzTopOfCell, relativeSlopeTapering, relativeSlopeTaperingCell, areaCellSum
+ real(kind=RKIND), dimension(:,:), pointer :: density, displacedDensity, zMid, normalGMBolusVelocity, hEddyFlux, &
+ layerThicknessEdge, gradDensityEdge, gradDensityTopOfEdge, gradDensityConstZTopOfEdge, gradZMidEdge, &
+ gradZMidTopOfEdge, relativeSlopeTopOfEdge, relativeSlopeTopOfCell, k33, gmStreamFuncTopOfEdge, BruntVaisalaFreqTop, &
+ gmStreamFuncTopOfCell, dDensityDzTopOfEdge, dDensityDzTopOfCell, relativeSlopeTapering, relativeSlopeTaperingCell, &
+ areaCellSum
real(kind=RKIND), dimension(:), pointer :: areaCell, dcEdge, dvEdge, tridiagA, tridiagB, tridiagC, rightHandSide
- integer, dimension(:), pointer :: maxLevelEdgeTop, maxLevelCell
- integer, dimension(:,:), pointer :: cellsOnEdge
- integer :: k, iEdge, cell1, cell2, iCell, N
+ integer, dimension(:), pointer :: maxLevelEdgeTop, maxLevelCell, nEdgesOnCell
+ integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell
+ integer :: i, k, iEdge, cell1, cell2, iCell, N
real(kind=RKIND) :: h1, h2, areaEdge, c, BruntVaisalaFreqTopEdge, rtmp, maxSlopeK33
! Dimensions
- integer, pointer :: nCells, nEdges
+ integer, pointer :: nCells, nEdges, nVertLevels
type (field2DReal), pointer :: gradDensityEdgeField, gradDensityTopOfEdgeField, gradDensityConstZTopOfEdgeField, &
gradZMidEdgeField, gradZMidTopOfEdgeField, dDensityDzTopOfCellField, dDensityDzTopOfEdgeField,areaCellSumField
- type (field1DReal), pointer :: rightHandSideField, tridiagAField, tridiagBField, tridiagCField
-
call mpas_pool_get_array(diagnosticsPool, 'density', density)
call mpas_pool_get_array(diagnosticsPool, 'displacedDensity', displacedDensity)
call mpas_pool_get_array(diagnosticsPool, 'zMid', zMid)
- call mpas_pool_get_array(diagnosticsPool, 'normalGMBolusVelocity', normalGMBolusVelocity)
+ call mpas_pool_get_array(diagnosticsPool, 'normalGMBolusVelocity', normalGMBolusVelocity)
call mpas_pool_get_array(diagnosticsPool, 'relativeSlopeTopOfEdge', relativeSlopeTopOfEdge)
call mpas_pool_get_array(diagnosticsPool, 'relativeSlopeTopOfCell', relativeSlopeTopOfCell)
call mpas_pool_get_array(diagnosticsPool, 'relativeSlopeTapering', relativeSlopeTapering)
@@ -133,9 +133,12 @@ subroutine ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
call mpas_pool_get_array(meshPool, 'areaCell', areaCell)
call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge)
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell)
+ call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell)
call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
call mpas_pool_get_field(scratchPool, 'gradDensityEdge', gradDensityEdgeField)
call mpas_pool_get_field(scratchPool, 'gradDensityTopOfEdge', gradDensityTopOfEdgeField)
@@ -144,10 +147,6 @@ subroutine ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
call mpas_pool_get_field(scratchPool, 'dDensityDzTopOfEdge', dDensityDzTopOfEdgeField)
call mpas_pool_get_field(scratchPool, 'gradZMidEdge', gradZMidEdgeField)
call mpas_pool_get_field(scratchPool, 'gradZMidTopOfEdge', gradZMidTopOfEdgeField)
- call mpas_pool_get_field(scratchPool, 'rightHandSide', rightHandSideField)
- call mpas_pool_get_field(scratchPool, 'tridiagA', tridiagAField)
- call mpas_pool_get_field(scratchPool, 'tridiagB', tridiagBField)
- call mpas_pool_get_field(scratchPool, 'tridiagC', tridiagCField)
call mpas_pool_get_field(scratchPool, 'areaCellSum', areaCellSumField)
call mpas_allocate_scratch_field(gradDensityEdgeField, .True.)
@@ -157,12 +156,10 @@ subroutine ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
call mpas_allocate_scratch_field(dDensityDzTopOfEdgeField, .True.)
call mpas_allocate_scratch_field(gradZMidEdgeField, .True.)
call mpas_allocate_scratch_field(gradZMidTopOfEdgeField, .True.)
- call mpas_allocate_scratch_field(rightHandSideField, .True.)
- call mpas_allocate_scratch_field(tridiagAField, .True.)
- call mpas_allocate_scratch_field(tridiagBField, .True.)
- call mpas_allocate_scratch_field(tridiagCField, .True.)
call mpas_allocate_scratch_field(areaCellSumField, .True.)
+ call mpas_threading_barrier()
+
gradDensityEdge => gradDensityEdgeField % array
gradDensityTopOfEdge => gradDensityTopOfEdgeField % array
gradDensityConstZTopOfEdge => gradDensityConstZTopOfEdgeField % array
@@ -170,38 +167,48 @@ subroutine ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
dDensityDzTopOfEdge => dDensityDzTopOfEdgeField % array
gradZMidEdge => gradZMidEdgeField % array
gradZMidTopOfEdge => gradZMidTopOfEdgeField % array
- rightHandSide => rightHandSideField % array
- tridiagA => tridiagAField % array
- tridiagB => tridiagBField % array
- tridiagC => tridiagCField % array
areaCellSum => areaCellSumField % array
+ allocate(rightHandSide(nVertLevels))
+ allocate(tridiagA(nVertLevels))
+ allocate(tridiagB(nVertLevels))
+ allocate(tridiagC(nVertLevels))
+
! Assign a huge value to the scratch variables which may manifest itself when
! there is a bug.
- gradDensityEdge(:,:) = huge(0D0)
- gradDensityTopOfEdge(:,:) = huge(0D0)
- dDensityDzTopOfCell(:,:) = huge(0D0)
- dDensityDzTopOfEdge(:,:) = huge(0D0)
- gradZMidEdge(:,:) = huge(0D0)
- gradZMidTopOfEdge(:,:) = huge(0D0)
-
- relativeSlopeTopOfEdge(:,:) = 0.0_RKIND
- relativeSlopeTopOfCell(:,:) = 0.0_RKIND
- relativeSlopeTapering(:,:) = 0.0_RKIND
- relativeSlopeTaperingCell(:,:) = 0.0_RKIND
- k33(:,:) = 0.0_RKIND
- normalGMBolusVelocity(:,:) = 0.0_RKIND
-
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ gradDensityEdge(:, iEdge) = huge(0D0)
+ gradDensityTopOfEdge(:, iEdge) = huge(0D0)
+ dDensityDzTopOfEdge(:, iEdge) = huge(0D0)
+ gradZMidEdge(:, iEdge) = huge(0D0)
+ gradZMidTopOfEdge(:, iEdge) = huge(0D0)
+ relativeSlopeTopOfEdge(:, iEdge) = 0.0_RKIND
+ relativeSlopeTapering(:, iEdge) = 0.0_RKIND
+ normalGMBolusVelocity(:, iEdge) = 0.0_RKIND
+ end do
+ !$omp end do
+
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ dDensityDzTopOfCell(:, iCell) = huge(0D0)
+ k33(:, iCell) = 0.0_RKIND
+ relativeSlopeTopOfCell(:, iCell) = 0.0_RKIND
+ relativeSlopeTaperingCell(:, iCell) = 0.0_RKIND
+ end do
+ !$omp end do
+
!--------------------------------------------------------------------
!
! Compute vertical derivative of density at top of cell, interpolate to top of edge
! This is required for Redi and Bolus parts.
!
!--------------------------------------------------------------------
-
+
! Compute vertical derivative of density (dDensityDzTopOfCell) at cell center and layer interface
- ! Note that displacedDensity is used from the upper cell, so that the EOS reference level for
+ ! Note that displacedDensity is used from the upper cell, so that the EOS reference level for
! pressure is the same for both displacedDensity(k-1,iCell) and density(k,iCell).
+ !$omp do schedule(runtime) private(k, rtmp)
do iCell = 1, nCells
do k = 2, maxLevelCell(iCell)
rtmp = (displacedDensity(k-1,iCell) - density(k,iCell)) / (zMid(k-1,iCell) - zMid(k,iCell))
@@ -214,8 +221,10 @@ subroutine ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
dDensityDzTopOfCell(1,iCell) = 0.0_RKIND
dDensityDzTopOfCell(maxLevelCell(iCell)+1,iCell) = 0.0_RKIND
end do
+ !$omp end do
! Interpolate dDensityDzTopOfCell to edge and layer interface
+ !$omp do schedule(runtime) private(k, cell1, cell2)
do iEdge = 1, nEdges
do k = 1, maxLevelEdgeTop(iEdge)+1
cell1 = cellsOnEdge(1,iEdge)
@@ -223,6 +232,7 @@ subroutine ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
dDensityDzTopOfEdge(k,iEdge) = 0.5_RKIND * (dDensityDzTopOfCell(k,cell1) + dDensityDzTopOfCell(k,cell2))
end do
end do
+ !$omp end do
!--------------------------------------------------------------------
!
@@ -231,9 +241,10 @@ subroutine ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
!
!--------------------------------------------------------------------
- ! Compute density gradient (gradDensityEdge) and gradient of zMid (gradZMidEdge)
+ ! Compute density gradient (gradDensityEdge) and gradient of zMid (gradZMidEdge)
! along the constant coordinate surface.
! The computed variables lives at edge and mid-layer depth
+ !$omp do schedule(runtime) private(cell1, cell2, k)
do iEdge = 1, nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
@@ -243,11 +254,13 @@ subroutine ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
gradZMidEdge(k,iEdge) = (zMid(k,cell2) - zMid(k,cell1)) / dcEdge(iEdge)
end do
end do
+ !$omp end do
! Interpolate gradDensityEdge and gradZMidEdge to layer interface
+ !$omp do schedule(runtime) private(k, h1, h2)
do iEdge = 1, nEdges
! The interpolation can only be carried out on non-boundary edges
- if (maxLevelEdgeTop(iEdge) .GE. 1) then
+ if (maxLevelEdgeTop(iEdge) .GE. 1) then
do k = 2, maxLevelEdgeTop(iEdge)
h1 = layerThicknessEdge(k-1,iEdge)
h2 = layerThicknessEdge(k,iEdge)
@@ -265,6 +278,7 @@ subroutine ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
gradZMidTopOfEdge(maxLevelEdgeTop(iEdge)+1,iEdge) = gradZMidEdge(maxLevelEdgeTop(iEdge),iEdge)
end if
end do
+ !$omp end do
!--------------------------------------------------------------------
!
@@ -272,13 +286,16 @@ subroutine ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
!
!--------------------------------------------------------------------
+ !$omp do schedule(runtime) private(k)
do iEdge = 1, nEdges
if (maxLevelEdgeTop(iEdge) .GE. 1) then
do k = 1, maxLevelEdgeTop(iEdge)+1
- gradDensityConstZTopOfEdge(k,iEdge) = gradDensityTopOfEdge(k,iEdge) - dDensityDzTopOfEdge(k,iEdge) * gradZMidTopOfEdge(k,iEdge)
+ gradDensityConstZTopOfEdge(k,iEdge) = gradDensityTopOfEdge(k,iEdge) - dDensityDzTopOfEdge(k,iEdge) &
+ * gradZMidTopOfEdge(k,iEdge)
end do
end if
end do
+ !$omp end do
!--------------------------------------------------------------------
!
@@ -289,66 +306,86 @@ subroutine ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
! Compute relativeSlopeTopOfEdge at edge and layer interface
! set relativeSlopeTopOfEdge to zero for horizontal land/water edges.
- relativeSlopeTopOfEdge = 0.0_RKIND
+ !$omp do schedule(runtime) private(k)
do iEdge = 1, nEdges
+ relativeSlopeTopOfEdge(:, iEdge) = 0.0_RKIND
! Beside a full land cell (e.g. missing cell) maxLevelEdgeTop=0, so relativeSlopeTopOfEdge at that edge will remain zero.
do k = 2, maxLevelEdgeTop(iEdge)
relativeSlopeTopOfEdge(k,iEdge) = - gradDensityTopOfEdge(k,iEdge) / min(dDensityDzTopOfEdge(k,iEdge),-epsGM)
end do
- ! Since dDensityDzTopOfEdge is guaranteed to be zero on the top surface, relativeSlopeTopOfEdge on the top surface is identified with its value on the second interface.
+ ! Since dDensityDzTopOfEdge is guaranteed to be zero on the top surface, relativeSlopeTopOfEdge on the top
+ ! surface is identified with its value on the second interface.
relativeSlopeTopOfEdge(1,iEdge) = relativeSlopeTopOfEdge(2,iEdge)
- ! dDensityDzTopOfEdge may or may not equal zero on the bottom surface, depending on whether maxLevelEdgeTop(iEdge) = maxLevelEdgeBottom(iEdge). But here we
- ! take a simplistic approach and identify relativeSlopeTopOfEdge on the bottom surface with its value on the interface just above.
+ ! dDensityDzTopOfEdge may or may not equal zero on the bottom surface, depending on whether
+ ! maxLevelEdgeTop(iEdge) = maxLevelEdgeBottom(iEdge). But here we
+ ! take a simplistic approach and identify relativeSlopeTopOfEdge on the bottom surface with its value on
+ ! the interface just above.
relativeSlopeTopOfEdge( maxLevelEdgeTop(iEdge)+1, iEdge ) = relativeSlopeTopOfEdge( max(1,maxLevelEdgeTop(iEdge)), iEdge )
end do
+ !$omp end do
! slope can be unbounded in regions of neutral stability, reset to the large, but bounded, value
! values is hardwrite to 1.0, this is equivalent to a slope of 45 degrees
- where(relativeSlopeTopOfEdge < -1.0_RKIND) relativeSlopeTopOfEdge = -1.0_RKIND
- where(relativeSlopeTopOfEdge > 1.0_RKIND) relativeSlopeTopOfEdge = 1.0_RKIND
+ !$omp do schedule(runtime) private(k)
+ do iEdge = 1, nEdges
+ do k = 1, nVertLevels
+ relativeSlopeTopOfEdge(k, iEdge) = max( min( relativeSlopeTopOfEdge(k, iEdge), 1.0_RKIND), -1.0_RKIND)
+ end do
+ end do
+ !$omp end do
! average relative slope to cell centers
! do this by computing (relative slope)^2, then taking sqrt
- areaCellSum = 1.0e-34_RKIND
- do iEdge = 1, nEdges
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
- ! contribution of cell area from this edge:
- areaEdge = 0.25_RKIND * dcEdge(iEdge) * dvEdge(iEdge)
-
- do k = 1, maxLevelEdgeTop(iEdge)
- ! only one component is summed (thus the weighting by a factor of 2.0)
- rtmp = 2.0_RKIND * areaEdge * relativeSlopeTopOfEdge(k,iEdge)**2
- relativeSlopeTopOfCell(k,cell1) = relativeSlopeTopOfCell(k,cell1) + rtmp
- relativeSlopeTopOfCell(k,cell2) = relativeSlopeTopOfCell(k,cell2) + rtmp
-
- areaCellSum(k,cell1) = areaCellSum(k,cell1) + areaEdge
- areaCellSum(k,cell2) = areaCellSum(k,cell2) + areaEdge
-
- end do
+ !$omp do schedule(runtime) private(i, iEdge, areaEdge, rtmp, k)
+ do iCell = 1, nCells
+ areaCellSum(:, iCell) = 1.0e-34_RKIND
+ do i = 1, nEdgesOnCell(iCell)
+ iEdge = edgesOnCell(i, iCell)
+
+ !contribution of cell area from this edge * 2.0
+ areaEdge = 0.5_RKIND * dcEdge(iEdge) * dvEdge(iEdge)
+ do k = 1, maxLevelEdgeTop(iEdge)
+ rtmp = areaEdge * relativeSlopeTopOfEdge(k, iEdge)**2
+ relativeSlopeTopOfCell(k, iCell) = relativeSlopeTopOfCell(k, iCell) + rtmp
+ areaCellSum(k, iCell) = areaCellSum(k, iCell) + areaEdge
+ end do
+ end do
end do
+ !$omp end do
+
+ !$omp do schedule(runtime) private(k)
do iCell=1,nCells
do k = 1, maxLevelCell(iCell)
relativeSlopeTopOfCell(k,iCell) = sqrt(relativeSlopeTopOfCell(k,iCell)/areaCellSum(k,iCell))
end do
end do
+ !$omp end do
! Compute tapering function
! Compute k33 at cell center and layer interface
- k33(:,:) = 0.0_RKIND
+
+ !$omp do schedule(runtime) private(k)
do iCell=1,nCells
+ k33(:, iCell) = 0.0_RKIND
do k = 2, maxLevelCell(iCell)
- relativeSlopeTaperingCell(k,iCell) = min(1.0_RKIND, config_max_relative_slope**2 / (relativeSlopeTopOfCell(k,iCell)**2+epsGM))
+ relativeSlopeTaperingCell(k,iCell) = min(1.0_RKIND, config_max_relative_slope**2 &
+ / (relativeSlopeTopOfCell(k,iCell)**2+epsGM))
k33(k,iCell) = relativeSlopeTaperingCell(k,iCell) * (relativeSlopeTopOfCell(k,iCell))**2
+
+ ! k33 is still non-dimensional measuring the limited (relative slope)^2 of neutral surfaces.
+ ! scale k33 by config_Redi_kappa so it has units of diffusivity
+ k33(k,iCell) = config_Redi_kappa * k33(k, iCell)
end do
end do
+ !$omp end do
! average tapering function to layer edges
+ !$omp do schedule(runtime) private(cell1, cell2, k)
do iEdge = 1, nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
@@ -356,13 +393,16 @@ subroutine ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
relativeSlopeTapering(k,iEdge) = 0.5_RKIND * (relativeSlopeTaperingCell(k,cell1) + relativeSlopeTaperingCell(k,cell2))
enddo
enddo
-
- ! k33 is still non-dimensional measuring the limited (relative slope)^2 of neutral surfaces.
- ! scale k33 by config_Redi_kappa so it has units of diffusivity
- k33 = config_Redi_kappa * k33
+ !$omp end do
! allow disabling of K33 for testing
- if(config_disable_redi_k33) k33=0.0_RKIND
+ if(config_disable_redi_k33) then
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ k33(:, iCell) = 0.0_RKIND
+ end do
+ !$omp end do
+ end if
!--------------------------------------------------------------------
!
@@ -370,74 +410,99 @@ subroutine ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
!
!--------------------------------------------------------------------
- gmStreamFuncTopOfEdge(:,:) = 0.0_RKIND
c = config_gravWaveSpeed_trunc**2
- do iEdge = 1, nEdges
+ !$omp do schedule(runtime) private(cell1, cell2, k, BruntVaisalaFreqTopEdge, N)
+ do iEdge = 1, nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
+ gmStreamFuncTopOfEdge(:, iEdge) = 0.0_RKIND
+
! Construct the tridiagonal matrix
if (maxLevelEdgeTop(iEdge) .GE. 3) then
! First row
- k = 2
+ k = 2
BruntVaisalaFreqTopEdge = 0.5_RKIND * (BruntVaisalaFreqTop(k,cell1) + BruntVaisalaFreqTop(k,cell2))
BruntVaisalaFreqTopEdge = max(BruntVaisalaFreqTopEdge, 0.0_RKIND)
- tridiagB(k-1) = - 2.0_RKIND * config_gravWaveSpeed_trunc**2/(layerThicknessEdge(k-1,iEdge)*layerThicknessEdge(k,iEdge)) - BruntVaisalaFreqTopEdge
- tridiagC(k-1) = 2.0_RKIND * config_gravWaveSpeed_trunc**2/layerThicknessEdge(k,iEdge)/(layerThicknessEdge(k-1,iEdge)+layerThicknessEdge(k,iEdge))
- rightHandSide(k-1) = config_standardGM_tracer_kappa * gravity / config_density0 * gradDensityConstZTopOfEdge(k,iEdge)
+ tridiagB(k-1) = - 2.0_RKIND * config_gravWaveSpeed_trunc**2 / (layerThicknessEdge(k-1,iEdge) &
+ * layerThicknessEdge(k,iEdge)) - BruntVaisalaFreqTopEdge
+ tridiagC(k-1) = 2.0_RKIND * config_gravWaveSpeed_trunc**2 / layerThicknessEdge(k, iEdge) &
+ / (layerThicknessEdge(k-1, iEdge) + layerThicknessEdge(k, iEdge))
+ rightHandSide(k-1) = config_standardGM_tracer_kappa * gravity / rho_sw * gradDensityConstZTopOfEdge(k,iEdge)
! Second to next to the last rows
do k = 3, maxLevelEdgeTop(iEdge)-1
BruntVaisalaFreqTopEdge = 0.5_RKIND * (BruntVaisalaFreqTop(k,cell1) + BruntVaisalaFreqTop(k,cell2))
BruntVaisalaFreqTopEdge = max(BruntVaisalaFreqTopEdge, 0.0_RKIND)
- tridiagA(k-2) = 2.0_RKIND * config_gravWaveSpeed_trunc**2/layerThicknessEdge(k-1,iEdge)/(layerThicknessEdge(k-1,iEdge)+layerThicknessEdge(k,iEdge))
- tridiagB(k-1) = - 2.0_RKIND * config_gravWaveSpeed_trunc**2/(layerThicknessEdge(k-1,iEdge)*layerThicknessEdge(k,iEdge)) - BruntVaisalaFreqTopEdge
- tridiagC(k-1) = 2.0_RKIND * config_gravWaveSpeed_trunc**2/layerThicknessEdge(k,iEdge)/(layerThicknessEdge(k-1,iEdge)+layerThicknessEdge(k,iEdge))
- rightHandSide(k-1) = config_standardGM_tracer_kappa * gravity / config_density0 * gradDensityConstZTopOfEdge(k,iEdge)
+ tridiagA(k-2) = 2.0_RKIND * config_gravWaveSpeed_trunc**2 / layerThicknessEdge(k-1, iEdge) &
+ / (layerThicknessEdge(k-1, iEdge) + layerThicknessEdge(k, iEdge))
+ tridiagB(k-1) = - 2.0_RKIND * config_gravWaveSpeed_trunc**2 / (layerThicknessEdge(k-1, iEdge) &
+ * layerThicknessEdge(k, iEdge) ) - BruntVaisalaFreqTopEdge
+ tridiagC(k-1) = 2.0_RKIND * config_gravWaveSpeed_trunc**2 / layerThicknessEdge(k, iEdge) &
+ / (layerThicknessEdge(k-1, iEdge) + layerThicknessEdge(k, iEdge))
+ rightHandSide(k-1) = config_standardGM_tracer_kappa * gravity / rho_sw * gradDensityConstZTopOfEdge(k,iEdge)
end do
! Last row
- k = maxLevelEdgeTop(iEdge)
+ k = maxLevelEdgeTop(iEdge)
BruntVaisalaFreqTopEdge = 0.5_RKIND * (BruntVaisalaFreqTop(k,cell1) + BruntVaisalaFreqTop(k,cell2))
BruntVaisalaFreqTopEdge = max(BruntVaisalaFreqTopEdge, 0.0_RKIND)
- tridiagA(k-2) = 2.0_RKIND * config_gravWaveSpeed_trunc**2/layerThicknessEdge(k-1,iEdge)/(layerThicknessEdge(k-1,iEdge)+layerThicknessEdge(k,iEdge))
- tridiagB(k-1) = - 2.0_RKIND * config_gravWaveSpeed_trunc**2/(layerThicknessEdge(k-1,iEdge)*layerThicknessEdge(k,iEdge)) - BruntVaisalaFreqTopEdge
- rightHandSide(k-1) = config_standardGM_tracer_kappa * gravity / config_density0 * gradDensityConstZTopOfEdge(k,iEdge)
+ tridiagA(k-2) = 2.0_RKIND * config_gravWaveSpeed_trunc**2 / layerThicknessEdge(k-1,iEdge) &
+ / (layerThicknessEdge(k-1,iEdge) + layerThicknessEdge(k,iEdge))
+ tridiagB(k-1) = - 2.0_RKIND * config_gravWaveSpeed_trunc**2 / (layerThicknessEdge(k-1, iEdge) &
+ * layerThicknessEdge(k, iEdge)) - BruntVaisalaFreqTopEdge
+ rightHandSide(k-1) = config_standardGM_tracer_kappa * gravity / rho_sw * gradDensityConstZTopOfEdge(k,iEdge)
! Total number of rows
N = maxLevelEdgeTop(iEdge) - 1
! Call the tridiagonal solver
- call tridiagonal_solve(tridiagA, tridiagB, tridiagC, rightHandSide, gmStreamFuncTopOfEdge(2:maxLevelEdgeTop(iEdge),iEdge), N)
+ call tridiagonal_solve(tridiagA, tridiagB, tridiagC, rightHandSide, &
+ gmStreamFuncTopOfEdge(2:maxLevelEdgeTop(iEdge), iEdge), N)
end if
-
end do
+ !$omp end do
! Compute normalGMBolusVelocity from the stream function
+ !$omp do schedule(runtime) private(k)
do iEdge = 1, nEdges
do k = 1, maxLevelEdgeTop(iEdge)
- normalGMBolusVelocity(k,iEdge) = (gmStreamFuncTopOfEdge(k,iEdge) - gmStreamFuncTopOfEdge(k+1,iEdge)) / layerThicknessEdge(k,iEdge)
+ normalGMBolusVelocity(k,iEdge) = (gmStreamFuncTopOfEdge(k,iEdge) - gmStreamFuncTopOfEdge(k+1,iEdge)) &
+ / layerThicknessEdge(k,iEdge)
end do
end do
+ !$omp end do
! Interpolate gmStreamFuncTopOfEdge to cell centers for visualization
- gmStreamFuncTopOfCell(:,:) = 0.0_RKIND
- do iEdge = 1, nEdges
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
- areaEdge = 0.25_RKIND * dcEdge(iEdge) * dvEdge(iEdge)
+ !$omp do schedule(runtime) private(i, iEdge, areaEdge, k, rtmp)
+ do iCell = 1, nCells
+ gmStreamFuncTopOfCell(:, iCell) = 0.0_RKIND
+ do i = 1, nEdgesOnCell(iCell)
+ iEdge = edgesOnCell(i, iCell)
- do k = 1, maxLevelEdgeTop(iEdge)
- rtmp = 0.5_RKIND * ( gmStreamFuncTopOfEdge(k,iEdge) + gmStreamFuncTopOfEdge(k+1,iEdge) ) * areaEdge
- gmStreamFuncTopOfCell(k,cell1) = gmStreamFuncTopOfCell(k,cell1) + rtmp
- gmStreamFuncTopOfCell(k,cell2) = gmStreamFuncTopOfCell(k,cell2) + rtmp
- end do
+ areaEdge = 0.25_RKIND * dcEdge(iEdge) * dvEdge(iEdge)
+ do k = 1, maxLevelEdgeTop(iEdge)
+ rtmp = 0.5_RKIND * ( gmStreamFuncTopOfEdge(k, iEdge) + gmStreamFuncTopOfEdge(k+1, iEdge) ) * areaEdge
+ gmStreamFuncTopOfCell(k, iCell) = gmStreamFuncTopOfCell(k, iCell) + rtmp
+ end do
+ end do
end do
+ !$omp end do
+
+ !$omp do schedule(runtime)
do iCell = 1, nCells
gmStreamFuncTopOfCell(:, iCell) = gmStreamFuncTopOfCell(:,iCell) / areaCell(iCell)
end do
+ !$omp end do
+
+ deallocate(rightHandSide)
+ deallocate(tridiagA)
+ deallocate(tridiagB)
+ deallocate(tridiagC)
+
+ call mpas_threading_barrier()
! Deallocate scratch variables
call mpas_deallocate_scratch_field(gradDensityEdgeField, .true.)
@@ -447,10 +512,6 @@ subroutine ocn_gm_compute_Bolus_velocity(diagnosticsPool, meshPool, scratchPool)
call mpas_deallocate_scratch_field(dDensityDzTopOfEdgeField, .true.)
call mpas_deallocate_scratch_field(gradZMidEdgeField, .true.)
call mpas_deallocate_scratch_field(gradZMidTopOfEdgeField, .true.)
- call mpas_deallocate_scratch_field(rightHandSideField, .true.)
- call mpas_deallocate_scratch_field(tridiagAField, .true.)
- call mpas_deallocate_scratch_field(tridiagBField, .true.)
- call mpas_deallocate_scratch_field(tridiagCField, .true.)
end subroutine ocn_gm_compute_Bolus_velocity!}}}
@@ -461,7 +522,7 @@ end subroutine ocn_gm_compute_Bolus_velocity!}}}
!> \brief Solve the matrix equation Ax=r for x, where A is tridiagonal.
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> Solve the matrix equation Ax=r for x, where A is tridiagonal.
!> A is an nxn matrix, with:
!> a sub-diagonal, filled from 1:n-1 (a(1) appears on row 2)
@@ -471,7 +532,7 @@ end subroutine ocn_gm_compute_Bolus_velocity!}}}
!-----------------------------------------------------------------------
! mrp note: This subroutine also appears in vmix and should really be put in the framework.
subroutine tridiagonal_solve(a,b,c,r,x,n) !{{{
-
+
!-----------------------------------------------------------------
!
! input variables
@@ -499,27 +560,23 @@ subroutine tridiagonal_solve(a,b,c,r,x,n) !{{{
real (KIND=RKIND) :: m
integer i
- call mpas_timer_start("tridiagonal_solve")
-
! Use work variables for b and r
bTemp(1) = b(1)
rTemp(1) = r(1)
-
+
! First pass: set the coefficients
do i = 2,n
m = a(i-1)/bTemp(i-1)
bTemp(i) = b(i) - m*c(i-1)
rTemp(i) = r(i) - m*rTemp(i-1)
- end do
-
+ end do
+
x(n) = rTemp(n)/bTemp(n)
! Second pass: back-substition
do i = n-1, 1, -1
x(i) = (rTemp(i) - c(i)*x(i+1))/bTemp(i)
end do
- call mpas_timer_stop("tridiagonal_solve")
-
end subroutine tridiagonal_solve !}}}
!***********************************************************************
@@ -529,7 +586,7 @@ end subroutine tridiagonal_solve !}}}
!> \brief Initializes ocean momentum horizontal pressure gradient
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> This routine initializes parameters required for the computation of the
!> horizontal pressure gradient.
!
@@ -550,7 +607,6 @@ subroutine ocn_gm_init(err)!{{{
call mpas_pool_get_config(ocnConfigs, 'config_gravWaveSpeed_trunc',config_gravWaveSpeed_trunc)
call mpas_pool_get_config(ocnConfigs, 'config_standardGM_tracer_kappa',config_standardGM_tracer_kappa)
call mpas_pool_get_config(ocnConfigs, 'config_max_relative_slope',config_max_relative_slope)
- call mpas_pool_get_config(ocnConfigs, 'config_density0',config_density0)
call mpas_pool_get_config(ocnConfigs, 'config_Redi_kappa', config_Redi_kappa)
call mpas_pool_get_config(ocnConfigs, 'config_use_standardGM',config_use_standardGM)
call mpas_pool_get_config(ocnConfigs, 'config_disable_redi_k33',config_disable_redi_k33)
diff --git a/src/core_ocean/shared/mpas_ocn_high_freq_thickness_hmix_del2.F b/src/core_ocean/shared/mpas_ocn_high_freq_thickness_hmix_del2.F
index 61a75aae2d..8ea5e482cf 100644
--- a/src/core_ocean/shared/mpas_ocn_high_freq_thickness_hmix_del2.F
+++ b/src/core_ocean/shared/mpas_ocn_high_freq_thickness_hmix_del2.F
@@ -13,7 +13,7 @@
!> \author Mark Petersen
!> \date July 2013
!> \details
-!> This module contains the main driver routine for computing
+!> This module contains the main driver routine for computing
!> horizontal mixing tendencies for high frequency thickness mixing
!
!-----------------------------------------------------------------------
@@ -64,8 +64,8 @@ module ocn_high_freq_thickness_hmix_del2
!> \brief Computes Laplacian tendency term for horizontal highFreqThickness mixing
!> \author Mark Petersen
!> \date July 2013
-!> \details
-!> This routine computes the horizontal mixing tendency for
+!> \details
+!> This routine computes the horizontal mixing tendency for
!> high frequency thickness
!> based on current state using a Laplacian parameterization.
!
@@ -137,15 +137,16 @@ subroutine ocn_high_freq_thickness_hmix_del2_tend(meshPool, highFreqThickness, t
call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell)
call mpas_pool_get_array(meshPool, 'edgeSignOnCell', edgeSignOnCell)
+ !$omp do schedule(runtime) private(invAreaCell, i, iEdge, cell1, cell2, r_tmp, k, hhf_turb_flux, flux)
do iCell = 1, nCells
- invAreaCell = 1.0 / areaCell(iCell)
+ invAreaCell = 1.0_RKIND / areaCell(iCell)
do i = 1, nEdgesOncell(iCell)
iEdge = edgesOnCell(i, iCell)
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
r_tmp = meshScalingDel2(iEdge) * config_highFreqThick_del2 * dvEdge(iEdge) / dcEdge(iEdge)
-
+
do k = 1, maxLevelEdgeTop(iEdge)
! \nabla h^{hf} on edge
hhf_turb_flux = highFreqThickness(k,cell2) - highFreqThickness(k,cell1)
@@ -158,6 +159,7 @@ subroutine ocn_high_freq_thickness_hmix_del2_tend(meshPool, highFreqThickness, t
end do
end do
+ !$omp end do
end subroutine ocn_high_freq_thickness_hmix_del2_tend!}}}
@@ -168,10 +170,10 @@ end subroutine ocn_high_freq_thickness_hmix_del2_tend!}}}
!> \brief Initializes horizontal highFreqThickness mixing
!> \author Mark Petersen
!> \date July 2013
-!> \details
-!> This routine initializes the module for horizontal mixing of
+!> \details
+!> This routine initializes the module for horizontal mixing of
!> high frequency thickness
-!>
+!>
!
!-----------------------------------------------------------------------
diff --git a/src/core_ocean/shared/mpas_ocn_init_routines.F b/src/core_ocean/shared/mpas_ocn_init_routines.F
index 3dfab0cfb2..fc5fa881bc 100644
--- a/src/core_ocean/shared/mpas_ocn_init_routines.F
+++ b/src/core_ocean/shared/mpas_ocn_init_routines.F
@@ -33,7 +33,6 @@ module ocn_init_routines
use mpas_vector_reconstruction
use mpas_tracer_advection_helpers
- use ocn_time_average
use ocn_diagnostics
use ocn_gm
use ocn_constants
@@ -130,6 +129,7 @@ subroutine ocn_init_routines_compute_max_level(domain)!{{{
min( maxLevelCell(cellsOnEdge(1,iEdge)), &
maxLevelCell(cellsOnEdge(2,iEdge)) )
end do
+
maxLevelEdgeTop(nEdges+1) = 0
! maxLevelEdgeBot is the maximum (deepest) of the surrounding cells
@@ -138,6 +138,7 @@ subroutine ocn_init_routines_compute_max_level(domain)!{{{
max( maxLevelCell(cellsOnEdge(1,iEdge)), &
maxLevelCell(cellsOnEdge(2,iEdge)) )
end do
+
maxLevelEdgeBot(nEdges+1) = 0
! maxLevelVertexBot is the maximum (deepest) of the surrounding cells
@@ -149,6 +150,7 @@ subroutine ocn_init_routines_compute_max_level(domain)!{{{
maxLevelCell(cellsOnVertex(i,iVertex)))
end do
end do
+
maxLevelVertexBot(nVertices+1) = 0
! maxLevelVertexTop is the minimum (shallowest) of the surrounding cells
@@ -160,11 +162,14 @@ subroutine ocn_init_routines_compute_max_level(domain)!{{{
maxLevelCell(cellsOnVertex(i,iVertex)))
end do
end do
+
maxLevelVertexTop(nVertices+1) = 0
! set boundary edge
boundaryEdge(:,1:nEdges+1)=1
edgeMask(:,1:nEdges+1)=0
+
+
do iEdge = 1, nEdges
boundaryEdge(1:maxLevelEdgeTop(iEdge),iEdge)=0
edgeMask(1:maxLevelEdgeTop(iEdge),iEdge)=1
@@ -177,6 +182,8 @@ subroutine ocn_init_routines_compute_max_level(domain)!{{{
cellMask(:,1:nCells+1) = 0
boundaryVertex(:,1:nVertices+1) = 0
vertexMask(:,1:nVertices+1) = 0
+
+
do iEdge = 1, nEdges
do k = 1, nVertLevels
if (boundaryEdge(k,iEdge).eq.1) then
@@ -324,16 +331,23 @@ subroutine ocn_init_routines_compute_mesh_scaling(meshPool, scaleHmixWithMesh, m
!
! Compute the scaling factors to be used in the del2 and del4 dissipation
!
- meshScalingDel2(:) = 1.0
- meshScalingDel4(:) = 1.0
- meshScaling(:) = 1.0
+ ! Typical use cases have the minval(meshScaling)==1.
+ ! meshScaling values of approximately 1 indicate the highest resolution of the domain.
+
+ meshScalingDel2(:) = 1.0_RKIND
+ meshScalingDel4(:) = 1.0_RKIND
+ meshScaling(:) = 1.0_RKIND
+
if (scaleHmixWithMesh) then
do iEdge = 1, nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
- meshScalingDel2(iEdge) = 1.0 / ( ((meshDensity(cell1) + meshDensity(cell2) ) / 2.0) / maxMeshDensity)**(3.0 / 4.0) ! goes as dc**3
- meshScalingDel4(iEdge) = 1.0 / ( ((meshDensity(cell1) + meshDensity(cell2) ) / 2.0) / maxMeshDensity)**(3.0 / 4.0) ! goes as dc**3
- meshScaling(iEdge) = 1.0 / ( ((meshDensity(cell1) + meshDensity(cell2) ) / 2.0) / maxMeshDensity)**(1.0 / 4.0)
+ meshScalingDel2(iEdge) = 1.0_RKIND / ( ((meshDensity(cell1) + meshDensity(cell2) ) / 2.0_RKIND) &
+ / maxMeshDensity)**(3.0_RKIND / 4.0_RKIND) ! goes as dc**3
+ meshScalingDel4(iEdge) = 1.0_RKIND / ( ((meshDensity(cell1) + meshDensity(cell2) ) / 2.0_RKIND) &
+ / maxMeshDensity)**(3.0_RKIND / 4.0_RKIND) ! goes as dc**3
+ meshScaling(iEdge) = 1.0_RKIND / ( ((meshDensity(cell1) + meshDensity(cell2) ) / 2.0_RKIND) &
+ / maxMeshDensity)**(1.0_RKIND / 4.0_RKIND)
end do
end if
@@ -358,6 +372,7 @@ subroutine ocn_init_routines_vert_coord(domain)!{{{
type (mpas_pool_type), pointer :: statePool
type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: tracersPool
type (mpas_pool_type), pointer :: verticalMeshPool
type (dm_info) :: dminfo
@@ -372,24 +387,21 @@ subroutine ocn_init_routines_vert_coord(domain)!{{{
refBottomDepthTopOfCell, vertCoordMovementWeights, bottomDepth, refZMid, refLayerThickness
real (kind=RKIND), dimension(:), allocatable :: minBottomDepth, minBottomDepthMid, zMidZLevel
- real (kind=RKIND), dimension(:,:), pointer :: layerThickness, restingThickness
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers
- integer, pointer :: nVertLevels, nCells, num_tracers
+ real (kind=RKIND), dimension(:,:), pointer :: layerThickness
+ real (kind=RKIND), dimension(:,:,:), pointer :: tracersGroup
+ integer, pointer :: nVertLevels, nCells
logical :: consistentSSH
- real (kind=RKIND), pointer :: config_min_pbc_fraction
- logical, pointer :: config_do_restart, config_alter_ICs_for_pbcs, config_check_ssh_consistency
- logical, pointer :: config_check_zlevel_consistency, config_set_restingThickness_to_IC
- character (len=StrKIND), pointer :: config_vert_coord_movement, config_pbc_alteration_type
+ logical, pointer :: config_do_restart, config_check_ssh_consistency
+ logical, pointer :: config_check_zlevel_consistency
+ character (len=StrKIND), pointer :: config_vert_coord_movement
+
+ type (mpas_pool_iterator_type) :: groupItr
call mpas_pool_get_config(domain % configs, 'config_vert_coord_movement', config_vert_coord_movement)
call mpas_pool_get_config(domain % configs, 'config_do_restart', config_do_restart)
- call mpas_pool_get_config(domain % configs, 'config_alter_ICs_for_pbcs', config_alter_ICs_for_pbcs)
- call mpas_pool_get_config(domain % configs, 'config_pbc_alteration_type', config_pbc_alteration_type)
call mpas_pool_get_config(domain % configs, 'config_check_ssh_consistency', config_check_ssh_consistency)
call mpas_pool_get_config(domain % configs, 'config_check_zlevel_consistency', config_check_zlevel_consistency)
- call mpas_pool_get_config(domain % configs, 'config_min_pbc_fraction', config_min_pbc_fraction)
- call mpas_pool_get_config(domain % configs, 'config_set_restingThickness_to_IC', config_set_restingThickness_to_IC)
! Initialize z-level mesh variables from h, read in from input file.
block => domain % blocklist
@@ -397,9 +409,9 @@ subroutine ocn_init_routines_vert_coord(domain)!{{{
call mpas_pool_get_subpool(block % structs, 'state', statePool)
call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
call mpas_pool_get_subpool(block % structs, 'verticalMesh', verticalMeshPool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
- call mpas_pool_get_array(statePool, 'tracers', tracers, 1)
call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
call mpas_pool_get_array(meshPool, 'refBottomDepthTopOfCell', refBottomDepthTopOfCell)
@@ -407,141 +419,51 @@ subroutine ocn_init_routines_vert_coord(domain)!{{{
call mpas_pool_get_array(meshPool, 'vertCoordMovementWeights', vertCoordMovementWeights)
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
- call mpas_pool_get_array(verticalMeshPool, 'restingThickness', restingThickness)
call mpas_pool_get_array(verticalMeshPool, 'refZMid', refZMid)
call mpas_pool_get_array(verticalMeshPool, 'refLayerThickness', refLayerThickness)
call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
- call mpas_pool_get_dimension(statePool, 'num_tracers', num_tracers)
-
! TopOfCell needed where zero depth for the very top may be referenced.
- refBottomDepthTopOfCell(1) = 0.0
+ refBottomDepthTopOfCell(1) = 0.0_RKIND
do k = 1, nVertLevels
refBottomDepthTopOfCell(k+1) = refBottomDepth(k)
refLayerThickness(k) = refBottomDepth(k) - refBottomDepthTopOfCell(k)
- refZMid(k) = - refBottomDepthTopOfCell(k) - refLayerThickness(k)/2.0
+ refZMid(k) = - refBottomDepthTopOfCell(k) - refLayerThickness(k)/2.0_RKIND
end do
! Initialization of vertCoordMovementWeights. This determines how SSH perturbations
! are distributed throughout the column.
if (config_vert_coord_movement.eq.'fixed') then
- vertCoordMovementWeights = 0.0
- vertCoordMovementWeights(1) = 1.0
+ vertCoordMovementWeights = 0.0_RKIND
+ vertCoordMovementWeights(1) = 1.0_RKIND
elseif (config_vert_coord_movement.eq.'uniform_stretching') then
- vertCoordMovementWeights = 1.0
+ vertCoordMovementWeights = 1.0_RKIND
endif
- ! Initial condition files (ocean.nc, produced by basin) include a realistic
- ! bottomDepth variable and h,T,S variables for full thickness cells.
- ! If running with pbcs, set config_alter_ICs_for_pbc='zlevel_pbcs_on'. Then thin pbc cells
- ! will be changed, and h,T,S will be altered to match the pbcs.
- ! If running without pbcs, set config_alter_ICs_for_pbc='zlevel_pbcs_off'. Then
- ! bottomDepth will be altered so it is full cells everywhere.
- ! If your input file does not include bottomDepth, the false option will
- ! initialize bottomDepth correctly for a non-pbc run.
-
- if (.not. config_do_restart .and. config_alter_ICs_for_pbcs) then
-
- if (config_pbc_alteration_type .eq. 'partial_cell') then
-
- write (stdoutUnit,'(a)') ' Altering bottomDepth to avoid very thin cells.'
- write (stdoutUnit,'(a)') ' Altering layerThickness and tracer initial conditions to conform with partial bottom cells.'
-
- allocate(minBottomDepth(nVertLevels),minBottomDepthMid(nVertLevels),zMidZLevel(nVertLevels))
-
- ! min_pbc_fraction restricts pbcs from being too small.
- ! A typical value is 10%, so pbcs must occupy at least 10% of the cell thickness.
- ! If min_pbc_fraction = 0.0, bottomDepth gives the actual depth for that cell.
- ! If min_pbc_fraction = 1.0, bottomDepth reverts to discrete z-level depths, same
- ! as partial_bottom_cells = .false.
-
- minBottomDepth(1) = (1.0-config_min_pbc_fraction)*refBottomDepth(1)
- minBottomDepthMid(1) = 0.5*(minBottomDepth(1) + refBottomDepthTopOfCell(1))
- zMidZLevel(1) = - 0.5*(refBottomDepth(1) + refBottomDepthTopOfCell(1))
- do k = 2, nVertLevels
- minBottomDepth(k) = refBottomDepth(k) - (1.0-config_min_pbc_fraction)*(refBottomDepth(k) - refBottomDepth(k-1))
- minBottomDepthMid(k) = 0.5*(minBottomDepth(k) + refBottomDepthTopOfCell(k))
- zMidZLevel(k) = - 0.5*(refBottomDepth(k) + refBottomDepthTopOfCell(k))
- enddo
-
- do iCell = 1, nCells
-
- ! Change value of maxLevelCell for partial bottom cells
- k = maxLevelCell(iCell)
- if (bottomDepth(iCell) .lt. minBottomDepthMid(k)) then
- ! Round up to cell above
- maxLevelCell(iCell) = maxLevelCell(iCell) - 1
- bottomDepth(iCell) = refBottomDepth(maxLevelCell(iCell))
- elseif (bottomDepth(iCell) .lt. minBottomDepth(k)) then
- ! Round down cell to the min_pbc_fraction.
- bottomDepth(iCell) = minBottomDepth(k)
- endif
- ! reset k to new value of maxLevelCell
- k = maxLevelCell(iCell)
-
- ! Alter thickness of bottom level to account for PBC
- layerThickness(k,iCell) = bottomDepth(iCell) - refBottomDepthTopOfCell(k)
-
- ! Linearly interpolate the initial T&S for new location of bottom cell for PBCs
- zMidPBC = -0.5*(bottomDepth(iCell) + refBottomDepthTopOfCell(k))
- km1 = max(k-1,1)
- do iTracer = 1, num_tracers
- tracers(iTracer,k,iCell) = tracers(iTracer,k,iCell) &
- + (tracers(iTracer,km1,iCell) - tracers(iTracer,k,iCell)) &
- /(zMidZLevel(km1)-zMidZLevel(k)+1.0e-16) &
- *(zMidPBC - zMidZLevel(k))
- enddo
-
- enddo
-
- deallocate(minBottomDepth,zMidZLevel)
-
- elseif (config_pbc_alteration_type .eq. 'full_cell') then
-
- do iCell = 1,nCells
- bottomDepth(iCell) = refBottomDepth(maxLevelCell(iCell))
- enddo
-
- else
-
- write (stderrUnit,*) ' Incorrect choice of config_pbc_alteration_type.'
- call mpas_dmpar_abort(dminfo)
-
- endif
-
- endif ! .not.config_do_restart
-
- if (.not. config_do_restart) then
-
- ! Layer thickness when the ocean is at rest, i.e. without SSH or internal perturbations.
- ! This is applied only from the initial condition
- if (config_set_restingThickness_to_IC) then
- restingThickness = layerThickness
- endif
-
- endif ! .not.config_do_restart.and.config_alter_ICs_for_pbcs
-
if (config_check_ssh_consistency) then
consistentSSH = .true.
do iCell = 1,nCells
! Check if abs(ssh)>2m. If so, print warning.
- if (abs(sum(layerThickness(1:maxLevelCell(iCell),iCell))-bottomDepth(iCell))>2.0) then
+ if (abs(sum(layerThickness(1:maxLevelCell(iCell),iCell))-bottomDepth(iCell))>2.0_RKIND) then
consistentSSH = .false.
- write (stderrUnit,'(a)') ' Warning: abs(sum(h)-bottomDepth)>2m. Most likely, initial layerThickness does not match bottomDepth.'
+ write (stderrUnit,'(a)') ' Warning: abs(sum(h)-bottomDepth)>2m. Most likely, initial layerThickness ' &
+ // 'does not match bottomDepth.'
write (stderrUnit,*) ' iCell, K=maxLevelCell(iCell), bottomDepth(iCell),sum(h),bottomDepth: ', &
- iCell, maxLevelCell(iCell), bottomDepth(iCell),sum(layerThickness(1:maxLevelCell(iCell),iCell)),bottomDepth(iCell), &
+ iCell, maxLevelCell(iCell), bottomDepth(iCell), sum( &
+ layerThickness(1:maxLevelCell(iCell), iCell) ), bottomDepth(iCell), &
layerThickness(maxLevelCell(iCell),iCell)
endif
enddo
if (.not. consistentSSH) then
- write(stderrUnit,*) 'Warning: SSH is not consistent. Most likely, initial layerThickness does not match bottomDepth.'
+ write(stderrUnit,*) 'Warning: SSH is not consistent. Most likely, initial layerThickness ' &
+ // 'does not match bottomDepth.'
end if
endif ! config_check_ssh_consistency
@@ -554,9 +476,10 @@ subroutine ocn_init_routines_vert_coord(domain)!{{{
write (stderrUnit,'(a)') ' fatal error: bottomDepth and maxLevelCell do not match:'
write (stderrUnit,'(a,2i5,10f10.2)') ' iCell, maxLevelCell(iCell), bottomDepth(iCell): ', &
iCell, maxLevelCell(iCell), bottomDepth(iCell)
- write (stderrUnit,'(a,10f10.2)') ' refBottomDepth(maxLevelCell(iCell)), refBottomDepthTopOfCell(maxLevelCell(iCell)): ', &
+ write (stderrUnit,'(a,10f10.2)') ' refBottomDepth(maxLevelCell(iCell)), ' &
+ // 'refBottomDepthTopOfCell(maxLevelCell(iCell)): ', &
refBottomDepth(maxLevelCell(iCell)), refBottomDepthTopOfCell(maxLevelCell(iCell))
- call mpas_dmpar_abort(dminfo)
+ call mpas_dmpar_global_abort('MPAS-ocean: Abort: bottomDepth and maxLevelCell do not match')
endif
enddo
@@ -586,7 +509,7 @@ subroutine ocn_init_routines_block(block, dt, err)!{{{
real (kind=RKIND), intent(in) :: dt
integer, intent(out) :: err
- type (mpas_pool_type), pointer :: meshPool, averagePool, statePool
+ type (mpas_pool_type), pointer :: meshPool, statePool, tracersPool
type (mpas_pool_type), pointer :: forcingPool, diagnosticsPool, scratchPool
integer :: i, iEdge, iCell, k
integer :: err1
@@ -602,7 +525,7 @@ subroutine ocn_init_routines_block(block, dt, err)!{{{
real (kind=RKIND), dimension(:,:), pointer :: velocityZonal, velocityMeridional
real (kind=RKIND), dimension(:,:,:), pointer :: derivTwo
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+ real (kind=RKIND), dimension(:,:,:), pointer :: tracersGroup
integer, pointer :: nCells, nEdges, nVertices, nVertLevels
integer, pointer :: config_horiz_tracer_adv_order
@@ -610,6 +533,8 @@ subroutine ocn_init_routines_block(block, dt, err)!{{{
logical, pointer :: config_use_standardGM
real (kind=RKIND), pointer :: config_maxMeshDensity
+ type (mpas_pool_iterator_type) :: groupItr
+
call mpas_pool_get_dimension(block % dimensions, 'nCells', nCells)
call mpas_pool_get_dimension(block % dimensions, 'nEdges', nEdges)
call mpas_pool_get_dimension(block % dimensions, 'nVertices', nVertices)
@@ -620,7 +545,8 @@ subroutine ocn_init_routines_block(block, dt, err)!{{{
call mpas_pool_get_subpool(block % structs, 'forcing', forcingPool)
call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool)
call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool)
- call mpas_pool_get_subpool(block % structs, 'average', averagePool)
+
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
call mpas_pool_get_array(meshPool, 'derivTwo', derivTwo)
call mpas_pool_get_array(meshPool, 'advCoefs', advCoefs)
@@ -647,7 +573,6 @@ subroutine ocn_init_routines_block(block, dt, err)!{{{
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, 1)
call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, 1)
- call mpas_pool_get_array(statePool, 'tracers', tracers, 1)
call mpas_pool_get_config(block % configs, 'config_horiz_tracer_adv_order', config_horiz_tracer_adv_order)
call mpas_pool_get_config(block % configs, 'config_hmix_scaleWithMesh', config_hmix_scaleWithMesh)
@@ -664,37 +589,47 @@ subroutine ocn_init_routines_block(block, dt, err)!{{{
boundaryCell)
err = ior(err, err1)
- call ocn_time_average_init(averagePool)
-
if (.not. config_do_restart) then
do iCell=1,nCells
- boundaryLayerDepth(iCell) = layerThickness(1, iCell) * 0.5
+ boundaryLayerDepth(iCell) = layerThickness(1, iCell) * 0.5_RKIND
end do
end if
call mpas_timer_start("diagnostic solve")
- call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool)
+ call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, diagnosticsPool, scratchPool, tracersPool)
call mpas_timer_stop("diagnostic solve")
- ! initialize velocities and tracers on land to be zero.
- areaCell(nCells+1) = -1.0e34
+ ! initialize velocities and active tracers on land to be zero.
+ areaCell(nCells+1) = -1.0e34_RKIND
+
+ layerThickness(:, nCells+1) = 0.0_RKIND
- layerThickness(:, nCells+1) = 0.0
do iEdge=1, nEdges
- normalVelocity(maxLevelEdgeTop(iEdge)+1:maxLevelEdgeBot(iEdge), iEdge) = 0.0
+ normalVelocity(maxLevelEdgeTop(iEdge)+1:maxLevelEdgeBot(iEdge), iEdge) = 0.0_RKIND
- normalVelocity(maxLevelEdgeBot(iEdge)+1:nVertLevels,iEdge) = -1.0e34
+ normalVelocity(maxLevelEdgeBot(iEdge)+1:nVertLevels,iEdge) = -1.0e34_RKIND
end do
- do iCell=1,nCells
- tracers(:, maxLevelCell(iCell)+1:nVertLevels,iCell) = -1.0e34
+ call mpas_pool_begin_iteration(tracersPool)
+ do while ( mpas_pool_get_next_member(tracersPool, groupItr) )
+ if ( groupItr % memberType == MPAS_POOL_FIELD ) then
+ call mpas_pool_get_array(tracersPool, groupItr % memberName, tracersGroup, 1)
+ if ( associated(tracersGroup) ) then
+ do iCell=1,nCells
+ tracersGroup(:, maxLevelCell(iCell)+1:nVertLevels,iCell) = -1.0e34_RKIND
+ end do
+ end if
+ end if
end do
! ------------------------------------------------------------------
! Accumulating various parametrizations of the transport velocity
! ------------------------------------------------------------------
- normalTransportVelocity(:,:) = normalVelocity(:,:)
+ do iEdge = 1, nEdges
+ normalTransportVelocity(:, iEdge) = normalVelocity(:, iEdge)
+ end do
+
! Compute normalGMBolusVelocity, relativeSlope and RediDiffVertCoef if respective flags are turned on
if (config_use_standardGM) then
@@ -702,8 +637,11 @@ subroutine ocn_init_routines_block(block, dt, err)!{{{
end if
if (config_use_standardGM) then
- normalTransportVelocity(:,:) = normalTransportVelocity(:,:) + normalGMBolusVelocity(:,:)
+ do iEdge = 1, nEdges
+ normalTransportVelocity(:, iEdge) = normalTransportVelocity(:, iEdge) + normalGMBolusVelocity(:, iEdge)
+ end do
end if
+
! ------------------------------------------------------------------
! End: Accumulating various parametrizations of the transport velocity
! ------------------------------------------------------------------
@@ -713,7 +651,7 @@ subroutine ocn_init_routines_block(block, dt, err)!{{{
call mpas_rbf_interp_initialize(meshPool)
call mpas_initialize_tangent_vectors(meshPool, edgeTangentVectors)
- call mpas_init_reconstruct(meshPool)
+ call mpas_init_reconstruct(meshPool, includeHalos=.true.)
call mpas_reconstruct(meshPool, normalVelocity, &
velocityX, &
diff --git a/src/core_ocean/shared/mpas_ocn_sea_ice.F b/src/core_ocean/shared/mpas_ocn_sea_ice.F
index 2b8b077c28..d8e8939a77 100644
--- a/src/core_ocean/shared/mpas_ocn_sea_ice.F
+++ b/src/core_ocean/shared/mpas_ocn_sea_ice.F
@@ -64,7 +64,7 @@ module ocn_sea_ice
!> \brief Performs the formation of Sea Ice within the ocean.
!> \author Doug Jacobsen
!> \date 08/19/2013
-!> \details
+!> \details
!> ocn_sea_ice_formation performs the adjustment of tracer values
!> and layerThickness based on the formation of frazil ice within the ocean.
!
@@ -117,7 +117,6 @@ subroutine ocn_sea_ice_formation(meshPool, indexTemperature, indexSalinity, laye
real (kind=RKIND) :: referenceSalinity, iceSalinity
real (kind=RKIND) :: freezingTemp, density_ice
real (kind=RKIND), dimension(:), allocatable :: iceTracer
- real (kind=RKIND), pointer :: config_density0
if(.not. frazilFormationOn) return
@@ -126,15 +125,17 @@ subroutine ocn_sea_ice_formation(meshPool, indexTemperature, indexSalinity, laye
call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
nTracers = size(tracers, dim=1)
- call mpas_pool_get_config(ocnConfigs, 'config_density0', config_density0)
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
allocate(iceTracer(nTracers))
iceTracer = 0.0_RKIND
iceTracer(indexSalinity) = sea_ice_salinity * ppt_to_salt
+
density_ice = rho_ice
+ !$omp do schedule(runtime) private(maxLevel, netEnergyChange, k, freezingTemp, availableEnergyChange, energyChange, &
+ !$omp temperatureChange, thicknessChange, iceThicknessChange, iTracer)
do iCell = 1, nCellsSolve ! Check performance of these two loop definitions
! do iCell = nCellsSolve, 1, -1
maxLevel = min(maxLevelCell(iCell), verticalLevelCap)
@@ -146,7 +147,7 @@ subroutine ocn_sea_ice_formation(meshPool, indexTemperature, indexSalinity, laye
! availableEnergyChange is:
! positive when frazil ice is formed
! negative when frazil ice can be melted
- availableEnergyChange = config_density0 * cp_sw * layerThickness(k, iCell) &
+ availableEnergyChange = rho_sw * cp_sw * layerThickness(k, iCell) &
* (freezingTemp - tracers(indexTemperature, k, iCell))
! energyChange is capped when negative.
@@ -155,9 +156,9 @@ subroutine ocn_sea_ice_formation(meshPool, indexTemperature, indexSalinity, laye
energyChange = max(availableEnergyChange, -netEnergyChange)
! Compute temperature change in ocean cell due to energy change
- temperatureChange = energyChange / ( config_density0 * cp_sw * layerThickness(k, iCell) )
+ temperatureChange = energyChange / ( rho_sw * cp_sw * layerThickness(k, iCell) )
! Compute thickness change in ocean cell due to energy change
- thicknessChange = energyChange / ( config_density0 * latent_heat_fusion_mks )
+ thicknessChange = energyChange / ( rho_sw * latent_heat_fusion_mks )
! Compute thickness change in sea ice due to energy change
iceThicknessChange = energyChange / ( density_ice * latent_heat_fusion_mks )
@@ -165,11 +166,11 @@ subroutine ocn_sea_ice_formation(meshPool, indexTemperature, indexSalinity, laye
do iTracer = 1, nTracers
if(iTracer /= indexTemperature) then
! computed as:
- ! \rho_{ocn} h_{ocn}^{pre} \theta_{ocn}^{pre} =
+ ! \rho_{ocn} h_{ocn}^{pre} \theta_{ocn}^{pre} =
! \rho_{ocn}^{new} h_{ocn}^{new} \theta_{ocn}^{new} = \rho_{si} h_{si} \theta_{si}
- tracers(iTracer, k, iCell) = ( config_density0 * layerThickness(k,iCell) * tracers(iTracer, k, iCell) &
+ tracers(iTracer, k, iCell) = ( rho_sw * layerThickness(k,iCell) * tracers(iTracer, k, iCell) &
- density_ice * iceThicknessChange * iceTracer(iTracer)) / &
- (config_density0 * (layerThickness(k,iCell) + thicknessChange))
+ (rho_sw * (layerThickness(k,iCell) + thicknessChange))
end if
end do
@@ -197,7 +198,7 @@ subroutine ocn_sea_ice_formation(meshPool, indexTemperature, indexSalinity, laye
! availableEnergyChange is:
! positive when frazil ice is formed
! negative when frazil ice can be melted
- availableEnergyChange = config_density0 * cp_sw * layerThickness(k, iCell) &
+ availableEnergyChange = rho_sw * cp_sw * layerThickness(k, iCell) &
* (freezingTemp - tracers(indexTemperature, k, iCell))
! energyChange is capped when negative.
@@ -207,9 +208,9 @@ subroutine ocn_sea_ice_formation(meshPool, indexTemperature, indexSalinity, laye
energyChange = max(availableEnergyChange, -seaIceEnergy(iCell))
! Compute temperature change in ocean cell due to energy change
- temperatureChange = energyChange / ( config_density0 * cp_sw * layerThickness(k, iCell) )
+ temperatureChange = energyChange / ( rho_sw * cp_sw * layerThickness(k, iCell) )
! Compute thickness change in ocean cell due to energy change
- thicknessChange = energyChange / ( config_density0 * latent_heat_fusion_mks )
+ thicknessChange = energyChange / ( rho_sw * latent_heat_fusion_mks )
! Compute thickness change in sea ice due to energy change
iceThicknessChange = energyChange / ( density_ice * latent_heat_fusion_mks )
@@ -217,11 +218,11 @@ subroutine ocn_sea_ice_formation(meshPool, indexTemperature, indexSalinity, laye
do iTracer = 1, nTracers
if(iTracer /= indexTemperature) then
! computed as:
- ! \rho_{ocn} h_{ocn}^{pre} \theta_{ocn}^{pre} =
+ ! \rho_{ocn} h_{ocn}^{pre} \theta_{ocn}^{pre} =
! \rho_{ocn}^{new} h_{ocn}^{new} \theta_{ocn}^{new} = \rho_{si} h_{si} \theta_{si}
- tracers(iTracer, k, iCell) = ( config_density0 * layerThickness(k,iCell) * tracers(iTracer, k, iCell) &
+ tracers(iTracer, k, iCell) = ( rho_sw * layerThickness(k,iCell) * tracers(iTracer, k, iCell) &
- density_ice * iceThicknessChange * iceTracer(iTracer)) / &
- (config_density0 * (layerThickness(k,iCell) + thicknessChange))
+ (rho_sw * (layerThickness(k,iCell) + thicknessChange))
end if
end do
@@ -235,30 +236,12 @@ subroutine ocn_sea_ice_formation(meshPool, indexTemperature, indexSalinity, laye
seaIceEnergy(iCell) = seaIceEnergy(iCell) + energyChange
end if
end do
+ !$omp end do
deallocate(iceTracer)
end subroutine ocn_sea_ice_formation!}}}
-!***********************************************************************
-!
-! function ocn_freezing_temperature
-!
-!> \brief Computes the freezing temperature of the ocean.
-!> \author Doug Jacobsen
-!> \date 08/29/2013
-!> \details
-!> This routine computes the freezing temperature of the ocean at a given
-!> salinity value.
-!
-!-----------------------------------------------------------------------
- real (kind=RKIND) function ocn_freezing_temperature(salinity)!{{{
- real (kind=RKIND) :: salinity !< Input: Salinity value of water for freezing temperature
-
- ocn_freezing_temperature = -1.8
- end function ocn_freezing_temperature!}}}
-
-
!***********************************************************************
!
! routine ocn_sea_ice_init
@@ -266,7 +249,7 @@ end function ocn_freezing_temperature!}}}
!> \brief Initializes ocean sea ice module.
!> \author Doug Jacobsen
!> \date 08/19/2013
-!> \details
+!> \details
!> This routine initializes the ocean sea ice module and variables..
!
!-----------------------------------------------------------------------
@@ -276,16 +259,16 @@ subroutine ocn_sea_ice_init(nVertLevels, err)!{{{
integer, intent(in) :: nVertLevels !< Input: Number of vertical levels suggested for level cap
integer, intent(out) :: err !< Output: error flag
- logical, pointer :: config_frazil_ice_formation, config_monotonic
+ logical, pointer :: config_use_frazil_ice_formation, config_monotonic
err = 0
- call mpas_pool_get_config(ocnConfigs, 'config_frazil_ice_formation', config_frazil_ice_formation)
+ call mpas_pool_get_config(ocnConfigs, 'config_use_frazil_ice_formation', config_use_frazil_ice_formation)
call mpas_pool_get_config(ocnConfigs, 'config_monotonic', config_monotonic)
frazilFormationOn = .false.
- if(config_frazil_ice_formation) then
+ if(config_use_frazil_ice_formation) then
frazilFormationOn = .true.
end if
diff --git a/src/core_ocean/shared/mpas_ocn_surface_bulk_forcing.F b/src/core_ocean/shared/mpas_ocn_surface_bulk_forcing.F
new file mode 100644
index 0000000000..62e442555e
--- /dev/null
+++ b/src/core_ocean/shared/mpas_ocn_surface_bulk_forcing.F
@@ -0,0 +1,461 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_surface_bulk_forcing
+!
+!> \brief MPAS ocean bulk forcing
+!> \author Doug Jacobsen
+!> \date 04/25/12
+!> \details
+!> This module contains routines for building the forcing arrays,
+!> if bulk forcing is used.
+!
+!-----------------------------------------------------------------------
+
+module ocn_surface_bulk_forcing
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_timekeeping
+ use ocn_constants
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_surface_bulk_forcing_tracers, &
+ ocn_surface_bulk_forcing_vel, &
+ ocn_surface_bulk_forcing_thick, &
+ ocn_surface_bulk_forcing_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: bulkWindStressOn, bulkThicknessFluxOn
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_surface_bulk_forcing_tracers
+!
+!> \brief Determines the tracers forcing array used for the bulk forcing.
+!> \author Doug Jacobsen
+!> \date 04/25/12
+!> \details
+!> This routine computes the tracers forcing arrays used later in MPAS.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_surface_bulk_forcing_tracers(meshPool, groupName, forcingPool, tracerGroup, &
+ tracersSurfaceFlux, tracersSurfaceFluxRunoff, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(in) :: meshPool !< Input: mesh information
+ character (len=*) :: groupName !< Input: Name of tracer group
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(inout) :: forcingPool !< Input: Forcing information
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: tracerGroup
+ real (kind=RKIND), dimension(:,:), intent(inout) :: tracersSurfaceFlux !< Input/Output: Surface flux for tracer group
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ tracersSurfaceFluxRunoff !< Input/Output: Surface flux for tracer group due to river runoff
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ if ( trim(groupName) == 'activeTracers' ) then
+ call ocn_surface_bulk_forcing_active_tracers(meshPool, forcingPool, tracerGroup, &
+ tracersSurfaceFlux, tracersSurfaceFluxRunoff, err)
+ end if
+
+ end subroutine ocn_surface_bulk_forcing_tracers!}}}
+
+!***********************************************************************
+!
+! routine ocn_surface_bulk_forcing_vel
+!
+!> \brief Determines the velocity forcing array used for the bulk forcing.
+!> \author Doug Jacobsen
+!> \date 04/25/12
+!> \details
+!> This routine computes the velocity forcing arrays used later in MPAS.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_surface_bulk_forcing_vel(meshPool, forcingPool, surfaceStress, surfaceStressMagnitude, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(in) :: meshPool !< Input: mesh information
+ type (mpas_pool_type), intent(in) :: forcingPool !< Input: Forcing information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(:), intent(inout) :: surfaceStress, & !< Input/Output: Array for surface stress
+ surfaceStressMagnitude !< Input/Output: Array for magnitude of surface stress
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iEdge, cell1, cell2, iCell
+ integer, pointer :: nCells, nEdges
+
+ integer, dimension(:,:), pointer :: cellsOnEdge
+
+ real (kind=RKIND) :: meridionalAverage, zonalAverage
+ real (kind=RKIND), dimension(:), pointer :: angleEdge
+ real (kind=RKIND), dimension(:), pointer :: windStressZonal, windStressMeridional
+
+ err = 0
+
+ if ( .not. bulkWindStressOn ) return
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+
+ call mpas_pool_get_array(meshPool, 'angleEdge', angleEdge)
+ call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
+
+ call mpas_pool_get_array(forcingPool, 'windStressZonal', windStressZonal)
+ call mpas_pool_get_array(forcingPool, 'windStressMeridional', windStressMeridional)
+
+ ! Convert CESM wind stress to MPAS-O wind stress
+ !$omp do schedule(runtime) private(cell1, cell2, zonalAverage, meridionalAverage)
+ do iEdge = 1, nEdges
+ cell1 = cellsOnEdge(1, iEdge)
+ cell2 = cellsOnEdge(2, iEdge)
+
+ zonalAverage = 0.5_RKIND * (windStressZonal(cell1) + windStressZonal(cell2))
+ meridionalAverage = 0.5_RKIND * (windStressMeridional(cell1) + windStressMeridional(cell2))
+
+ surfaceStress(iEdge) = surfaceStress(iEdge) + cos(angleEdge(iEdge)) * zonalAverage + sin(angleEdge(iEdge)) &
+ * meridionalAverage
+ end do
+ !$omp end do
+
+ ! Build surface fluxes at cell centers
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ surfaceStressMagnitude(iCell) = surfaceStressMagnitude(iCell) + sqrt( windStressZonal(iCell)**2 &
+ + windStressMeridional(iCell)**2 )
+ end do
+ !$omp end do
+
+ end subroutine ocn_surface_bulk_forcing_vel!}}}
+
+!***********************************************************************
+!
+! routine ocn_surface_bulk_forcing_thick
+!
+!> \brief Determines the thickness forcing array used for the bulk forcing.
+!> \author Doug Jacobsen
+!> \date 04/25/12
+!> \details
+!> This routine computes the thickness forcing arrays used later in MPAS.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_surface_bulk_forcing_thick(meshPool, forcingPool, surfaceThicknessFlux, surfaceThicknessFluxRunoff, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(in) :: meshPool !< Input: mesh information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(inout) :: forcingPool !< Input: Forcing information
+ real (kind=RKIND), dimension(:), intent(inout) :: surfaceThicknessFlux !< Input/Output: Array for surface thickness flux
+ real (kind=RKIND), dimension(:), intent(inout) :: &
+ surfaceThicknessFluxRunoff !< Input/Output: Array for surface thickness flux due to river runoff
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iCell
+ integer, pointer :: nCells, nEdges
+
+ integer, dimension(:,:), pointer :: cellsOnEdge
+
+ real (kind=RKIND), dimension(:), pointer :: evaporationFlux, snowFlux
+ real (kind=RKIND), dimension(:), pointer :: seaIceFreshWaterFlux, riverRunoffFlux, iceRunoffFlux
+ real (kind=RKIND), dimension(:), pointer :: rainFlux
+
+ err = 0
+
+ if ( .not. bulkThicknessFluxOn ) return
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_array(forcingPool, 'evaporationFlux', evaporationFlux)
+ call mpas_pool_get_array(forcingPool, 'snowFlux', snowFlux)
+ call mpas_pool_get_array(forcingPool, 'seaIceFreshWaterFlux', seaIceFreshWaterFlux)
+ call mpas_pool_get_array(forcingPool, 'riverRunoffFlux', riverRunoffFlux)
+ call mpas_pool_get_array(forcingPool, 'iceRunoffFlux', iceRunoffFlux)
+ call mpas_pool_get_array(forcingPool, 'rainFlux', rainFlux)
+
+
+ ! Build surface fluxes at cell centers
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ surfaceThicknessFlux(iCell) = surfaceThicknessFlux(iCell) + ( snowFlux(iCell) + rainFlux(iCell) + evaporationFlux(iCell) &
+ + seaIceFreshWaterFlux(iCell) + iceRunoffFlux(iCell) ) / rho_sw
+ surfaceThicknessFluxRunoff(iCell) = riverRunoffFlux(iCell) / rho_sw
+ end do
+ !$omp end do
+
+ end subroutine ocn_surface_bulk_forcing_thick!}}}
+
+!***********************************************************************
+!
+! routine ocn_surface_bulk_forcing_init
+!
+!> \brief Initializes bulk forcing module
+!> \author Doug Jacobsen
+!> \date 04/25/12
+!> \details
+!> This routine initializes the bulk forcing module.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_surface_bulk_forcing_init(err)!{{{
+
+ integer, intent(out) :: err !< Output: error flag
+
+ logical, pointer :: config_use_bulk_wind_stress, config_use_bulk_thickness_flux
+
+ err = 0
+
+ call mpas_pool_get_config(ocnConfigs, 'config_use_bulk_wind_stress', config_use_bulk_wind_stress)
+ call mpas_pool_get_config(ocnConfigs, 'config_use_bulk_thickness_flux', config_use_bulk_thickness_flux)
+
+ bulkWindStressOn = config_use_bulk_wind_stress
+ bulkThicknessFluxOn = config_use_bulk_thickness_flux
+
+ end subroutine ocn_surface_bulk_forcing_init!}}}
+
+!***********************************************************************
+!
+! Private module subroutines
+!
+!***********************************************************************
+
+
+!***********************************************************************
+!
+! routine ocn_surface_bulk_forcing_active_tracers
+!
+!> \brief Determines the active tracers forcing array used for the bulk forcing.
+!> \author Doug Jacobsen
+!> \date 04/25/12
+!> \details
+!> This routine computes the active tracers forcing arrays used later in MPAS.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_surface_bulk_forcing_active_tracers(meshPool, forcingPool, tracerGroup, &
+ tracersSurfaceFlux, tracersSurfaceFluxRunoff, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(in) :: meshPool !< Input: mesh information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(inout) :: forcingPool !< Input: Forcing information
+ real (kind=RKIND), dimension(:,:), intent(inout) :: tracersSurfaceFlux
+ real (kind=RKIND), dimension(:,:), intent(inout) :: tracersSurfaceFluxRunoff
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: tracerGroup
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iCell
+ integer, pointer :: index_temperature_flux, index_salinity_flux
+ integer, pointer :: nCells
+
+ type(mpas_pool_type),pointer :: tracersSurfaceFluxPool
+
+ real (kind=RKIND), dimension(:), pointer :: latentHeatFlux, sensibleHeatFlux, longWaveHeatFluxUp, longWaveHeatFluxDown, &
+ seaIceHeatFlux, evaporationFlux, riverRunoffFlux
+ real (kind=RKIND), dimension(:), pointer :: seaIceFreshWaterFlux, seaIceSalinityFlux, iceRunoffFlux
+ real (kind=RKIND), dimension(:), pointer :: shortWaveHeatFlux, penetrativeTemperatureFlux
+ real (kind=RKIND), dimension(:), pointer :: snowFlux, rainFlux
+
+ err = 0
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_subpool(forcingPool, 'tracersSurfaceFlux',tracersSurfaceFluxPool)
+
+ call mpas_pool_get_dimension(tracersSurfaceFluxPool, 'index_temperatureSurfaceFlux', index_temperature_flux)
+ call mpas_pool_get_dimension(tracersSurfaceFluxPool, 'index_salinitySurfaceFlux', index_salinity_flux)
+
+ call mpas_pool_get_array(forcingPool, 'latentHeatFlux', latentHeatFlux)
+ call mpas_pool_get_array(forcingPool, 'sensibleHeatFlux', sensibleHeatFlux)
+ call mpas_pool_get_array(forcingPool, 'longWaveHeatFluxUp', longWaveHeatFluxUp)
+ call mpas_pool_get_array(forcingPool, 'longWaveHeatFluxDown', longWaveHeatFluxDown)
+ call mpas_pool_get_array(forcingPool, 'seaIceHeatFlux', seaIceHeatFlux)
+ call mpas_pool_get_array(forcingPool, 'rainFlux', rainFlux)
+ call mpas_pool_get_array(forcingPool, 'snowFlux', snowFlux)
+ call mpas_pool_get_array(forcingPool, 'shortWaveHeatFlux', shortWaveHeatFlux)
+ call mpas_pool_get_array(forcingPool, 'evaporationFlux', evaporationFlux)
+
+ call mpas_pool_get_array(forcingPool, 'seaIceFreshWaterFlux', seaIceFreshWaterFlux)
+ call mpas_pool_get_array(forcingPool, 'seaIceSalinityFlux', seaIceSalinityFlux)
+ call mpas_pool_get_array(forcingPool, 'iceRunoffFlux', iceRunoffFlux)
+ call mpas_pool_get_array(forcingPool, 'riverRunoffFlux', riverRunoffFlux)
+ call mpas_pool_get_array(forcingPool, 'penetrativeTemperatureFlux', penetrativeTemperatureFlux)
+
+ ! Build surface fluxes at cell centers
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ tracersSurfaceFlux(index_temperature_flux, iCell) = tracersSurfaceFlux(index_temperature_flux, iCell) &
+ + (latentHeatFlux(iCell) + sensibleHeatFlux(iCell) &
+ + longWaveHeatFluxUp(iCell) + longWaveHeatFluxDown(iCell) &
+ + seaIceHeatFlux(iCell) - (snowFlux(iCell) + iceRunoffFlux(iCell)) &
+ * latent_heat_fusion_mks) * hflux_factor
+
+ tracersSurfaceFlux(index_salinity_flux, iCell) = tracersSurfaceFlux(index_salinity_flux, iCell) &
+ + seaIceSalinityFlux(iCell) * sflux_factor
+ end do
+ !$omp end do
+ ! assume that snow comes in at 0 C
+
+ ! Surface fluxes of water have an associated heat content, but the coupled system does not account for this
+ ! Assume surface fluxes of water have a temperature dependent on the incoming mass flux.
+ ! Assume surface fluxes of water have zero salinity. So the RHS forcing is zero for salinity.
+ ! Only include this heat forcing when bulk thickness is turned on
+ ! indices on tracerGroup are (iTracer, iLevel, iCell)
+ if (bulkThicknessFluxOn) then
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+
+ ! Accumulate fluxes that use the surface temperature
+ tracersSurfaceFlux(index_temperature_flux, iCell) = tracersSurfaceFlux(index_temperature_flux, iCell) &
+ + (rainFlux(iCell) + evaporationFlux(iCell)) * tracerGroup(index_temperature_flux,1,iCell) / rho_sw
+
+ tracersSurfaceFluxRunoff(index_temperature_flux,iCell) = riverRunoffFlux(iCell) * &
+ tracerGroup(index_temperature_flux,1,iCell)/rho_sw
+ ! Accumulate fluxes that use the freezing point
+ tracersSurfaceFlux(index_temperature_flux, iCell) = tracersSurfaceFlux(index_temperature_flux, iCell) &
+ + seaIceFreshWaterFlux(iCell) * ocn_freezing_temperature( tracerGroup(index_salinity_flux, 1, iCell) ) / rho_sw
+
+ ! Fields with zero temperature are not accumulated. These include:
+ ! snowFlux
+ ! iceRunoffFlux
+
+ end do
+ !$omp end do
+ endif ! bulkThicknessFluxOn
+
+ ! convert short wave heat flux to a temperature flux
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ penetrativeTemperatureFlux(iCell) = shortWaveHeatFlux(iCell) * hflux_factor
+ end do
+ !$omp end do
+
+ end subroutine ocn_surface_bulk_forcing_active_tracers!}}}
+
+end module ocn_surface_bulk_forcing
+
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_surface_land_ice_fluxes.F b/src/core_ocean/shared/mpas_ocn_surface_land_ice_fluxes.F
new file mode 100644
index 0000000000..6832e0c75a
--- /dev/null
+++ b/src/core_ocean/shared/mpas_ocn_surface_land_ice_fluxes.F
@@ -0,0 +1,936 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_surface_land_ice_fluxes
+!
+!> \brief MPAS ocean surface land-ice fluxes
+!> \author Xylar Asay-Davis
+!> \date 10/02/2014
+!> \details
+!> This module contains routines for computing surface flux related
+!> melting under land-ice.
+!
+!-----------------------------------------------------------------------
+
+module ocn_surface_land_ice_fluxes
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+
+ use ocn_constants
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_surface_land_ice_fluxes_tracers, &
+ ocn_surface_land_ice_fluxes_vel, &
+ ocn_surface_land_ice_fluxes_thick, &
+ ocn_surface_land_ice_fluxes_build_arrays, &
+ ocn_surface_land_ice_fluxes_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: landIceFluxesOn, standaloneOn, isomipOn, jenkinsOn, hollandJenkinsOn
+
+ real (kind=RKIND) :: Tf0, dTf_dp, dTf_dS, cp_land_ice, rho_land_ice
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_surface_land_ice_fluxes_tracers
+!
+!> \brief Determines the tracers melt fluxes under land ice
+!> \author Xylar Asay-Davis
+!> \date 9 September 2015
+!> \details
+!> This routine adds land-ice tracer fluxes to the surface flux array
+!> used to compute tracer tendencies later in MPAS.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_surface_land_ice_fluxes_tracers(meshPool, groupName, forcingPool, tracersSurfaceFlux, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(in) :: meshPool !< Input: mesh information
+ character (len=*) :: groupName !< Input: Name of tracer group
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(inout) :: forcingPool !< Input: Forcing information
+ real (kind=RKIND), dimension(:,:), intent(inout) :: tracersSurfaceFlux !< Input/Output: Surface flux for tracer group
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ if ( .not. landIceFluxesOn ) return
+
+ if ( trim(groupName) == 'activeTracers' ) then
+ call ocn_surface_land_ice_fluxes_active_tracers(meshPool, forcingPool, tracersSurfaceFlux, err)
+ end if
+
+ end subroutine ocn_surface_land_ice_fluxes_tracers!}}}
+
+!***********************************************************************
+!
+! routine ocn_surface_land_ice_fluxes_vel
+!
+!> \brief Computes tendency term for top drag
+!> \author Xylar Asay-Davis
+!> \date 9 September 2015
+!> \details
+!> This routine computes the top-drag tendency for momentum
+!> based on current state.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_surface_land_ice_fluxes_vel(meshPool, diagnosticsPool, surfaceStress, surfaceStressMagnitude, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(in) :: meshPool !< Input: mesh information
+ type (mpas_pool_type), intent(in) :: diagnosticsPool !< Input: Diagnostics information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+ real (kind=RKIND), dimension(:), intent(inout) :: surfaceStress, & !< Input/Output: Array for total surface stress
+ surfaceStressMagnitude !< Input/Output: Array for magnitude of surface stress
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+ integer :: iEdge, iCell
+ integer, pointer :: nCells, nEdges
+
+ real (kind=RKIND), dimension(:), pointer :: topDrag, topDragMagnitude
+
+ err = 0
+
+ if ( .not. landIceFluxesOn ) return
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+
+ call mpas_pool_get_array(diagnosticsPool, 'topDrag', topDrag)
+ call mpas_pool_get_array(diagnosticsPool, 'topDragMagnitude', topDragMagnitude)
+
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ surfaceStress(iEdge) = surfaceStress(iEdge) + topDrag(iEdge)
+ end do
+ !$omp end do
+
+ ! Build surface stress magnitude at cell centers
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ surfaceStressMagnitude(iCell) = surfaceStressMagnitude(iCell) + topDragMagnitude(iCell)
+ end do
+ !$omp end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_surface_land_ice_fluxes_vel!}}}
+
+!***********************************************************************
+!
+! routine ocn_surface_land_ice_fluxes_thick
+!
+!> \brief Add land-ice fluxes to surfaceThicknessFlux.
+!> \author Xylar Asay-Davis
+!> \date 11 September 2015
+!> \details
+!> This routine adds land-ice freshwater fluxes to the surface thickness flux
+!> to be converted into a thickness tendency later.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_surface_land_ice_fluxes_thick(meshPool, forcingPool, surfaceThicknessFlux, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(in) :: meshPool !< Input: mesh information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(inout) :: forcingPool !< Input: Forcing information
+ real (kind=RKIND), dimension(:), intent(inout) :: surfaceThicknessFlux !< Input/Output: Array for surface thickness flux
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iCell
+ integer, pointer :: nCells
+
+ real (kind=RKIND), dimension(:), pointer :: landIceFreshwaterFlux
+
+ err = 0
+
+ if ( .not. landIceFluxesOn ) return
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_array(forcingPool, 'landIceFreshwaterFlux', landIceFreshwaterFlux)
+
+ ! Build surface fluxes at cell centers
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ surfaceThicknessFlux(iCell) = surfaceThicknessFlux(iCell) + landIceFreshwaterFlux(iCell) / rho_sw
+ end do
+ !$omp end do
+
+ end subroutine ocn_surface_land_ice_fluxes_thick!}}}
+
+!***********************************************************************
+!
+! routine ocn_surface_land_ice_fluxes_active_tracers
+!
+!> \brief Adds the active tracers fluxes from land-ice melting.
+!> \author Xylar Asay-Davis
+!> \date 11 September 2015
+!> \details
+!> This routine adds the active tracers fluxes to surface fluxes
+!> from which tracer tendencies are computed later.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_surface_land_ice_fluxes_active_tracers(meshPool, forcingPool, tracersSurfaceFlux, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(in) :: meshPool !< Input: mesh information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(inout) :: forcingPool !< Input: Forcing information
+ real (kind=RKIND), dimension(:,:), intent(inout) :: tracersSurfaceFlux
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iCell
+ integer, pointer :: nCells
+
+ real (kind=RKIND), dimension(:), pointer :: landIceHeatFlux
+
+ err = 0
+
+ if ( .not. landIceFluxesOn ) return
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_array(forcingPool, 'landIceHeatFlux', landIceHeatFlux)
+
+ ! add to surface fluxes at cell centers
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ tracersSurfaceFlux(1, iCell) = tracersSurfaceFlux(1, iCell) + landIceHeatFlux(iCell)/(rho_sw*cp_sw)
+ end do
+ !$omp end do
+
+ end subroutine ocn_surface_land_ice_fluxes_active_tracers!}}}
+
+
+!***********************************************************************
+!
+! routine ocn_surface_land_ice_fluxes_build_arrays
+!
+!> \brief Builds the forcing array for land-ice forcing
+!> \author Xylar Asay-Davis
+!> \date 10/02/2014
+!> \details
+!> This routine computes surface fluxes related to land-ice forcing based
+!> on diagnostics from the previous time step.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_surface_land_ice_fluxes_build_arrays(meshPool, diagnosticsPool, &
+ forcingPool, scratchPool, err) !{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mpas_pool_type), intent(in) :: &
+ meshPool, & !< Input: mesh information
+ diagnosticsPool !< Input: diagnostics information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+ type (mpas_pool_type), intent(inout) :: &
+ forcingPool, & !< Input: Forcing information
+ scratchPool !< Input: scratch field information
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mpas_pool_type), pointer :: tracersPool
+
+ integer :: iCell
+ integer, pointer :: nCellsSolve
+
+ real (kind=RKIND), pointer :: config_land_ice_flux_ISOMIP_gammaT
+
+ logical, pointer :: config_land_ice_flux_useHollandJenkinsAdvDiff
+
+
+ real (kind=RKIND) :: freshwaterFlux, heatFlux
+
+ real (kind=RKIND), dimension(:), pointer :: seaSurfacePressure, landIceFraction, &
+ landIceSurfaceTemperature, &
+ landIceFrictionVelocity, &
+ landIceFreshwaterFlux, &
+ landIceHeatFlux, heatFluxToLandIce, &
+ freezeInterfaceSalinity, freezeInterfaceTemperature, &
+ freezeFreshwaterFlux, freezeHeatFlux, &
+ freezeIceHeatFlux
+
+ real (kind=RKIND), dimension(:,:), pointer :: landIceBoundaryLayerTracers, &
+ landIceInterfaceTracers, &
+ landIceTracerTransferVelocities
+ integer, pointer :: indexBLT, indexBLS, indexIT, indexIS, indexHeatTrans, indexSaltTrans
+
+ type (field1DReal), pointer :: boundaryLayerTemperatureField, boundaryLayerSalinityField, &
+ freezeInterfaceSalinityField, freezeInterfaceTemperatureField, &
+ freezeFreshwaterFluxField, freezeHeatFluxField, &
+ freezeIceHeatFluxField
+
+ err = 0
+
+ if ( .not. standaloneOn ) return
+
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_ISOMIP_gammaT', config_land_ice_flux_ISOMIP_gammaT)
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_useHollandJenkinsAdvDiff', &
+ config_land_ice_flux_useHollandJenkinsAdvDiff)
+
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+
+ call mpas_pool_get_array(diagnosticsPool, 'landIceFrictionVelocity', landIceFrictionVelocity)
+
+ call mpas_pool_get_array(forcingPool, 'seaSurfacePressure', seaSurfacePressure)
+ call mpas_pool_get_array(diagnosticsPool, 'landIceBoundaryLayerTracers', landIceBoundaryLayerTracers)
+ call mpas_pool_get_dimension(diagnosticsPool, 'index_landIceBoundaryLayerTemperature', indexBLT)
+ call mpas_pool_get_dimension(diagnosticsPool, 'index_landIceBoundaryLayerSalinity', indexBLS)
+
+ if(jenkinsOn .or. hollandJenkinsOn) then
+ call mpas_pool_get_array(diagnosticsPool, 'landIceTracerTransferVelocities', landIceTracerTransferVelocities)
+ call mpas_pool_get_dimension(diagnosticsPool, 'index_landIceHeatTransferVelocity', indexHeatTrans)
+ call mpas_pool_get_dimension(diagnosticsPool, 'index_landIceSaltTransferVelocity', indexSaltTrans)
+ end if
+
+ call mpas_pool_get_array(forcingPool, 'landIceFraction', landIceFraction)
+
+ call mpas_pool_get_array(forcingPool, 'landIceFreshwaterFlux', landIceFreshwaterFlux)
+ call mpas_pool_get_array(forcingPool, 'landIceHeatFlux', landIceHeatFlux)
+ call mpas_pool_get_array(forcingPool, 'heatFluxToLandIce', heatFluxToLandIce)
+
+ call mpas_pool_get_array(forcingPool, 'landIceInterfaceTracers', landIceInterfaceTracers)
+ call mpas_pool_get_dimension(forcingPool, 'index_landIceInterfaceTemperature', indexIT)
+ call mpas_pool_get_dimension(forcingPool, 'index_landIceInterfaceSalinity', indexIS)
+
+ if(config_land_ice_flux_useHollandJenkinsAdvDiff) then
+ call mpas_pool_get_array(forcingPool, 'landIceSurfaceTemperature', landIceSurfaceTemperature)
+
+ call mpas_pool_get_field(scratchPool, 'freezeInterfaceSalinityScratch', freezeInterfaceSalinityField)
+ call mpas_pool_get_field(scratchPool, 'freezeInterfaceTemperatureScratch', freezeInterfaceTemperatureField)
+ call mpas_pool_get_field(scratchPool, 'freezeFreshwaterFluxScratch', freezeFreshwaterFluxField)
+ call mpas_pool_get_field(scratchPool, 'freezeHeatFluxScratch', freezeHeatFluxField)
+ call mpas_pool_get_field(scratchPool, 'freezeIceHeatFluxScratch', freezeIceHeatFluxField)
+ call mpas_allocate_scratch_field(freezeInterfaceSalinityField, .true.)
+ call mpas_allocate_scratch_field(freezeInterfaceTemperatureField, .true.)
+ call mpas_allocate_scratch_field(freezeFreshwaterFluxField, .true.)
+ call mpas_allocate_scratch_field(freezeHeatFluxField, .true.)
+ call mpas_allocate_scratch_field(freezeIceHeatFluxField, .true.)
+ freezeInterfaceSalinity => freezeInterfaceSalinityField % array
+ freezeInterfaceTemperature => freezeInterfaceTemperatureField % array
+ freezeFreshwaterFlux => freezeFreshwaterFluxField % array
+ freezeHeatFlux => freezeHeatFluxField % array
+ freezeIceHeatFlux => freezeIceHeatFluxField % array
+ end if
+
+ if(isomipOn) then
+ !$omp do schedule(runtime) private(heatFlux)
+ do iCell = 1, nCellsSolve
+ ! linearized equaiton for the S and p dependent potential freezing temperature
+ landIceInterfaceTracers(indexIT,iCell) = Tf0 &
+ + dTf_dS*landIceBoundaryLayerTracers(indexBLT,iCell) &
+ + dTf_dp*seaSurfacePressure(iCell)
+
+ ! using (3) and (4) from Hunter (2006)
+ ! or (7) from Jenkins et al. (2001) if gamma constant
+ ! and no heat flux into ice
+ ! freshwater flux = density * melt rate is in kg/m^2/s
+ freshwaterFlux = -rho_sw * config_land_ice_flux_ISOMIP_gammaT * (cp_sw/latent_heat_fusion_mks) &
+ * (landIceInterfaceTracers(indexIT,iCell)-landIceBoundaryLayerTracers(indexBLT,iCell))
+
+ landIceFreshwaterFlux(iCell) = landIceFraction(iCell)*freshwaterFlux
+
+ ! Using (13) from Jenkins et al. (2001)
+ ! heat flux is in W/s
+ heatFlux = cp_sw*(freshwaterFlux*landIceInterfaceTracers(indexIT,iCell) &
+ + rho_sw*config_land_ice_flux_ISOMIP_gammaT &
+ * (landIceInterfaceTracers(indexIT,iCell)-landIceBoundaryLayerTracers(indexBLT,iCell)))
+ landIceHeatFlux(iCell) = landIceFraction(iCell)*heatFlux
+
+ heatFluxToLandIce(iCell) = 0.0_RKIND
+
+ end do
+ !$omp end do
+ end if
+
+ if(jenkinsOn .or. hollandJenkinsOn) then
+ if(config_land_ice_flux_useHollandJenkinsAdvDiff) then
+ ! melting solution
+ call compute_HJ99_melt_fluxes( &
+ landIceBoundaryLayerTracers(indexBLT,:), &
+ landIceBoundaryLayerTracers(indexBLS,:), &
+ landIceTracerTransferVelocities(indexHeatTrans,:), &
+ landIceTracerTransferVelocities(indexSaltTrans,:), &
+ landIceSurfaceTemperature, &
+ seaSurfacePressure, &
+ landIceInterfaceTracers(indexIT,:), &
+ landIceInterfaceTracers(indexIS,:), &
+ landIceFreshwaterFlux, &
+ landIceHeatFlux, &
+ heatFluxToLandIce, &
+ nCellsSolve, &
+ err)
+ if(err .ne. 0) then
+ call mpas_dmpar_global_abort("MPAS-ocean: ERROR: compute_HJ99_melt_fluxes failed.")
+ end if
+
+ ! freezing solution
+ call compute_melt_fluxes( &
+ landIceBoundaryLayerTracers(indexBLT,:), &
+ landIceBoundaryLayerTracers(indexBLS,:), &
+ landIceTracerTransferVelocities(indexHeatTrans,:), &
+ landIceTracerTransferVelocities(indexSaltTrans,:), &
+ seaSurfacePressure, &
+ freezeInterfaceTemperature, &
+ freezeInterfaceSalinity, &
+ freezeFreshwaterFlux, &
+ freezeHeatFlux, &
+ freezeIceHeatFlux, &
+ nCellsSolve, &
+ err)
+ if(err .ne. 0) then
+ call mpas_dmpar_global_abort("MPAS-ocean: ERROR: compute_melt_fluxes failed.")
+ end if
+
+ where(landIceFreshwaterFlux < 0.0_RKIND)
+ landIceInterfaceTracers(indexIS,:) = freezeInterfaceSalinity
+ landIceInterfaceTracers(indexIT,:) = freezeInterfaceTemperature
+ landIceFreshwaterFlux = freezeFreshwaterFlux
+ landIceHeatFlux = freezeHeatFlux
+ heatFluxToLandIce = freezeIceHeatFlux
+ end where
+ else ! not using Holland and Jenkins advection/diffusion
+ call compute_melt_fluxes( &
+ landIceBoundaryLayerTracers(indexBLT,:), &
+ landIceBoundaryLayerTracers(indexBLS,:), &
+ landIceTracerTransferVelocities(indexHeatTrans,:), &
+ landIceTracerTransferVelocities(indexSaltTrans,:), &
+ seaSurfacePressure, &
+ landIceInterfaceTracers(indexIT,:), &
+ landIceInterfaceTracers(indexIS,:), &
+ landIceFreshwaterFlux, &
+ landIceHeatFlux, &
+ heatFluxToLandIce, &
+ nCellsSolve, &
+ err)
+ if(err .ne. 0) then
+ call mpas_dmpar_global_abort("MPAS-ocean: ERROR: compute_melt_fluxes failed.")
+ end if
+ end if
+ landIceFreshwaterFlux(:) = landIceFraction(:)*landIceFreshwaterFlux(:)
+ landIceHeatFlux(:) = landIceFraction(:)*landIceHeatFlux(:)
+ heatFluxToLandIce(:) = landIceFraction(:)*heatFluxToLandIce(:)
+
+ end if
+
+ if(config_land_ice_flux_useHollandJenkinsAdvDiff) then
+ call mpas_deallocate_scratch_field(freezeInterfaceSalinityField, .true.)
+ call mpas_deallocate_scratch_field(freezeInterfaceTemperatureField, .true.)
+ call mpas_deallocate_scratch_field(freezeFreshwaterFluxField, .true.)
+ call mpas_deallocate_scratch_field(freezeHeatFluxField, .true.)
+ call mpas_deallocate_scratch_field(freezeIceHeatFluxField, .true.)
+ end if
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_surface_land_ice_fluxes_build_arrays!}}}
+
+!***********************************************************************
+!
+! routine ocn_surface_land_ice_fluxes_init
+!
+!> \brief Initializes land-ice forcing
+!> \author Xylar Asay-Davis
+!> \date 10/02/2014
+!> \details
+!> This routine initializes a variety of quantities related to
+!> land-ice forcing.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_surface_land_ice_fluxes_init(err)!{{{
+
+ integer, intent(out) :: err !< Output: error flag
+
+ character (len=StrKIND), pointer :: config_land_ice_flux_formulation, config_land_ice_flux_mode
+
+ real (kind=RKIND), pointer :: config_land_ice_flux_Tf0, &
+ config_land_ice_flux_dTf_dp, &
+ config_land_ice_flux_dTf_dS, &
+ config_land_ice_flux_cp_ice, &
+ config_land_ice_flux_rho_ice
+
+
+ err = 0
+ isomipOn = .false.
+ jenkinsOn = .false.
+ hollandJenkinsOn = .false.
+
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_mode', config_land_ice_flux_mode)
+ landIceFluxesOn = (trim(config_land_ice_flux_mode) == 'standalone') &
+ .or. (trim(config_land_ice_flux_mode) == 'coupled')
+ if(.not. landIceFluxesOn) return
+
+ standaloneOn = trim(config_land_ice_flux_mode) == 'standalone'
+
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_formulation', config_land_ice_flux_formulation)
+
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_Tf0', config_land_ice_flux_Tf0)
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_dTf_dp', config_land_ice_flux_dTf_dp)
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_dTf_dS', config_land_ice_flux_dTf_dS)
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_cp_ice', config_land_ice_flux_cp_ice)
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_rho_ice', config_land_ice_flux_rho_ice)
+
+ if ( trim(config_land_ice_flux_formulation) == 'ISOMIP' ) then
+ isomipOn = .true.
+ else if ( trim(config_land_ice_flux_formulation) == 'Jenkins' ) then
+ jenkinsOn = .true.
+ else if ( trim(config_land_ice_flux_formulation) == 'HollandJenkins' ) then
+ hollandJenkinsOn = .true.
+ else
+ write(stderrUnit, *) "ERROR: config_land_ice_flux_formulation not one of 'ISOMIP', 'Jenkins', or 'HollandJenkins'."
+ err = 1
+ call mpas_dmpar_global_abort("MPAS-ocean: ERROR: config_land_ice_flux_formulation not one of 'ISOMIP', 'Jenkins', " &
+ // "or 'HollandJenkins'.")
+ end if
+
+ Tf0 = config_land_ice_flux_Tf0
+ dTf_dp = config_land_ice_flux_dTf_dp
+ dTf_dS = config_land_ice_flux_dTf_dS
+ cp_land_ice = config_land_ice_flux_cp_ice
+ rho_land_ice = config_land_ice_flux_rho_ice
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_surface_land_ice_fluxes_init!}}}
+
+!***********************************************************************
+!
+! routine ocn_forcing_compute_melt_fluxes
+!
+!> \brief Computes ocean and ice melt fluxes, etc.
+!> \author Xylar Asay-Davis
+!> \date 3/27/2015
+!> This routine computes melt fluxes (melt rate, temperature fluxes
+!> into the ice and the ocean, and salt flux) as well as the interface
+!> temperature and salinity. This routine expects an ice temperature
+!> in the bottom layer of ice and ocean temperature and salinity in
+!> the top ocean layer as well as the pressure at the ice/ocean interface.
+!>
+!> The ocean heat and salt transfer velocities are determined based on
+!> observations of turbulent mixing rates in the under-ice boundary layer.
+!> They should be the product of the friction velocity and a (possibly
+!> spatially variable) non-dimenional transfer coefficient.
+!>
+!> The iceTemperatureDistance is the distance between the location
+!> where the iceTemperature is supplied and the ice-ocean interface,
+!> used to compute a temperature gradient. The ice thermal conductivity,
+!> kappa_land_ice, is zero for the freezing solution from Holland and Jenkins
+!> (1999) in which the ice is purely insulating.
+!
+!-----------------------------------------------------------------------
+
+
+ subroutine compute_melt_fluxes( &
+ oceanTemperature, &
+ oceanSalinity, &
+ oceanHeatTransferVelocity, &
+ oceanSaltTransferVelocity, &
+ interfacePressure, &
+ outInterfaceTemperature, &
+ outInterfaceSalinity, &
+ outFreshwaterFlux, &
+ outOceanHeatFlux, &
+ outIceHeatFlux, &
+ nCells, &
+ err, &
+ iceTemperature, &
+ iceTemperatureDistance, &
+ kappa_land_ice) !{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:), intent(in) :: &
+ oceanTemperature, & !< Input: ocean temperature in top layer
+ oceanSalinity, & !< Input: ocean salinity in top layer
+ oceanHeatTransferVelocity, & !< Input: ocean heat transfer velocity
+ oceanSaltTransferVelocity, & !< Input: ocean salt transfer velocity
+ interfacePressure !< Input: pressure at the ice-ocean interface
+
+ integer, intent(in) :: nCells !< Input: number of cells in each array
+
+ real (kind=RKIND), dimension(:), intent(in), optional:: &
+ iceTemperature, & !< Input: ice temperature in bottom layer
+ iceTemperatureDistance !< Input: distance to ice temperature from ice-ocean interface
+
+ real (kind=RKIND), intent(in), optional:: &
+ kappa_land_ice !< Input: the diffusivity of heat in land ice
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:), intent(out) :: &
+ outInterfaceTemperature, & !< Output: ice/ocean temperature at the interface
+ outInterfaceSalinity, & !< Output: ocean salinity at the interface
+ outFreshwaterFlux, & !< Output: ocean thickness flux (melt rate)
+ outOceanHeatFlux, & !< Output: the temperature flux into the ocean
+ outIceHeatFlux !< Output: the temperature flux into the ice
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND) :: T0, transferVelocityRatio, Tlatent, nu, a, b, c, eta, &
+ iceHeatFluxCoeff, iceDeltaT
+ integer :: iCell
+
+ logical :: coupled
+
+ err = 0
+ coupled = present(iceTemperature) .and. present(iceTemperatureDistance) &
+ .and. present(kappa_land_ice)
+ Tlatent = latent_heat_fusion_mks/cp_sw
+
+ !$omp do schedule(runtime) private(iceHeatFluxCoeff, nu, iceDeltaT, T0, transferVelocityRatio, a, b, c)
+ do iCell = 1, nCells
+ if(coupled) then
+ iceHeatFluxCoeff = rho_land_ice*cp_land_ice*kappa_land_ice/iceTemperatureDistance(iCell)
+ nu = iceHeatFluxCoeff/(rho_sw*cp_sw*oceanHeatTransferVelocity(iCell))
+ iceDeltaT = T0 - iceTemperature(iCell)
+ else
+ nu = 0.0_RKIND
+ iceDeltaT = 0.0_RKIND
+ end if
+ T0 = Tf0 + dTf_dp*interfacePressure(iCell)
+ transferVelocityRatio = oceanSaltTransferVelocity(iCell)/oceanHeatTransferVelocity(iCell)
+
+ a = -dTf_dS*(1.0_RKIND + nu)
+ b = transferVelocityRatio*Tlatent - nu*iceDeltaT + oceanTemperature(iCell) - T0
+ c = -transferVelocityRatio*Tlatent
+
+ ! a is strictly positive; c is strictly negative so we never get imaginary roots
+ ! The positive root is the one we want (salinity is strictly positive)
+ outInterfaceSalinity(iCell) = (-b + sqrt(b**2 - 4.0_RKIND*a*c*oceanSalinity(iCell)))/(2.0_RKIND*a)
+ if (outInterfaceSalinity(iCell) .le. 0.0_RKIND) then
+ write(stderrUnit, *) "ERROR: interfaceSalinity <= 0", outInterfaceSalinity(iCell), oceanSalinity(iCell), a, b, c
+ err = 1
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: interfaceSalinity is negative...')
+ end if
+ outInterfaceTemperature(iCell) = dTf_dS*outInterfaceSalinity(iCell)+T0
+
+ outFreshwaterFlux(iCell) = rho_sw*oceanSaltTransferVelocity(iCell) &
+ * (oceanSalinity(iCell)/outInterfaceSalinity(iCell) - 1.0_RKIND)
+
+ ! According to Jenkins et al. (2001), the temperature fluxes into the ocean are:
+ ! 1. the advection of meltwater into the top layer (or removal for freezing)
+ ! 2. the turbulent transfer of heat across the boundary layer, based on the termal driving
+ outOceanHeatFlux(iCell) = cp_sw*(outFreshwaterFlux(iCell)*outInterfaceTemperature(iCell) &
+ - rho_sw*oceanHeatTransferVelocity(iCell)*(oceanTemperature(iCell)-outInterfaceTemperature(iCell)))
+
+ ! the temperature fluxes into the ice are:
+ ! 1. the advection of ice at the interface temperature out of the domain due to melting
+ ! (or in due to freezing)
+ ! 2. the diffusion (if any) of heat into the ice, based on temperature difference between
+ ! the reference point in the ice (either the surface or the middle of the bottom layer)
+ ! and the interface
+ outIceHeatFlux(iCell) = -cp_land_ice*outFreshwaterFlux(iCell)*outInterfaceTemperature(iCell)
+ if(coupled) then
+ outIceHeatFlux(iCell) = outIceHeatFlux(iCell) &
+ - iceHeatFluxCoeff*(iceTemperature(iCell) - outInterfaceTemperature(iCell))
+ end if
+ end do
+ !$omp end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine compute_melt_fluxes !}}}
+
+
+!***********************************************************************
+!
+! routine compute_HJ99_melt_fluxes
+!
+!> \brief Computes melt fluxes, etc. according to HJ99
+!> \author Xylar Asay-Davis
+!> \date 3/28/2015
+!> \details
+!> This routine computes melt fluxes (melt rate, temperature fluxes
+!> into the ice and the ocean, and salt flux) as well as the interface
+!> temperature and salinity. Following Holland and Jenkins (1999),
+!> temperature is assumed to be vertically advected and diffused in
+!> the ice at a rate determined by the melt rate, so that no
+!> heat transfer velocity for the ice need be supplied. Except for
+!> very small melt rates, the Holland and Jenkins advection/diffusion
+!> solution produces an ice temperature profile that is approximately
+!> constant with depth except near the ice-ocean interface. The ice
+!> temperature supplied to this routine should be the far-field value,
+!> equal to the time-averaged surface temperature.
+!>
+!> The solution is only appropriate for melting (positive ocean
+!> thickness flux). For freezing, the fluxes should be computed using
+!> ocn_forcing_compute_melt_fluxes with ``insulating'' ice where
+!> the iceHeatTransferVelocity is set to zero.
+!
+!-----------------------------------------------------------------------
+
+ subroutine compute_HJ99_melt_fluxes( &
+ oceanTemperature, &
+ oceanSalinity, &
+ oceanHeatTransferVelocity, &
+ oceanSaltTransferVelocity, &
+ iceTemperature, &
+ interfacePressure, &
+ outInterfaceTemperature, &
+ outInterfaceSalinity, &
+ outFreshwaterFlux, &
+ outOceanHeatFlux, &
+ outIceHeatFlux, &
+ nCells, &
+ err) !{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:), intent(in) :: &
+ oceanTemperature, & !< Input: ocean temperature in top layer
+ oceanSalinity, & !< Input: ocean salinity in top layer
+ oceanHeatTransferVelocity, & !< Input: ocean heat transfer velocity
+ oceanSaltTransferVelocity, & !< Input: ocean salt transfer velocity
+ iceTemperature, & !< Input: ice temperature in bottom layer
+ interfacePressure !< Input: pressure at the ice-ocean interface
+
+ integer, intent(in) :: nCells !< Input: number of cells in each array
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:), intent(out) :: &
+ outInterfaceTemperature, & !< Output: ice/ocean temperature at the interface
+ outInterfaceSalinity, & !< Output: ocean salinity at the interface
+ outFreshwaterFlux, & !< Output: ocean thickness flux (melt rate)
+ outOceanHeatFlux, & !< Output: the temperature flux into the ocean
+ outIceHeatFlux !< Output: the temperature flux into the ice
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND) :: T0, cpRatio, transferVelocityRatio, Tlatent, a, b, c, eta, TlatentStar
+
+ integer :: iCell
+
+ err = 0
+ cpRatio = cp_land_ice/cp_sw
+ !$omp do schedule(runtime) private(T0, transferVelocityRatio, Tlatent, eta, TlatentStar, a, b, c)
+ do iCell = 1, nCells
+ T0 = Tf0 + dTf_dp*interfacePressure(iCell)
+ transferVelocityRatio = (rho_fw/rho_sw)*oceanSaltTransferVelocity(iCell)/oceanHeatTransferVelocity(iCell)
+ Tlatent = latent_heat_fusion_mks/cp_sw
+
+ eta = cpRatio * transferVelocityRatio
+ TlatentStar = Tlatent + cpRatio*(T0-iceTemperature(iCell))
+ a = -dTf_dS*(1.0_RKIND - eta)
+ b = (transferVelocityRatio*TlatentStar - eta*dTf_dS*oceanSalinity(iCell) &
+ + oceanTemperature(iCell) - T0)
+ c = -transferVelocityRatio*TlatentStar
+
+ ! a is strictly positive; c is strictly negative so we never get imaginary roots
+ ! The positive root is the one we want (salinity is strictly positive)
+ outInterfaceSalinity(iCell) = (-b + sqrt(b**2 - 4.0_RKIND*a*c*oceanSalinity(iCell)))/(2.0_RKIND*a)
+ if (outInterfaceSalinity(iCell) .le. 0.0_RKIND) then
+ err = 1
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: interfaceSalinity is negative...')
+ end if
+ outInterfaceTemperature(iCell) = dTf_dS*outInterfaceSalinity(iCell)+T0
+
+ outFreshwaterFlux(iCell) = rho_sw*oceanSaltTransferVelocity(iCell) &
+ * (oceanSalinity(iCell)/outInterfaceSalinity(iCell) - 1.0_RKIND)
+
+ ! According to Jenkins et al. (2001), the temperature fluxes into the ocean are:
+ ! 1. the advection of meltwater into the top layer (or removal for freezing)
+ ! 2. the turbulent transfer of heat across the boundary layer, based on the termal driving
+ outOceanHeatFlux(iCell) = cp_sw*(outFreshwaterFlux(iCell)*outInterfaceTemperature(iCell) &
+ - rho_sw*oceanHeatTransferVelocity(iCell)*(oceanTemperature(iCell)-outInterfaceTemperature(iCell)))
+
+ ! Since we're considering only melting and ignoring diffusion,
+ ! the ice loses heat simply by the loss of ice mass at the prescribed
+ ! (surface?) ice temperature
+ outIceHeatFlux(iCell) = -cp_land_ice*outFreshwaterFlux(iCell)*iceTemperature(iCell)
+ end do
+ !$omp end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine compute_HJ99_melt_fluxes !}}}
+
+
+!***********************************************************************
+
+end module ocn_surface_land_ice_fluxes
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_tendency.F b/src/core_ocean/shared/mpas_ocn_tendency.F
index 1d0168a50e..c0e6511436 100644
--- a/src/core_ocean/shared/mpas_ocn_tendency.F
+++ b/src/core_ocean/shared/mpas_ocn_tendency.F
@@ -24,12 +24,28 @@ module ocn_tendency
use mpas_pool_routines
use mpas_constants
use mpas_timer
+ use mpas_threading
use ocn_constants
+ use ocn_surface_bulk_forcing
+ use ocn_surface_land_ice_fluxes
+ use ocn_frazil_forcing
+
+ use ocn_tracer_hmix
+ use ocn_high_freq_thickness_hmix_del2
use ocn_tracer_advection
use ocn_tracer_short_wave_absorption
use ocn_tracer_nonlocalflux
+ use ocn_tracer_surface_restoring
+ use ocn_tracer_interior_restoring
+ use ocn_tracer_exponential_decay
+ use ocn_tracer_ideal_age
+ use ocn_tracer_TTD
+ use ocn_tracer_surface_flux_to_tend
+ use ocn_tracer_ecosys
+ use ocn_tracer_DMS
+ use ocn_tracer_MacroMolecules
use ocn_thick_hadv
use ocn_thick_vadv
@@ -42,10 +58,6 @@ module ocn_tendency
use ocn_vel_forcing
use ocn_vmix
- use ocn_tracer_hmix
- use ocn_high_freq_thickness_hmix_del2
- use ocn_tracer_surface_flux
-
implicit none
private
save
@@ -87,7 +99,7 @@ module ocn_tendency
!> \brief Computes thickness tendency
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the thickness tendency for the ocean
!
!-----------------------------------------------------------------------
@@ -96,22 +108,24 @@ subroutine ocn_tend_thick(tendPool, forcingPool, diagnosticsPool, meshPool)!{{{
implicit none
type (mpas_pool_type), intent(inout) :: tendPool !< Input/Output: Tendency structure
- type (mpas_pool_type), intent(in) :: forcingPool !< Input: Forcing information
+ type (mpas_pool_type), intent(inout) :: forcingPool !< Input: Forcing information
type (mpas_pool_type), intent(in) :: diagnosticsPool !< Input: Diagnostics information
type (mpas_pool_type), intent(in) :: meshPool !< Input: Mesh information
real (kind=RKIND), dimension(:), pointer :: surfaceThicknessFlux
+ real (kind=RKIND), dimension(:), pointer :: surfaceThicknessFluxRunoff
real (kind=RKIND), dimension(:,:), pointer :: layerThickness, layerThicknessEdge, &
- vertAleTransportTop, tend_layerThickness, normalTransportVelocity, fractionAbsorbed
+ vertAleTransportTop, tend_layerThickness, normalTransportVelocity, fractionAbsorbed, fractionAbsorbedRunoff
- integer :: err
+ integer, pointer :: nCells
+ integer :: err, iCell
logical, pointer :: config_disable_thick_all_tend
- call mpas_timer_start("ocn_tend_thick")
-
call mpas_pool_get_config(ocnConfigs, 'config_disable_thick_all_tend', config_disable_thick_all_tend)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
call mpas_pool_get_array(diagnosticsPool, 'normalTransportVelocity', normalTransportVelocity)
call mpas_pool_get_array(diagnosticsPool, 'layerThicknessEdge', layerThicknessEdge)
call mpas_pool_get_array(diagnosticsPool, 'vertAleTransportTop', vertAleTransportTop)
@@ -119,19 +133,39 @@ subroutine ocn_tend_thick(tendPool, forcingPool, diagnosticsPool, meshPool)!{{{
call mpas_pool_get_array(tendPool, 'layerThickness', tend_layerThickness)
call mpas_pool_get_array(forcingPool, 'surfaceThicknessFlux', surfaceThicknessFlux)
+ call mpas_pool_get_array(forcingPool, 'surfaceThicknessFluxRunoff', surfaceThicknessFluxRunoff)
call mpas_pool_get_array(forcingPool, 'fractionAbsorbed', fractionAbsorbed)
-
+ call mpas_pool_get_array(forcingPool, 'fractionAbsorbedRunoff', fractionAbsorbedRunoff)
+
!
! height tendency: start accumulating tendency terms
!
- tend_layerThickness = 0.0
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ tend_layerThickness(:, iCell) = 0.0_RKIND
+ surfaceThicknessFlux(iCell) = 0.0_RKIND
+ surfaceThicknessFluxRunoff(iCell) = 0.0_RKIND
+ end do
+ !$omp end do
if(config_disable_thick_all_tend) return
+ call mpas_timer_start("ocn_tend_thick")
+
+ ! Build suface mass flux array from bulk
+ call mpas_timer_start("bulk_thick", .false.)
+ call ocn_surface_bulk_forcing_thick(meshPool, forcingPool, surfaceThicknessFlux, surfaceThicknessFluxRunoff, err)
+ call mpas_timer_stop("bulk_thick")
+
+ ! Build suface thickness flux array from land ice
+ call mpas_timer_start("land_ice_thick", .false.)
+ call ocn_surface_land_ice_fluxes_thick(meshPool, forcingPool, surfaceThicknessFlux, err)
+ call mpas_timer_stop("land_ice_thick")
+
!
! height tendency: horizontal advection term -\nabla\cdot ( hu)
!
- ! See Ringler et al. (2010) jcp paper, eqn 19, 21, and fig. 3.
+ ! See Ringler et al. (2010) jcp paper, eqn 19, 21, and fig. 3.
! for explanation of divergence operator.
!
! QC Comment (3/15/12): need to make sure that uTranport is the right
@@ -152,11 +186,19 @@ subroutine ocn_tend_thick(tendPool, forcingPool, diagnosticsPool, meshPool)!{{{
!
call mpas_timer_start("surface flux")
- call ocn_thick_surface_flux_tend(meshPool, fractionAbsorbed, layerThickness, surfaceThicknessFlux, tend_layerThickness, err)
+ call ocn_thick_surface_flux_tend(meshPool, fractionAbsorbed, fractionAbsorbedRunoff, layerThickness, &
+ surfaceThicknessFlux, surfaceThicknessFluxRunoff, tend_layerThickness, err)
call mpas_timer_stop("surface flux")
+ !
+ ! surface flux tendency
+ !
+ call mpas_timer_start("frazil thickness tendency", .false.)
+ call ocn_frazil_forcing_layer_thickness(meshPool, forcingPool, tend_layerThickness, err)
+ call mpas_timer_stop("frazil thickness tendency")
+
call mpas_timer_stop("ocn_tend_thick")
-
+
end subroutine ocn_tend_thick!}}}
!***********************************************************************
@@ -166,7 +208,7 @@ end subroutine ocn_tend_thick!}}}
!> \brief Computes velocity tendency
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the velocity tendency for the ocean
!
!-----------------------------------------------------------------------
@@ -182,25 +224,25 @@ subroutine ocn_tend_vel(tendPool, statePool, forcingPool, diagnosticsPool, meshP
type (mpas_pool_type), intent(inout) :: scratchPool !< Input: Scratch structure
integer, intent(in), optional :: timeLevelIn !< Input: Time level for state fields
- real (kind=RKIND), dimension(:), pointer :: surfaceWindStress
+ type (mpas_pool_type), pointer :: tracersPool
+
+ real (kind=RKIND), dimension(:), pointer :: surfaceStress, surfaceStressMagnitude, surfaceFluxAttenuationCoefficient
real (kind=RKIND), dimension(:,:), pointer :: &
layerThicknessEdge, normalVelocity, tangentialVelocity, density, potentialDensity, zMid, pressure, &
tend_normalVelocity, circulation, relativeVorticity, viscosity, kineticEnergyCell, &
normalizedRelativeVorticityEdge, normalizedPlanetaryVorticityEdge, &
montgomeryPotential, vertAleTransportTop, divergence, vertViscTopOfEdge, &
inSituThermalExpansionCoeff, inSituSalineContractionCoeff
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
integer :: timeLevel
- integer :: err
- integer, pointer :: indexTemperature, indexSalinity
+ integer :: err, iEdge, iCell
+ integer, pointer :: indexTemperature, indexSalinity, nEdges, nCells
logical, pointer :: config_disable_vel_all_tend
character (len=StrKIND), pointer :: config_pressure_gradient_type
- call mpas_timer_start("ocn_tend_vel")
-
if (present(timeLevelIn)) then
timeLevel = timeLevelIn
else
@@ -210,10 +252,15 @@ subroutine ocn_tend_vel(tendPool, statePool, forcingPool, diagnosticsPool, meshP
call mpas_pool_get_config(ocnConfigs, 'config_disable_vel_all_tend', config_disable_vel_all_tend)
call mpas_pool_get_config(ocnConfigs, 'config_pressure_gradient_type', config_pressure_gradient_type)
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, timeLevel)
- call mpas_pool_get_array(statePool, 'tracers', tracers, timeLevel)
- call mpas_pool_get_dimension(statePool, 'index_temperature', indexTemperature)
- call mpas_pool_get_dimension(statePool, 'index_salinity', indexSalinity)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, timeLevel)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', indexTemperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', indexSalinity)
call mpas_pool_get_array(diagnosticsPool, 'kineticEnergyCell', kineticEnergyCell)
call mpas_pool_get_array(diagnosticsPool, 'layerThicknessEdge', layerThicknessEdge)
@@ -230,18 +277,43 @@ subroutine ocn_tend_vel(tendPool, statePool, forcingPool, diagnosticsPool, meshP
call mpas_pool_get_array(diagnosticsPool, 'density', density)
call mpas_pool_get_array(diagnosticsPool, 'potentialDensity', potentialDensity)
call mpas_pool_get_array(diagnosticsPool, 'tangentialVelocity', tangentialVelocity)
+ call mpas_pool_get_array(diagnosticsPool, 'surfaceFluxAttenuationCoefficient', surfaceFluxAttenuationCoefficient)
call mpas_pool_get_array(tendPool, 'normalVelocity', tend_normalVelocity)
-
- call mpas_pool_get_array(forcingPool, 'surfaceWindStress', surfaceWindStress)
+
+ call mpas_pool_get_array(forcingPool, 'surfaceStress', surfaceStress)
+ call mpas_pool_get_array(forcingPool, 'surfaceStressMagnitude', surfaceStressMagnitude)
!
! velocity tendency: start accumulating tendency terms
!
- tend_normalVelocity(:,:) = 0.0
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ tend_normalVelocity(:, iEdge) = 0.0_RKIND
+ surfaceStress(iEdge) = 0.0_RKIND
+ end do
+ !$omp end do
+
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ surfaceStressMagnitude(iCell) = 0.0_RKIND
+ end do
+ !$omp end do
if(config_disable_vel_all_tend) return
+ call mpas_timer_start("ocn_tend_vel")
+
+ ! Build bulk forcing suface stress
+ call mpas_timer_start("bulk_ws", .false.)
+ call ocn_surface_bulk_forcing_vel(meshPool, forcingPool, surfaceStress, surfaceStressMagnitude, err)
+ call mpas_timer_stop("bulk_ws")
+
+ ! Add top drag to suface stress
+ call mpas_timer_start("top_drag", .false.)
+ call ocn_surface_land_ice_fluxes_vel(meshPool, diagnosticsPool, surfaceStress, surfaceStressMagnitude, err)
+ call mpas_timer_stop("top_drag")
+
!
! velocity tendency: nonlinear Coriolis term and grad of kinetic energy
!
@@ -267,11 +339,11 @@ subroutine ocn_tend_vel(tendPool, statePool, forcingPool, diagnosticsPool, meshP
call mpas_pool_get_array(diagnosticsPool, 'inSituThermalExpansionCoeff',inSituThermalExpansionCoeff)
call mpas_pool_get_array(diagnosticsPool, 'inSituSalineContractionCoeff', inSituSalineContractionCoeff)
call ocn_vel_pressure_grad_tend(meshPool, pressure, montgomeryPotential, zMid, density, potentialDensity, &
- indexTemperature, indexSalinity, tracers, tend_normalVelocity, err, &
+ indexTemperature, indexSalinity, activeTracers, tend_normalVelocity, err, &
inSituThermalExpansionCoeff,inSituSalineContractionCoeff)
else
call ocn_vel_pressure_grad_tend(meshPool, pressure, montgomeryPotential, zMid, density, potentialDensity, &
- indexTemperature, indexSalinity, tracers, tend_normalVelocity, err, &
+ indexTemperature, indexSalinity, activeTracers, tend_normalVelocity, err, &
inSituThermalExpansionCoeff,inSituSalineContractionCoeff)
endif
call mpas_timer_stop("pressure grad")
@@ -282,22 +354,24 @@ subroutine ocn_tend_vel(tendPool, statePool, forcingPool, diagnosticsPool, meshP
! strictly only valid for config_mom_del2 == constant
!
call mpas_timer_start("hmix")
- call ocn_vel_hmix_tend(meshPool, divergence, relativeVorticity, normalVelocity, tangentialVelocity, viscosity, &
- tend_normalVelocity, scratchPool, err)
+ call ocn_vel_hmix_tend(meshPool, scratchPool, divergence, relativeVorticity, normalVelocity, tangentialVelocity, viscosity, &
+ tend_normalVelocity, err)
call mpas_timer_stop("hmix")
!
! velocity tendency: forcing and bottom drag
!
-
call mpas_timer_start("forcings")
- call ocn_vel_forcing_tend(meshPool, normalVelocity, surfaceWindStress, layerThicknessEdge, tend_normalVelocity, err)
+ call ocn_vel_forcing_tend(meshPool, normalVelocity, surfaceFluxAttenuationCoefficient, surfaceStress, layerThicknessEdge, &
+ tend_normalVelocity, err)
call mpas_timer_stop("forcings")
+
!
! velocity tendency: vertical mixing d/dz( nu_v du/dz))
!
call mpas_timer_stop("ocn_tend_vel")
+ call mpas_threading_barrier()
end subroutine ocn_tend_vel!}}}
@@ -308,50 +382,128 @@ end subroutine ocn_tend_vel!}}}
!> \brief Computes tracer tendency
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date September 2011
-!> \details
+!> \details
!> This routine computes tracer tendencies for the ocean
!
!-----------------------------------------------------------------------
- subroutine ocn_tend_tracer(tendPool, statePool, forcingPool, diagnosticsPool, meshPool, scratchPool, dt, timeLevelIn)!{{{
+ subroutine ocn_tend_tracer(tendPool, statePool, forcingPool, diagnosticsPool, meshPool, swForcingPool, scratchPool, dt, & !{{{
+ timeLevelIn)
implicit none
- type (mpas_pool_type), intent(inout) :: tendPool !< Input/Output: Tendency structure
- type (mpas_pool_type), intent(in) :: statePool !< Input: State information
- type (mpas_pool_type), intent(in) :: forcingPool !< Input: Forcing information
- type (mpas_pool_type), intent(in) :: diagnosticsPool !< Input: Diagnostic information
- type (mpas_pool_type), intent(in) :: meshPool !< Input: Mesh information
- type (mpas_pool_type), intent(in) :: scratchPool !< Input: Scratch information
- real (kind=RKIND), intent(in) :: dt !< Input: Time step
- integer, intent(in), optional :: timeLevelIn
+ !
+ ! intent in/out
+ !
+ type (mpas_pool_type), intent(inout) :: tendPool !< Input/Output: Tendency structure
+ type (mpas_pool_type), intent(in) :: statePool !< Input: State information
+ type (mpas_pool_type), intent(inout) :: forcingPool !< Input: Forcing information
+ type (mpas_pool_type), intent(in) :: diagnosticsPool !< Input: Diagnostic information
+ type (mpas_pool_type), intent(inout) :: meshPool !< Input: Mesh information
+ type (mpas_pool_type), intent(in) :: swForcingPool !< Input: sw data input info
+ type (mpas_pool_type), intent(in) :: scratchPool !< Input: Scratch information
+ real (kind=RKIND), intent(in) :: dt !< Input: Time step
+ integer, intent(in), optional :: timeLevelIn !< Input/Optional: Time Level Indes
+
+ !
+ ! additional pools
+ !
+ type (mpas_pool_type), pointer :: tracersPool, tracersTendPool ! tracers and their tendency
+ type (mpas_pool_type), pointer :: tracersSurfaceFluxPool ! surface fluxes
+ type (mpas_pool_type), pointer :: tracersSurfaceRestoringFieldsPool ! surface restoring
+ type (mpas_pool_type), pointer :: tracersInteriorRestoringFieldsPool ! interior restoring
+ type (mpas_pool_type), pointer :: tracersExponentialDecayFieldsPool ! exponential decay
+ type (mpas_pool_type), pointer :: tracersIdealAgeFieldsPool ! ideal age
+ type (mpas_pool_type), pointer :: tracersTTDFieldsPool ! transit time distribution
+
+ ! scalar pointers
+ integer :: nTracerGroup
+ integer, pointer :: nVertLevels, nEdges, nCells, nCellsSolve, indexTemperature, indexSalinity
+ logical, pointer :: config_disable_tr_all_tend, config_use_cvmix_kpp
+ logical, pointer :: config_use_tracerGroup, config_use_tracerGroup_surface_bulk_forcing, &
+ config_use_tracerGroup_surface_restoring, config_use_tracerGroup_interior_restoring, &
+ config_use_tracerGroup_exponential_decay, config_use_tracerGroup_idealAge_forcing, &
+ config_use_tracerGroup_ttd_forcing
+
+ ! iterator for tracer categories
+ type (mpas_pool_iterator_type) :: groupItr
+ character (len=StrKIND) :: modifiedGroupName
+ character (len=StrKIND) :: modifiedConfigName
+ !
+ ! one dimensional pointers
+ !
+ real (kind=RKIND), dimension(:), pointer :: penetrativeTemperatureFlux, penetrativeTemperatureFluxOBL
+ real (kind=RKIND), dimension(:), pointer :: tracerGroupExponentialDecayRate
+ integer, dimension(:), pointer :: maxLevelCell
+
+ !
+ ! two dimensional pointers
+ !
+ real (kind=RKIND), dimension(:,:), pointer :: tracerGroupPistonVelocity, tracerGroupSurfaceRestoringValue, &
+ tracerGroupIdealAgeMask, tracerGroupTTDMask
- real (kind=RKIND), dimension(:), pointer :: penetrativeTemperatureFlux
real (kind=RKIND), dimension(:,:), pointer :: &
normalTransportVelocity, layerThickness,vertAleTransportTop, layerThicknessEdge, vertDiffTopOfCell, &
- tend_layerThickness, normalThicknessFlux, surfaceTracerFlux, fractionAbsorbed, zMid, relativeSlopeTopOfEdge, &
- relativeSlopeTapering, relativeSlopeTaperingCell
+ tend_layerThickness, normalThicknessFlux, tracerGroupSurfaceFlux, fractionAbsorbed, zMid, relativeSlopeTopOfEdge, &
+ relativeSlopeTapering, relativeSlopeTaperingCell, fractionAbsorbedRunoff, tracerGroupSurfaceFluxRunoff, &
+ nonLocalSurfaceTracerFlux
+
+ !
+ ! three dimensional pointers
+ !
real (kind=RKIND), dimension(:,:,:), pointer :: &
- tracers, tend_tr, vertNonLocalFlux
+ tracerGroup, tracerGroupTend, vertNonLocalFlux
- integer :: err, iEdge, k
- integer, pointer :: nVertLevels, nEdges, indexTemperature
- integer :: timeLevel
+ real (kind=RKIND), dimension(:,:,:), pointer :: &
+ activeTracers, & ! need T, S for ecosys
+ ecosysTracers ! need ecosys for DMS and MacroMolecules
- logical, pointer :: config_disable_tr_all_tend, config_use_cvmix_kpp
+ real (kind=RKIND), dimension(:,:,:), pointer :: tracerGroupInteriorRestoringRate, tracerGroupInteriorRestoringValue
- call mpas_timer_start("ocn_tend_tracer")
+ !
+ ! Field pointers
+ !
+ type (field2DReal), pointer :: normalThicknessFluxField
+
+ !
+ ! local integers/reals/logicals
+ !
+ integer :: err, iCell, iEdge, k, timeLevel, nTracersEcosys
+ !
+ ! set time level of optional argument is present
+ !
if (present(timeLevelIn)) then
timeLevel = timeLevelIn
else
timeLevel = 1
end if
+ !
+ ! get tracers pools
+ !
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_subpool(tendPool, 'tracersTend', tracersTendPool)
+ call mpas_pool_get_subpool(forcingPool, 'tracersSurfaceFlux', tracersSurfaceFluxPool)
+
+ !
+ ! get dimensions
+ !
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', indexTemperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', indexSalinity)
+
+ !
+ ! get configure options
+ !
call mpas_pool_get_config(ocnConfigs, 'config_disable_tr_all_tend', config_disable_tr_all_tend)
call mpas_pool_get_config(ocnConfigs, 'config_use_cvmix_kpp', config_use_cvmix_kpp)
+ !
+ ! get arrays
+ !
call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, timeLevel)
- call mpas_pool_get_array(statePool, 'tracers', tracers, timeLevel)
-
call mpas_pool_get_array(diagnosticsPool, 'normalTransportVelocity', normalTransportVelocity)
call mpas_pool_get_array(diagnosticsPool, 'layerThicknessEdge', layerThicknessEdge)
call mpas_pool_get_array(diagnosticsPool, 'vertDiffTopOfCell', vertDiffTopOfCell)
@@ -361,78 +513,323 @@ subroutine ocn_tend_tracer(tendPool, statePool, forcingPool, diagnosticsPool, me
call mpas_pool_get_array(diagnosticsPool, 'relativeSlopeTapering', relativeSlopeTapering)
call mpas_pool_get_array(diagnosticsPool, 'relativeSlopeTaperingCell', relativeSlopeTaperingCell)
call mpas_pool_get_array(diagnosticsPool, 'vertNonLocalFlux', vertNonLocalFlux)
-
call mpas_pool_get_array(forcingPool, 'penetrativeTemperatureFlux', penetrativeTemperatureFlux)
- call mpas_pool_get_array(forcingPool, 'surfaceTracerFlux', surfaceTracerFlux)
+ call mpas_pool_get_array(diagnosticsPool, 'penetrativeTemperatureFluxOBL', penetrativeTemperatureFluxOBL)
call mpas_pool_get_array(forcingPool, 'fractionAbsorbed', fractionAbsorbed)
-
- call mpas_pool_get_array(tendPool, 'tracers', tend_tr)
+ call mpas_pool_get_array(forcingPool, 'fractionAbsorbedRunoff', fractionAbsorbedRunoff)
call mpas_pool_get_array(tendPool, 'layerThickness', tend_layerThickness)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
- call mpas_pool_get_dimension(statePool, 'index_temperature', indexTemperature)
+ if(config_disable_tr_all_tend) return
- !
- ! initialize tracer tendency (RHS of tracer equation) to zero.
- !
- tend_tr(:,:,:) = 0.0
+ call mpas_timer_start("ocn_tend_tracer")
- if(config_disable_tr_all_tend) return
+ !allocate(normalThicknessFlux(nVertLevels, nEdges+1))
+ call mpas_pool_get_field(scratchPool, 'normalThicknessFlux', normalThicknessFluxField)
+ call mpas_allocate_scratch_field(normalThicknessFluxField, .true.)
+ call mpas_threading_barrier()
+
+ normalThicknessFlux => normalThicknessFluxField % array
- allocate(normalThicknessFlux(nVertLevels, nEdges+1))
!
! transport velocity for the tracer.
+ !
+ !$omp do schedule(runtime) private(k)
do iEdge = 1, nEdges
do k = 1, nVertLevels
normalThicknessFlux(k, iEdge) = normalTransportVelocity(k, iEdge) * layerThicknessEdge(k, iEdge)
end do
end do
-
- !
- ! tracer tendency: horizontal advection term -div( layerThickness \phi u)
- !
-
- ! Monotonoic Advection, or standard advection
- call mpas_timer_start("adv")
- call ocn_tracer_advection_tend(tracers, normalThicknessFlux, vertAleTransportTop, layerThickness, layerThickness, dt, meshPool, tend_layerThickness, tend_tr)
- call mpas_timer_stop("adv")
-
- !
- ! tracer tendency: del2 horizontal tracer diffusion, div(h \kappa_2 \nabla \phi)
- !
- call mpas_timer_start("hmix")
- call ocn_tracer_hmix_tend(meshPool, scratchPool, layerThickness, layerThicknessEdge, zMid, tracers, &
- relativeSlopeTopOfEdge, relativeSlopeTapering, relativeSlopeTaperingCell, tend_tr, err)
- call mpas_timer_stop("hmix")
-
- !
- ! Perform forcing from surface fluxes
- !
- call mpas_timer_start("surface_flux")
- call ocn_tracer_surface_flux_tend(meshPool, fractionAbsorbed, layerThickness, surfaceTracerFlux, tend_tr, err)
- call mpas_timer_stop("surface_flux")
-
- !
- ! Performing shortwave absorption
- !
- call mpas_timer_start("short wave")
- call ocn_tracer_short_wave_absorption_tend(meshPool, indexTemperature, layerThickness, penetrativeTemperatureFlux, tend_tr, err)
- call mpas_timer_stop("short wave")
-
- !
- ! Compute tracer tendency due to non-local flux computed in KPP
- !
- if (config_use_cvmix_kpp) then
- call mpas_timer_start("non-local flux from KPP")
- call ocn_tracer_nonlocalflux_tend(meshPool, vertNonLocalFlux, surfaceTracerFlux, tend_tr, err)
- call mpas_timer_stop("non-local flux from KPP")
- endif
-
+ !$omp end do
+
+ !
+ ! begin iterate over tracer categories
+ !
+ call mpas_pool_begin_iteration(tracersPool)
+ do while ( mpas_pool_get_next_member(tracersPool, groupItr) )
+ if ( groupItr % memberType == MPAS_POOL_FIELD ) then
+
+ ! load configure setting for this category
+ !
+ modifiedConfigName = 'config_use_' // trim(groupItr % memberName)
+ call mpas_pool_get_config(ocnConfigs, modifiedConfigName, config_use_tracerGroup)
+
+ if ( config_use_tracerGroup ) then
+ modifiedConfigName = 'config_use_' // trim(groupItr % memberName) // '_surface_bulk_forcing'
+ call mpas_pool_get_config(ocnConfigs, modifiedConfigName, config_use_tracerGroup_surface_bulk_forcing)
+ modifiedConfigName = 'config_use_' // trim(groupItr % memberName) // '_surface_restoring'
+ call mpas_pool_get_config(ocnConfigs, modifiedConfigName, config_use_tracerGroup_surface_restoring)
+ modifiedConfigName = 'config_use_' // trim(groupItr % memberName) // '_interior_restoring'
+ call mpas_pool_get_config(ocnConfigs, modifiedConfigName, config_use_tracerGroup_interior_restoring)
+ modifiedConfigName = 'config_use_' // trim(groupItr % memberName) // '_exponential_decay'
+ call mpas_pool_get_config(ocnConfigs, modifiedConfigName, config_use_tracerGroup_exponential_decay)
+ modifiedConfigName = 'config_use_' // trim(groupItr % memberName) // '_idealAge_forcing'
+ call mpas_pool_get_config(ocnConfigs, modifiedConfigName, config_use_tracerGroup_idealAge_forcing)
+ modifiedConfigName = 'config_use_' // trim(groupItr % memberName) // '_ttd_forcing'
+ call mpas_pool_get_config(ocnConfigs, modifiedConfigName, config_use_tracerGroup_ttd_forcing)
+
+
+ ! Get tracer group, and other groups (tendencies, etc.)
+ call mpas_pool_get_array(tracersPool, trim(groupItr % memberName), tracerGroup, timeLevel)
+ nTracerGroup = size(tracerGroup, dim=1)
+
+ ! Get Tendency array
+ modifiedGroupName = trim(groupItr % memberName) // "Tend"
+ call mpas_pool_get_array(tracersTendPool, trim(modifiedGroupName), tracerGroupTend)
+
+ ! Get surface flux array
+ modifiedGroupName = trim(groupItr % memberName) // "SurfaceFlux"
+ call mpas_pool_get_array(tracersSurfaceFluxPool, trim(modifiedGroupName), tracerGroupSurfaceFlux)
+
+ ! Get Array of total surface temp/salt flux (includes thickness
+ ! tendencies
+ call mpas_pool_get_array(tracersSurfaceFluxPool, 'nonLocalSurfaceTracerFlux', nonLocalSurfaceTracerFlux)
+
+ ! Get surface flux due to river runoff array
+ modifiedGroupName = trim(groupItr % memberName) // "SurfaceFluxRunoff"
+ call mpas_pool_get_array(tracersSurfaceFluxPool, trim(modifiedGroupName), tracerGroupSurfaceFluxRunoff)
+
+ !
+ ! initialize tracer surface flux and tendency to zero.
+ !
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ tracerGroupTend(:,:, iCell) = 0.0_RKIND
+ tracerGroupSurfaceFlux(:, iCell) = 0.0_RKIND
+ end do
+ !$omp end do
+
+ if (trim(groupItr % memberName) == 'activeTracers') then
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ tracerGroupSurfaceFluxRunoff(:, iCell) = 0.0_RKIND
+ end do
+ !$omp end do
+ endif
+
+ !
+ ! fill components of surface tracer flux
+ !
+ if (config_use_tracerGroup_surface_bulk_forcing) then
+ call mpas_timer_start("bulk_" // trim(groupItr % memberName))
+ call ocn_surface_bulk_forcing_tracers(meshPool, groupItr % memberName, forcingPool, tracerGroup, &
+ tracerGroupSurfaceFlux, tracerGroupSurfaceFluxRunoff, err)
+ call mpas_timer_stop("bulk_" // trim(groupItr % memberName))
+ end if
+
+ !
+ ! compute ecosystem source-sink tendencies and net surface fluxes
+ ! NOTE: must be called before ocn_tracer_surface_flux_tend
+ !
+ if ( trim(groupItr % memberName) == 'ecosysTracers' ) then
+ call mpas_timer_start("ecosys source-sink")
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, timeLevel)
+ call ocn_tracer_ecosys_compute(activeTracers, tracerGroup, forcingPool, nTracerGroup, &
+ nCellsSolve, maxLevelCell, nVertLevels, layerThickness, zMid, indexTemperature, &
+ indexSalinity, tracerGroupTend, err)
+ call mpas_timer_stop("ecosys source-sink")
+
+ call mpas_timer_start("ecosys surface flux", .false.)
+ call ocn_tracer_ecosys_surface_flux_compute(activeTracers, tracerGroup, forcingPool, &
+ nTracerGroup, nCellsSolve, zMid, indexTemperature, indexSalinity, tracerGroupSurfaceFlux, err)!{{{
+ call mpas_timer_stop("ecosys surface flux")
+ endif
+
+ !
+ ! compute DMS source-sink tendencies and net surface fluxes
+ ! NOTE: must be called before ocn_tracer_surface_flux_tend
+ !
+ if ( trim(groupItr % memberName) == 'DMSTracers' ) then
+ call mpas_timer_start("DMS source-sink")
+ call mpas_pool_get_array(tracersPool, 'ecosysTracers', ecosysTracers, timeLevel)
+ nTracersEcosys = size(ecosysTracers, dim=1)
+ call ocn_tracer_DMS_compute(activeTracers, tracerGroup, nTracerGroup, ecosysTracers, &
+ nTracersEcosys, forcingPool, nCellsSolve, maxLevelCell, &
+ nVertLevels, layerThickness, indexTemperature, indexSalinity, tracerGroupTend, err)
+ call mpas_timer_stop("DMS source-sink")
+
+ call mpas_timer_start("DMS surface flux", .false.)
+ call ocn_tracer_DMS_surface_flux_compute(activeTracers, tracerGroup, forcingPool, &
+ nTracerGroup, nCellsSolve, zMid, indexTemperature, indexSalinity, tracerGroupSurfaceFlux, err)!{{{
+ call mpas_timer_stop("DMS surface flux")
+ endif
+
+ !
+ ! compute MacroMolecules source-sink tendencies and net surface fluxes
+ ! NOTE: must be called before ocn_tracer_surface_flux_tend
+ !
+ if ( trim(groupItr % memberName) == 'MacroMoleculesTracers' ) then
+ call mpas_timer_start("MacroMolecules source-sink")
+ call mpas_pool_get_array(tracersPool, 'ecosysTracers', ecosysTracers, timeLevel)
+ nTracersEcosys = size(ecosysTracers, dim=1)
+ call ocn_tracer_MacroMolecules_compute(tracerGroup, nTracerGroup, ecosysTracers, nTracersEcosys, forcingPool, &
+ nCellsSolve, maxLevelCell, nVertLevels, layerThickness, &
+ tracerGroupTend, err)
+ call mpas_timer_stop("MacroMolecules source-sink")
+
+ call mpas_timer_start("MacroMolecules surface flux", .false.)
+ call ocn_tracer_MacroMolecules_surface_flux_compute(activeTracers, tracerGroup, forcingPool, &
+ nTracerGroup, nCellsSolve, zMid, indexTemperature, indexSalinity, tracerGroupSurfaceFlux, err)
+ call mpas_timer_stop("MacroMolecules surface flux")
+ endif
+
+ !
+ ! ocean surface restoring
+ !
+ if (config_use_tracerGroup_surface_restoring) then
+ call mpas_timer_start("surface_restoring_" // trim(groupItr % memberName))
+ call mpas_pool_get_subpool(forcingPool, 'tracersSurfaceRestoringFields', tracersSurfaceRestoringFieldsPool)
+ modifiedGroupName = trim(groupItr % memberName) // "PistonVelocity"
+ call mpas_pool_get_array(tracersSurfaceRestoringFieldsPool, trim(modifiedGroupName), &
+ tracerGroupPistonVelocity)
+ modifiedGroupName = trim(groupItr % memberName) // "SurfaceRestoringValue"
+ call mpas_pool_get_array(tracersSurfaceRestoringFieldsPool, trim(modifiedGroupName), &
+ tracerGroupSurfaceRestoringValue)
+ call ocn_tracer_surface_restoring_compute(nTracerGroup, nCells, tracerGroup, tracerGroupPistonVelocity, &
+ tracerGroupSurfaceRestoringValue, tracerGroupSurfaceFlux, err)
+ call mpas_timer_stop("surface_restoring_" // trim(groupItr % memberName))
+ endif
+
+ ! tracer fluxes at the land-ice / ocean interface
+ ! this is a flux at the top ocean surface -- so these fluxes are added into tracerGroupSurfaceFlux
+ call mpas_timer_start("land_ice_" // trim(groupItr % memberName))
+ call ocn_surface_land_ice_fluxes_tracers(meshPool, groupItr % memberName, forcingPool, tracerGroupSurfaceFlux, err)
+ call mpas_timer_stop("land_ice_" // trim(groupItr % memberName))
+
+ !
+ ! other additions to tracerGroupSurfaceFlux should be added here
+ !
+
+ !
+ ! now begin to accumulate the RHS tracer tendencies.
+ !
+
+ !
+ ! interior restoring forcing tendency
+ !
+ if (config_use_tracerGroup_interior_restoring) then
+ call mpas_timer_start("interior_restoring_" // trim(groupItr % memberName), .false.)
+ call mpas_pool_get_subpool(forcingPool, 'tracersInteriorRestoringFields', tracersInteriorRestoringFieldsPool)
+ modifiedGroupName = trim(groupItr % memberName) // "InteriorRestoringRate"
+ call mpas_pool_get_array(tracersInteriorRestoringFieldsPool, trim(modifiedGroupName), &
+ tracerGroupInteriorRestoringRate)
+ modifiedGroupName = trim(groupItr % memberName) // "InteriorRestoringValue"
+ call mpas_pool_get_array(tracersInteriorRestoringFieldsPool, trim(modifiedGroupName), &
+ tracerGroupInteriorRestoringValue)
+ call ocn_tracer_interior_restoring_compute(nTracerGroup, nCells, maxLevelCell, layerThickness, &
+ tracerGroup, tracerGroupInteriorRestoringRate, tracerGroupInteriorRestoringValue, tracerGroupTend, err)
+ call mpas_timer_stop("interior_restoring_" // trim(groupItr % memberName))
+ endif
+
+ !
+ ! exponential decay tendency
+ !
+ if (config_use_tracerGroup_exponential_decay) then
+ write (stderrUnit,'(a)') 'exponential decay not fully tested'
+ call mpas_pool_get_subpool(forcingPool, 'tracersExponentialDecayFields', tracersExponentialDecayFieldsPool)
+ modifiedGroupName = trim(groupItr % memberName) // "ExponentialDecayRate"
+ call mpas_pool_get_array(tracersExponentialDecayFieldsPool, trim(modifiedGroupName), &
+ tracerGroupExponentialDecayRate)
+ call ocn_tracer_exponential_decay_compute(nTracerGroup, nCells, maxLevelCell, layerThickness, &
+ tracerGroup, tracerGroupExponentialDecayRate, tracerGroupTend, err)
+ endif
+
+ !
+ ! ideal age forcing tendency
+ ! note: ocn_tracer_ideal_age_compute resets tracers in top layer to zero
+ !
+ if (config_use_tracerGroup_idealAge_forcing) then
+ write (stderrUnit,'(a)') 'ideal age not fully tested'
+ call mpas_pool_get_subpool(forcingPool, 'tracersIdealAgeFields', tracersIdealAgeFieldsPool)
+ modifiedGroupName = trim(groupItr % memberName) // "IdealAgeMask"
+ call mpas_pool_get_array(tracersIdealAgeFieldsPool, trim(modifiedGroupName), tracerGroupIdealAgeMask)
+ call ocn_tracer_ideal_age_compute(nTracerGroup, nCells, maxLevelCell, layerThickness, &
+ tracerGroupIdealAgeMask, tracerGroup, tracerGroupTend, err)
+ endif
+
+ !
+ ! transit-time distribution (TTD) forcing tendency
+ ! note: no tendency is actually computed in ocn_tracer_TTD_compute
+ ! note: rather, tracerGroup is reset to tracerGroupTTDMask in top-most layer
+ !
+ if (config_use_tracerGroup_ttd_forcing) then
+ write (stderrUnit,'(a)') 'ideal age not fully tested'
+ call mpas_pool_get_subpool(forcingPool, 'tracersTTDFields', tracersTTDFieldsPool)
+ modifiedGroupName = trim(groupItr % memberName) // "TTDMask"
+ call mpas_pool_get_array(tracersTTDFieldsPool, trim(modifiedGroupName), tracerGroupTTDMask)
+ call ocn_tracer_TTD_compute(nTracerGroup, nCells, maxLevelCell, layerThickness, &
+ tracerGroupTTDMask, tracerGroup, err)
+ endif
+
+ !
+ ! tracer tendency: horizontal advection term -div( layerThickness \phi u)
+ !
+
+ ! Monotonoic Advection, or standard advection
+ call mpas_timer_start("adv")
+ call ocn_tracer_advection_tend(tracerGroup, normalThicknessFlux, vertAleTransportTop, layerThickness, &
+ layerThickness, dt, meshPool, scratchPool, tend_layerThickness, tracerGroupTend)
+ call mpas_timer_stop("adv")
+
+ !
+ ! tracer tendency: del2 horizontal tracer diffusion, div(h \kappa_2 \nabla \phi)
+ !
+ call mpas_timer_start("hmix")
+ call ocn_tracer_hmix_tend(meshPool, scratchPool, layerThicknessEdge, zMid, tracerGroup, &
+ relativeSlopeTopOfEdge, relativeSlopeTapering, relativeSlopeTaperingCell, &
+ tracerGroupTend, err)
+ call mpas_timer_stop("hmix")
+
+ !
+ ! convert the surface tracer flux into a tracer tendency by distributing the flux across some number
+ ! of surface layers
+ !
+ call mpas_timer_start("surface_tracer_flux")
+ call ocn_tracer_surface_flux_tend(meshPool, fractionAbsorbed, fractionAbsorbedRunoff, layerThickness, &
+ tracerGroupSurfaceFlux, tracerGroupSurfaceFluxRunoff, &
+ tracerGroupTend, err)
+ call mpas_timer_stop("surface_tracer_flux")
+
+ !
+ ! Performing shortwave absorption
+ !
+ if ( trim(groupItr % memberName) == 'activeTracers' ) then
+ call mpas_timer_start("short wave")
+ call ocn_tracer_short_wave_absorption_tend(meshPool, swForcingPool, forcingPool, indexTemperature, &
+ layerThickness, penetrativeTemperatureFlux, penetrativeTemperatureFluxOBL, tracerGroupTend, err)
+ call mpas_timer_stop("short wave")
+ endif
+
+ !
+ ! Compute tracer tendency due to non-local flux computed in KPP
+ !
+ if (config_use_cvmix_kpp) then
+ call mpas_timer_start("non-local flux from KPP")
+ if( trim(groupItr % memberName) == 'activeTracers' ) then
+ call ocn_tracer_nonlocalflux_tend(meshPool, vertNonLocalFlux, nonLocalSurfaceTracerFlux, tracerGroupTend, err)
+ else
+ call ocn_tracer_nonlocalflux_tend(meshPool, vertNonLocalFlux, tracerGroupSurfaceFlux, tracerGroupTend, err)
+ endif
+ call mpas_timer_stop("non-local flux from KPP")
+ end if
+
+ !
+ ! Compute tracer tendency due to production/destruction of frazil ice
+ !
+ call mpas_timer_start("frazil")
+ call ocn_frazil_forcing_tracers(meshPool, tracersPool, groupItr%memberName, forcingPool, tracerGroupTend, err)
+ call mpas_timer_stop("frazil")
+
+ end if
+ end if
+ end do
call mpas_timer_stop("ocn_tend_tracer")
- deallocate(normalThicknessFlux)
+ call mpas_threading_barrier()
+ call mpas_deallocate_scratch_field(normalThicknessFluxField, .true.)
end subroutine ocn_tend_tracer!}}}
@@ -443,8 +840,8 @@ end subroutine ocn_tend_tracer!}}}
!> \brief Compute tendencies needed for frequency filtered thickness
!> \author Mark Petersen
!> \date July 2013
-!> \details
-!> This routine compute high frequency thickness tendency and the
+!> \details
+!> This routine compute high frequency thickness tendency and the
!> low freqency divergence. It is only called when
!> config_freq_filtered_thickness is true (z-tilde)
!
@@ -475,6 +872,7 @@ subroutine ocn_tend_freq_filtered_thickness(tendPool, statePool, diagnosticsPool
real (kind=RKIND), pointer :: config_thickness_filter_timescale, config_highFreqThick_restore_time
call mpas_timer_start("ocn_tend_freq_filtered_thickness")
+
err = 0
if (present(timeLevelIn)) then
@@ -507,21 +905,23 @@ subroutine ocn_tend_freq_filtered_thickness(tendPool, statePool, diagnosticsPool
call mpas_pool_get_array(tendPool, 'lowFreqDivergence', tend_lowFreqDivergence)
call mpas_pool_get_array(tendPool, 'highFreqThickness', tend_highFreqThickness)
- allocate(div_hu(nVertLevels))
-
!
! Low Frequency Divergence and high frequency thickness Tendency
!
- tend_lowFreqDivergence = 0.0
- tend_highFreqThickness = 0.0
! Convert restore time from days to seconds
- thickness_filter_timescale_sec = config_thickness_filter_timescale*86400.0
- highFreqThick_restore_time_sec = config_highFreqThick_restore_time*86400.0
+ thickness_filter_timescale_sec = config_thickness_filter_timescale*86400.0_RKIND
+ highFreqThick_restore_time_sec = config_highFreqThick_restore_time*86400.0_RKIND
+
+ allocate(div_hu(nVertLevels))
+
+ !$omp do schedule(runtime) private(div_hu_btr, invAreaCell, i, iEdge, k, totalThickness, flux)
do iCell = 1, nCells
- div_hu(:) = 0.0
- div_hu_btr = 0.0
- invAreaCell = 1.0 / areaCell(iCell)
+ tend_lowFreqDivergence(:, iCell) = 0.0_RKIND
+ tend_highFreqThickness(:, iCell) = 0.0_RKIND
+ div_hu(:) = 0.0_RKIND
+ div_hu_btr = 0.0_RKIND
+ invAreaCell = 1.0_RKIND / areaCell(iCell)
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
@@ -546,8 +946,8 @@ subroutine ocn_tend_freq_filtered_thickness(tendPool, statePool, diagnosticsPool
+ use_highFreqThick_restore*( -2.0 * pii / highFreqThick_restore_time_sec * highFreqThickness(k,iCell) )
end do
-
end do
+ !$omp end do
deallocate(div_hu)
@@ -569,7 +969,7 @@ end subroutine ocn_tend_freq_filtered_thickness!}}}
!> \brief Initializes flags used within tendency routines.
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date 4 November 2011
-!> \details
+!> \details
!> This routine initializes flags related to quantities computed within
!> other tendency routines.
!
diff --git a/src/core_ocean/shared/mpas_ocn_test.F b/src/core_ocean/shared/mpas_ocn_test.F
index 0a1aae428e..366c01da3a 100644
--- a/src/core_ocean/shared/mpas_ocn_test.F
+++ b/src/core_ocean/shared/mpas_ocn_test.F
@@ -69,7 +69,7 @@ module ocn_test
!> \brief Call all internal start-up tests
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date October 2013
-!> \details
+!> \details
!> Call all routines to test various MPAS-Ocean components.
!
!-----------------------------------------------------------------------
@@ -114,7 +114,7 @@ end subroutine ocn_test_suite!}}}
!> \brief set up scratch variables to test strain rate and tensor divergence operators
!> \author Mark Petersen
!> \date May 2013
-!> \details
+!> \details
!> This routine sets up scratch variables to test strain rate and tensor divergence operators.
!
!-----------------------------------------------------------------------
@@ -197,6 +197,7 @@ subroutine ocn_prep_test_tensor(domain,err)!{{{
call mpas_allocate_scratch_field(divTensorLonLatRCellSolutionField, .false.)
call mpas_allocate_scratch_field(outerProductEdgeField, .false.)
+
call mpas_test_tensor(domain, config_tensor_test_function, &
edgeSignOnCellField, &
edgeTangentVectorsField, &
@@ -214,6 +215,7 @@ subroutine ocn_prep_test_tensor(domain,err)!{{{
divTensorLonLatRCellSolutionField, &
outerProductEdgeField )
+
call mpas_deallocate_scratch_field(normalVelocityTestField, .false.)
call mpas_deallocate_scratch_field(tangentialVelocityTestField, .false.)
call mpas_deallocate_scratch_field(strainRateR3CellField, .false.)
@@ -239,7 +241,7 @@ end subroutine ocn_prep_test_tensor!}}}
!> \brief Initialize Gent-McWilliams test functions
!> \author Mark Petersen
!> \date May 2014
-!> \details
+!> \details
!> For the initial temperature distribution
!> T = T_1 + T_2*y/y_{max} + T_3*z/z_{max}
!> and linear EOS with T coefficient alpha, this subroutine computes
@@ -281,14 +283,13 @@ subroutine ocn_init_gm_test_functions(diagnosticsPool, meshPool, scratchPool)!{{
real(kind=RKIND) :: zTop, config_gm_analytic_temperature2, config_gm_analytic_temperature3, config_gm_analytic_ymax, &
config_gm_analytic_bottom_depth, L, R, c1, c2, zMax, zBot
- real (kind=RKIND), pointer :: config_gravWaveSpeed_trunc, config_density0, config_standardGM_tracer_kappa, config_eos_linear_alpha
+ real (kind=RKIND), pointer :: config_gravWaveSpeed_trunc, config_standardGM_tracer_kappa, config_eos_linear_alpha
real(kind=RKIND), dimension(:), pointer :: bottomDepth, refBottomDepthTopOfCell, yCell, yEdge
real(kind=RKIND), dimension(:,:), pointer :: yRelativeSlopeSolution, yGMStreamFuncSolution, yGMBolusVelocitySolution, zMid
type (field2DReal), pointer :: yRelativeSlopeSolutionField, yGMStreamFuncSolutionField, yGMBolusVelocitySolutionField
- call mpas_pool_get_config(ocnConfigs, 'config_density0',config_density0)
call mpas_pool_get_config(ocnConfigs, 'config_eos_linear_alpha', config_eos_linear_alpha)
call mpas_pool_get_config(ocnConfigs, 'config_gravWaveSpeed_trunc',config_gravWaveSpeed_trunc)
call mpas_pool_get_config(ocnConfigs, 'config_standardGM_tracer_kappa',config_standardGM_tracer_kappa)
@@ -309,24 +310,26 @@ subroutine ocn_init_gm_test_functions(diagnosticsPool, meshPool, scratchPool)!{{
yRelativeSlopeSolution => yRelativeSlopeSolutionField % array
yGMStreamFuncSolution => yGMStreamFuncSolutionField % array
- yGMBolusVelocitySolution => yGMBolusVelocitySolutionField % array
+ yGMBolusVelocitySolution => yGMBolusVelocitySolutionField % array
! These are flags that must match your initial conditions settings. See gm_analytic initial condition in mode_init.
- config_gm_analytic_temperature2 = 10;
- config_gm_analytic_temperature3 = -10;
- config_gm_analytic_ymax = 500000;
- config_gm_analytic_bottom_depth = 1000;
+ config_gm_analytic_temperature2 = 10
+ config_gm_analytic_temperature3 = -10
+ config_gm_analytic_ymax = 500000
+ config_gm_analytic_bottom_depth = 1000
! zMax is associated with linear temperature profile in z
- zMax = -config_gm_analytic_bottom_depth;
- ! zBot is location we apply boundary conditions on the ODE for stream function.
- zBot = zMax;
+ zMax = -config_gm_analytic_bottom_depth
+ ! zBot is location we apply boundary conditions on the ODE for stream function.
+ zBot = zMax
- L = config_gravWaveSpeed_trunc * sqrt(config_density0*zMax/gravity/config_eos_linear_alpha/config_gm_analytic_temperature3);
- R = - config_standardGM_tracer_kappa * config_gm_analytic_temperature2 * zMax / config_gm_analytic_temperature3 / config_gm_analytic_ymax;
- c1 = R*(1-exp(-zBot/L))/(exp(zBot/L) - exp(-zBot/L));
- c2 = R-c1;
+ L = config_gravWaveSpeed_trunc * sqrt(rho_sw * zMax / gravity / config_eos_linear_alpha / config_gm_analytic_temperature3)
+ R = - config_standardGM_tracer_kappa * config_gm_analytic_temperature2 * zMax / config_gm_analytic_temperature3 &
+ / config_gm_analytic_ymax
+ c1 = R*(1-exp(-zBot/L))/(exp(zBot/L) - exp(-zBot/L))
+ c2 = R-c1
+ !$omp do schedule(runtime) private(k, zTop)
do iCell = 1, nCells
do k = 1, maxLevelCell(iCell)
@@ -342,11 +345,12 @@ subroutine ocn_init_gm_test_functions(diagnosticsPool, meshPool, scratchPool)!{{
end do
k = maxLevelCell(iCell)+1
- ! placed at top interface, cell center.
- zTop = zBot
- yGMStreamFuncSolution(k,iCell) = c1*exp(zTop/L) + c2*exp(-zTop/L) - R;
+ ! placed at top interface, cell center.
+ zTop = zBot
+ yGMStreamFuncSolution(k,iCell) = c1*exp(zTop/L) + c2*exp(-zTop/L) - R;
end do
+ !$omp end do
end subroutine ocn_init_gm_test_functions!}}}
diff --git a/src/core_ocean/shared/mpas_ocn_thick_ale.F b/src/core_ocean/shared/mpas_ocn_thick_ale.F
index 02f4960631..7b10d3e841 100644
--- a/src/core_ocean/shared/mpas_ocn_thick_ale.F
+++ b/src/core_ocean/shared/mpas_ocn_thick_ale.F
@@ -62,14 +62,14 @@ module ocn_thick_ale
!> \brief Computes desired ALE thickness at new time
!> \author Mark Petersen
!> \date August 2013
-!> \details
+!> \details
!> This routine computes the desired Arbitrary Lagrangian-Eulerian (ALE)
-!> thickness at the new time. It uses the ALE formulation, and includes
+!> thickness at the new time. It uses the ALE formulation, and includes
!> contributions from SSH variations (z-star), high-frequency divergence
!> (z-tilde), and imposes a minimum layer thickness.
!
!-----------------------------------------------------------------------
- subroutine ocn_ALE_thickness(meshPool, verticalMeshPool, oldSSH, div_hu_btr, dt, ALE_thickness, err, newHighFreqThickness)!{{{
+ subroutine ocn_ALE_thickness(meshPool, verticalMeshPool, SSH, ALE_thickness, err, newHighFreqThickness)!{{{
!-----------------------------------------------------------------
!
@@ -84,15 +84,11 @@ subroutine ocn_ALE_thickness(meshPool, verticalMeshPool, oldSSH, div_hu_btr, dt,
verticalMeshPool !< Input: vertical mesh information
real (kind=RKIND), dimension(:), intent(in) :: &
- oldSSH, &!< Input: sea surface height at old time
- div_hu_btr !< Input: thickness-weighted barotropic divergence
+ SSH !< Input: sea surface height
real (kind=RKIND), dimension(:,:), intent(in), optional :: &
newHighFreqThickness !< Input: high frequency thickness. Alters ALE thickness.
- real (kind=RKIND), intent(in) :: &
- dt !< Input: time step
-
!-----------------------------------------------------------------
!
! output variables
@@ -114,7 +110,7 @@ subroutine ocn_ALE_thickness(meshPool, verticalMeshPool, oldSSH, div_hu_btr, dt,
integer, pointer :: nCells, nVertLevels
integer, dimension(:), pointer :: maxLevelCell
- real (kind=RKIND) :: thicknessSum, newSSH, remainder, newThickness, thicknessWithRemainder
+ real (kind=RKIND) :: thicknessSum, remainder, newThickness, thicknessWithRemainder
real (kind=RKIND), dimension(:), pointer :: vertCoordMovementWeights
real (kind=RKIND), dimension(:), allocatable :: &
SSH_ALE_thickness, & !> ALE thickness alteration due to SSH (z-star)
@@ -151,31 +147,34 @@ subroutine ocn_ALE_thickness(meshPool, verticalMeshPool, oldSSH, div_hu_btr, dt,
!
! ALE thickness alteration due to SSH (z-star)
!
+ !$omp do schedule(runtime) private(kMax, thicknessSum, k)
do iCell = 1, nCells
kMax = maxLevelCell(iCell)
- newSSH = oldSSH(iCell) - dt*div_hu_btr(iCell)
- thicknessSum = 1e-14
+ thicknessSum = 1e-14_RKIND
do k = 1, kMax
- SSH_ALE_Thickness(k) = newSSH * vertCoordMovementWeights(k) * restingThickness(k, iCell)
+ SSH_ALE_Thickness(k) = SSH(iCell) * vertCoordMovementWeights(k) * restingThickness(k, iCell)
thicknessSum = thicknessSum + vertCoordMovementWeights(k) * restingThickness(k, iCell)
end do
- SSH_ALE_Thickness = SSH_ALE_Thickness / thicknessSum
! Note that restingThickness is nonzero, and remaining terms are perturbations about zero.
- ALE_Thickness(1:kMax, iCell) = &
- restingThickness(1:kMax,iCell) &
- + SSH_ALE_Thickness(1:kMax)
+ do k = 1, kMax
+ SSH_ALE_Thickness(k) = SSH_ALE_Thickness(k) / thicknessSum
+ ALE_Thickness(k, iCell) = restingThickness(k, iCell) + SSH_ALE_Thickness(k)
+ end do
enddo
+ !$omp end do
if (thicknessFilterActive) then
+ !$omp do schedule(runtime) private(kMax)
do iCell = 1, nCells
kMax = maxLevelCell(iCell)
-
+
ALE_Thickness(1:kMax, iCell) = &
ALE_Thickness(1:kMax, iCell) &
+ newHighFreqThickness(1:kMax,iCell)
enddo
+ !$omp end do
end if
!
@@ -183,31 +182,38 @@ subroutine ocn_ALE_thickness(meshPool, verticalMeshPool, oldSSH, div_hu_btr, dt,
!
if (config_use_min_max_thickness) then
+ !$omp do schedule(runtime) private(kMax, remainder, k, newThickness)
do iCell = 1, nCells
kMax = maxLevelCell(iCell)
! go down the column:
prelim_ALE_Thickness(1:kMax) = ALE_Thickness(1:kMax, iCell)
- remainder = 0.0
+ remainder = 0.0_RKIND
do k = 1, kMax
- newThickness = max(min(prelim_ALE_Thickness(k) + remainder, config_max_thickness_factor * restingThickness(k,iCell)), config_min_thickness)
- min_ALE_thickness_down(k) = newThickness - prelim_ALE_Thickness(k)
+ newThickness = max( min(prelim_ALE_Thickness(k) + remainder, &
+ config_max_thickness_factor * restingThickness(k,iCell) ), &
+ config_min_thickness)
+ min_ALE_thickness_down(k) = newThickness - prelim_ALE_Thickness(k)
remainder = remainder - min_ALE_thickness_down(k)
end do
! go back up the column:
- min_ALE_thickness_up(kMax) = 0.0
+ min_ALE_thickness_up(kMax) = 0.0_RKIND
prelim_ALE_Thickness(1:kMax) = prelim_ALE_Thickness(1:kMax) + min_ALE_thickness_down(1:kMax)
do k = kMax-1, 1, -1
- newThickness = max(min(prelim_ALE_Thickness(k) + remainder, config_max_thickness_factor * restingThickness(k,iCell)), config_min_thickness)
- min_ALE_thickness_up(k) = newThickness - prelim_ALE_Thickness(k)
+ newThickness = max( min(prelim_ALE_Thickness(k) + remainder, &
+ config_max_thickness_factor * restingThickness(k,iCell) ), &
+ config_min_thickness)
+ min_ALE_thickness_up(k) = newThickness - prelim_ALE_Thickness(k)
remainder = remainder - min_ALE_thickness_up(k)
end do
min_ALE_thickness_up(1) = min_ALE_thickness_up(1) + remainder
- ALE_Thickness(1:kMax, iCell) = ALE_Thickness(1:kMax, iCell) + min_ALE_thickness_down(1:kMax) + min_ALE_thickness_up(1:kMax)
+ ALE_Thickness(1:kMax, iCell) = ALE_Thickness(1:kMax, iCell) + min_ALE_thickness_down(1:kMax) &
+ + min_ALE_thickness_up(1:kMax)
enddo
+ !$omp end do
endif ! config_use_min_max_thickness
@@ -222,7 +228,7 @@ end subroutine ocn_ALE_thickness!}}}
!> \brief Initializes flags used within diagnostics routines.
!> \author Mark Petersen
!> \date August 2013
-!> \details
+!> \details
!> This routine initializes flags related to quantities computed within
!> other diagnostics routines.
!
diff --git a/src/core_ocean/shared/mpas_ocn_thick_hadv.F b/src/core_ocean/shared/mpas_ocn_thick_hadv.F
index 9b6433133b..74ef8c329f 100644
--- a/src/core_ocean/shared/mpas_ocn_thick_hadv.F
+++ b/src/core_ocean/shared/mpas_ocn_thick_hadv.F
@@ -13,7 +13,7 @@
!> \author Doug Jacobsen
!> \date 16 September 2011
!> \details
-!> This module contains the routine for computing
+!> This module contains the routine for computing
!> tendencies for thickness from horizontal advection
!
!-----------------------------------------------------------------------
@@ -48,7 +48,7 @@ module ocn_thick_hadv
! Private module variables
!
!--------------------------------------------------------------------
-
+
logical :: thickHadvOn
!***********************************************************************
@@ -62,7 +62,7 @@ module ocn_thick_hadv
!> \brief Computes tendency term from horizontal advection of thickness
!> \author Doug Jacobsen
!> \date 15 September 2011
-!> \details
+!> \details
!> This routine computes the horizontal advection tendency for
!> thicknes based on current state and user choices of forcings.
!
@@ -108,7 +108,7 @@ subroutine ocn_thick_hadv_tend(meshPool, normalVelocity, layerThicknessEdge, ten
!
!-----------------------------------------------------------------
- integer :: iEdge, cell1, cell2, k, i, iCell
+ integer :: iEdge, cell1, cell2, k, i, iCell
integer, pointer :: nCells, nEdges, nVertLevels
integer, dimension(:), pointer :: maxLevelEdgeBot, MaxLevelCell, nEdgesOnCell
@@ -120,7 +120,7 @@ subroutine ocn_thick_hadv_tend(meshPool, normalVelocity, layerThicknessEdge, ten
!-----------------------------------------------------------------
!
! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
+ ! note that the user can choose multiple options and the
! tendencies will be added together
!
!-----------------------------------------------------------------
@@ -143,8 +143,9 @@ subroutine ocn_thick_hadv_tend(meshPool, normalVelocity, layerThicknessEdge, ten
call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell)
call mpas_pool_get_array(meshPool, 'edgeSignOnCell', edgeSignOnCell)
+ !$omp do schedule(runtime) private(invAreaCell, i, iEdge, k, flux)
do iCell = 1, nCells
- invAreaCell = 1.0 / areaCell(iCell)
+ invAreaCell = 1.0_RKIND / areaCell(iCell)
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
do k = 1, maxLevelEdgeBot(iEdge)
@@ -153,6 +154,7 @@ subroutine ocn_thick_hadv_tend(meshPool, normalVelocity, layerThicknessEdge, ten
end do
end do
end do
+ !$omp end do
!--------------------------------------------------------------------
@@ -165,9 +167,9 @@ end subroutine ocn_thick_hadv_tend!}}}
!> \brief Initializes ocean horizontal thickness advection
!> \author Doug Jacobsen
!> \date 16 September 2011
-!> \details
-!> This routine initializes quantities related to horizontal thickness
-!> advection in the ocean.
+!> \details
+!> This routine initializes quantities related to horizontal thickness
+!> advection in the ocean.
!
!-----------------------------------------------------------------------
diff --git a/src/core_ocean/shared/mpas_ocn_thick_surface_flux.F b/src/core_ocean/shared/mpas_ocn_thick_surface_flux.F
index 8593715cd2..aa1369e639 100644
--- a/src/core_ocean/shared/mpas_ocn_thick_surface_flux.F
+++ b/src/core_ocean/shared/mpas_ocn_thick_surface_flux.F
@@ -13,7 +13,7 @@
!> \author Doug Jacobsen
!> \date 12/17/12
!> \details
-!> This module contains the routine for computing
+!> This module contains the routine for computing
!> tendencies for thickness from surface fluxes
!
!-----------------------------------------------------------------------
@@ -64,13 +64,14 @@ module ocn_thick_surface_flux
!> \brief Computes tendency term from horizontal advection of thickness
!> \author Doug Jacobsen
!> \date 15 September 2011
-!> \details
+!> \details
!> This routine computes the horizontal advection tendency for
!> thicknes based on current state and user choices of forcings.
!
!-----------------------------------------------------------------------
- subroutine ocn_thick_surface_flux_tend(meshPool, transmissionCoefficients, layerThickness, surfaceThicknessFlux, tend, err)!{{{
+ subroutine ocn_thick_surface_flux_tend(meshPool, transmissionCoefficients, transmissionCoefficientsRunoff, &
+ layerThickness, surfaceThicknessFlux, surfaceThicknessFluxRunoff, tend, err)!{{{
!-----------------------------------------------------------------
!
! input variables
@@ -81,13 +82,15 @@ subroutine ocn_thick_surface_flux_tend(meshPool, transmissionCoefficients, layer
meshPool !< Input: mesh information
real (kind=RKIND), dimension(:,:), intent(in) :: &
- transmissionCoefficients !< Input: Coefficients for the transmission of surface fluxes
+ transmissionCoefficients, &!< Input: Coefficients for the transmission of surface fluxes
+ transmissionCoefficientsRunoff !< Input: Coefficients for the transmission of surface fluxes due to river runoff
real (kind=RKIND), dimension(:,:), intent(in) :: &
layerThickness !< Input: Layer thickness
real (kind=RKIND), dimension(:), intent(in) :: &
- surfaceThicknessFlux !< Input: surface flux of thickness
+ surfaceThicknessFlux, &!< Input: surface flux of thickness
+ surfaceThicknessFluxRunoff !< Input: surface flux of thickness due to river runoff
!-----------------------------------------------------------------
@@ -116,31 +119,39 @@ subroutine ocn_thick_surface_flux_tend(meshPool, transmissionCoefficients, layer
integer :: iCell, k
integer, pointer :: nCells, nVertLevels
integer, dimension(:), pointer :: maxLevelCell
- integer, dimension(:,:), pointer :: cellMask
- real (kind=RKIND) :: remainingFlux
+ real (kind=RKIND) :: remainingFlux, remainingFluxRunoff
err = 0
if (.not. surfaceThicknessFluxOn) return
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
- call mpas_pool_get_array(meshPool, 'cellMask', cellMask)
call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ !$omp do schedule(runtime) private(remainingFlux, remainingFluxRunoff, k)
do iCell = 1, nCells
remainingFlux = 1.0_RKIND
+ remainingFluxRunoff = 1.0_RKIND
do k = 1, maxLevelCell(iCell)
remainingFlux = remainingFlux - transmissionCoefficients(k, iCell)
+ remainingFluxRunoff = remainingFluxRunoff - transmissionCoefficientsRunoff(k, iCell)
- tend(k, iCell) = tend(k, iCell) + cellMask(k, iCell) * surfaceThicknessFlux(iCell) * transmissionCoefficients(k, iCell)
+ tend(k, iCell) = tend(k, iCell) + surfaceThicknessFlux(iCell) * transmissionCoefficients(k, iCell) &
+ + surfaceThicknessFluxRunoff(iCell) * transmissionCoefficientsRunoff(k, iCell)
end do
if(maxLevelCell(iCell) > 0 .and. remainingFlux > 0.0_RKIND) then
- tend(maxLevelCell(iCell), iCell) = tend(maxLevelCell(iCell), iCell) + cellMask(maxLevelCell(iCell), iCell) * remainingFlux * surfaceThicknessFlux(iCell)
+ tend(maxLevelCell(iCell), iCell) = tend(maxLevelCell(iCell), iCell) + remainingFlux * surfaceThicknessFlux(iCell)
+ end if
+
+ if(maxLevelCell(iCell) > 0 .and. remainingFluxRunoff > 0.0_RKIND) then
+ tend(maxLevelCell(iCell), iCell) = tend(maxLevelCell(iCell), iCell) &
+ + remainingFluxRunoff * surfaceThicknessFluxRunoff(iCell)
end if
end do
+ !$omp end do
!--------------------------------------------------------------------
@@ -153,9 +164,9 @@ end subroutine ocn_thick_surface_flux_tend!}}}
!> \brief Initializes ocean horizontal thickness surface fluxes
!> \author Doug Jacobsen
!> \date 12/17/12
-!> \details
-!> This routine initializes quantities related to thickness
-!> surface fluxes in the ocean.
+!> \details
+!> This routine initializes quantities related to thickness
+!> surface fluxes in the ocean.
!
!-----------------------------------------------------------------------
@@ -172,12 +183,10 @@ subroutine ocn_thick_surface_flux_init(err)!{{{
integer, intent(out) :: err !< Output: error flag
logical, pointer :: config_disable_thick_sflux
- character (len=StrKIND), pointer :: config_forcing_type
err = 0
call mpas_pool_get_config(ocnConfigs, 'config_disable_thick_sflux', config_disable_thick_sflux)
- call mpas_pool_get_config(ocnConfigs, 'config_forcing_type', config_forcing_type)
surfaceThicknessFluxOn = .true.
@@ -185,11 +194,6 @@ subroutine ocn_thick_surface_flux_init(err)!{{{
surfaceThicknessFluxOn = .false.
end if
- if (config_forcing_type == trim('off')) then
- surfaceThicknessFluxOn = .false.
- end if
-
-
!--------------------------------------------------------------------
end subroutine ocn_thick_surface_flux_init!}}}
diff --git a/src/core_ocean/shared/mpas_ocn_thick_vadv.F b/src/core_ocean/shared/mpas_ocn_thick_vadv.F
index ba1f5a096d..370607d85d 100644
--- a/src/core_ocean/shared/mpas_ocn_thick_vadv.F
+++ b/src/core_ocean/shared/mpas_ocn_thick_vadv.F
@@ -13,7 +13,7 @@
!> \author Doug Jacobsen
!> \date 16 September 2011
!> \details
-!> This module contains the routine for computing
+!> This module contains the routine for computing
!> tendencies for thickness from vertical advection
!
!-----------------------------------------------------------------------
@@ -62,7 +62,7 @@ module ocn_thick_vadv
!> \brief Computes tendency term from vertical advection of thickness
!> \author Doug Jacobsen
!> \date 15 September 2011
-!> \details
+!> \details
!> This routine computes the vertical advection tendency for
!> thicknes based on current state and user choices of forcings.
!
@@ -112,7 +112,7 @@ subroutine ocn_thick_vadv_tend(meshPool, vertAleTransportTop, tend, err)!{{{
!-----------------------------------------------------------------
!
! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
+ ! note that the user can choose multiple options and the
! tendencies will be added together
!
!-----------------------------------------------------------------
@@ -126,11 +126,13 @@ subroutine ocn_thick_vadv_tend(meshPool, vertAleTransportTop, tend, err)!{{{
call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ !$omp do schedule(runtime) private(k)
do iCell = 1, nCells
do k = 1, maxLevelCell(iCell)
tend(k,iCell) = tend(k,iCell) + vertAleTransportTop(k+1,iCell) - vertAleTransportTop(k,iCell)
end do
end do
+ !$omp end do
!--------------------------------------------------------------------
@@ -143,9 +145,9 @@ end subroutine ocn_thick_vadv_tend!}}}
!> \brief Initializes ocean thickness vertical advection
!> \author Doug Jacobsen
!> \date 16 September 2011
-!> \details
-!> This routine initializes quantities related to vertical advection of
-!> thickness in the ocean.
+!> \details
+!> This routine initializes quantities related to vertical advection of
+!> thickness in the ocean.
!
!-----------------------------------------------------------------------
@@ -168,7 +170,7 @@ subroutine ocn_thick_vadv_init(err)!{{{
thickVadvOn = .true.
if(config_disable_thick_vadv) thickVadvOn = .false.
-
+
err = 0
!--------------------------------------------------------------------
diff --git a/src/core_ocean/shared/mpas_ocn_time_average.F b/src/core_ocean/shared/mpas_ocn_time_average.F
deleted file mode 100644
index 82aa016364..0000000000
--- a/src/core_ocean/shared/mpas_ocn_time_average.F
+++ /dev/null
@@ -1,215 +0,0 @@
-! 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 ocn_time_average
-
- use mpas_derived_types
- use mpas_pool_routines
-
- implicit none
- save
- public
-
- contains
-
- subroutine ocn_time_average_init(averagePool)!{{{
- type (mpas_pool_type), intent(inout) :: averagePool
-
- real (kind=RKIND), pointer :: nAverage
-
- real (kind=RKIND), dimension(:), pointer :: avgSSH, varSSH
- real (kind=RKIND), dimension(:,:), pointer :: &
- avgNormalVelocity, avgVelocityZonal, avgVelocityMeridional, avgVertVelocityTop, &
- varNormalVelocity, varVelocityZonal, varVelocityMeridional, &
- avgNormalTransportVelocity, avgTransportVelocityZonal, avgTransportVelocityMeridional, avgVertTransportVelocityTop, &
- avgNormalGMBolusVelocity, avgGMBolusVelocityZonal, avgGMBolusVelocityMeridional, avgVertGMBolusVelocityTop
-
- call mpas_pool_get_array(averagePool, 'nAverage', nAverage)
- call mpas_pool_get_array(averagePool, 'avgSSH', avgSSH)
- call mpas_pool_get_array(averagePool, 'varSSH', varSSH)
- call mpas_pool_get_array(averagePool, 'avgNormalVelocity', avgNormalVelocity)
- call mpas_pool_get_array(averagePool, 'avgVelocityZonal', avgVelocityZonal)
- call mpas_pool_get_array(averagePool, 'avgVelocityMeridional', avgVelocityMeridional)
- call mpas_pool_get_array(averagePool, 'avgVertVelocityTop', avgVertVelocityTop)
- call mpas_pool_get_array(averagePool, 'varNormalVelocity', varNormalVelocity)
- call mpas_pool_get_array(averagePool, 'varVelocityZonal', varVelocityZonal)
- call mpas_pool_get_array(averagePool, 'varVelocityMeridional', varVelocityMeridional)
- call mpas_pool_get_array(averagePool, 'avgNormalTransportVelocity', avgNormalTransportVelocity)
- call mpas_pool_get_array(averagePool, 'avgTransportVelocityZonal', avgTransportVelocityZonal)
- call mpas_pool_get_array(averagePool, 'avgTransportVelocityMeridional', avgTransportVelocityMeridional)
- call mpas_pool_get_array(averagePool, 'avgVertTransportVelocityTop', avgVertTransportVelocityTop)
- call mpas_pool_get_array(averagePool, 'avgNormalGMBolusVelocity', avgNormalGMBolusVelocity)
- call mpas_pool_get_array(averagePool, 'avgGMBolusVelocityZonal', avgGMBolusVelocityZonal)
- call mpas_pool_get_array(averagePool, 'avgGMBolusVelocityMeridional', avgGMBolusVelocityMeridional)
- call mpas_pool_get_array(averagePool, 'avgVertGMBolusVelocityTop', avgVertGMBolusVelocityTop)
-
- nAverage = 0
-
- avgSSH = 0.0
- varSSH = 0.0
- avgNormalVelocity = 0.0
- avgVelocityZonal = 0.0
- avgVelocityMeridional = 0.0
- avgVertVelocityTop = 0.0
- varNormalVelocity = 0.0
- varVelocityZonal = 0.0
- varVelocityMeridional = 0.0
- avgNormalTransportVelocity = 0.0
- avgTransportVelocityZonal = 0.0
- avgTransportVelocityMeridional = 0.0
- avgVertTransportVelocityTop = 0.0
- avgNormalGMBolusVelocity = 0.0
- avgGMBolusVelocityZonal = 0.0
- avgGMBolusVelocityMeridional = 0.0
- avgVertGMBolusVelocityTop = 0.0
-
- end subroutine ocn_time_average_init!}}}
-
- subroutine ocn_time_average_accumulate(averagePool, statePool, diagnosticsPool, timeLevelIn)!{{{
- type (mpas_pool_type), intent(inout) :: averagePool
- type (mpas_pool_type), intent(in) :: statePool
- type (mpas_pool_type), intent(in) :: diagnosticsPool
- integer, intent(in), optional :: timeLevelIn
-
- real (kind=RKIND), pointer :: nAverage, old_nAverage
-
- real (kind=RKIND), dimension(:), pointer :: ssh
- real (kind=RKIND), dimension(:,:), pointer :: &
- velocityZonal, velocityMeridional, normalVelocity, vertVelocityTop, &
- transportVelocityZonal, transportVelocityMeridional, normalTransportVelocity, vertTransportVelocityTop, &
- GMBolusVelocityZonal, GMBolusVelocityMeridional, normalGMBolusVelocity, vertGMBolusVelocityTop
-
- real (kind=RKIND), dimension(:), pointer :: avgSSH, varSSH
- real (kind=RKIND), dimension(:,:), pointer :: &
- avgNormalVelocity, avgVelocityZonal, avgVelocityMeridional, avgVertVelocityTop, &
- varNormalVelocity, varVelocityZonal, varVelocityMeridional, &
- avgNormalTransportVelocity, avgTransportVelocityZonal, avgTransportVelocityMeridional, avgVertTransportVelocityTop, &
- avgNormalGMBolusVelocity, avgGMBolusVelocityZonal, avgGMBolusVelocityMeridional, avgVertGMBolusVelocityTop
-
- real (kind=RKIND), dimension(:), pointer :: old_avgSSH, old_varSSH
- real (kind=RKIND), dimension(:,:), pointer :: &
- old_avgNormalVelocity, old_avgVelocityZonal, old_avgVelocityMeridional, old_avgVertVelocityTop, &
- old_varNormalVelocity, old_varVelocityZonal, old_varVelocityMeridional, &
- old_avgNormalTransportVelocity, old_avgTransportVelocityZonal, old_avgTransportVelocityMeridional, old_avgVertTransportVelocityTop, &
- old_avgNormalGMBolusVelocity, old_avgGMBolusVelocityZonal, old_avgGMBolusVelocityMeridional, old_avgVertGMBolusVelocityTop
-
- integer :: timeLevel
-
- if (present(timeLevelIn)) then
- timeLevel = timeLevelIn
- else
- timeLevel = 1
- end if
-
- call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, timeLevel)
- call mpas_pool_get_array(statePool, 'ssh', ssh, timeLevel)
-
- call mpas_pool_get_array(diagnosticsPool, 'velocityZonal', velocityZonal)
- call mpas_pool_get_array(diagnosticsPool, 'velocityMeridional', velocityMeridional)
- call mpas_pool_get_array(diagnosticsPool, 'vertVelocityTop', vertVelocityTop)
- call mpas_pool_get_array(diagnosticsPool, 'normalTransportVelocity ', normalTransportVelocity)
- call mpas_pool_get_array(diagnosticsPool, 'transportVelocityZonal', transportVelocityZonal)
- call mpas_pool_get_array(diagnosticsPool, 'transportVelocityMeridional', transportVelocityMeridional)
- call mpas_pool_get_array(diagnosticsPool, 'vertTransportVelocityTop', vertTransportVelocityTop)
- call mpas_pool_get_array(diagnosticsPool, 'normalGMBolusVelocity', normalGMBolusVelocity)
- call mpas_pool_get_array(diagnosticsPool, 'GMBolusVelocityZonal', GMBolusVelocityZonal)
- call mpas_pool_get_array(diagnosticsPool, 'GMBolusVelocityMeridional', GMBolusVelocityMeridional)
- call mpas_pool_get_array(diagnosticsPool, 'vertGMBolusVelocityTop', vertGMBolusVelocityTop)
-
- call mpas_pool_get_array(averagePool, 'nAverage', nAverage)
- call mpas_pool_get_array(averagePool, 'avgSSH', avgSSH)
- call mpas_pool_get_array(averagePool, 'varSSH', varSSH)
- call mpas_pool_get_array(averagePool, 'avgNormalVelocity', avgNormalVelocity)
- call mpas_pool_get_array(averagePool, 'avgVelocityZonal', avgVelocityZonal)
- call mpas_pool_get_array(averagePool, 'avgVelocityMeridional', avgVelocityMeridional)
- call mpas_pool_get_array(averagePool, 'avgVertVelocityTop', avgVertVelocityTop)
- call mpas_pool_get_array(averagePool, 'varNormalVelocity', varNormalVelocity)
- call mpas_pool_get_array(averagePool, 'varVelocityZonal', varVelocityZonal)
- call mpas_pool_get_array(averagePool, 'varVelocityMeridional', varVelocityMeridional)
- call mpas_pool_get_array(averagePool, 'avgNormalTransportVelocity', avgNormalTransportVelocity)
- call mpas_pool_get_array(averagePool, 'avgTransportVelocityZonal', avgTransportVelocityZonal)
- call mpas_pool_get_array(averagePool, 'avgTransportVelocityMeridional', avgTransportVelocityMeridional)
- call mpas_pool_get_array(averagePool, 'avgVertTransportVelocityTop', avgVertTransportVelocityTop)
- call mpas_pool_get_array(averagePool, 'avgNormalGMBolusVelocity', avgNormalGMBolusVelocity)
- call mpas_pool_get_array(averagePool, 'avgGMBolusVelocityZonal', avgGMBolusVelocityZonal)
- call mpas_pool_get_array(averagePool, 'avgGMBolusVelocityMeridional', avgGMBolusVelocityMeridional)
- call mpas_pool_get_array(averagePool, 'avgVertGMBolusVelocityTop', avgVertGMBolusVelocityTop)
-
- avgSSH = avgSSH + ssh
- varSSH = varSSH + ssh**2
- avgNormalVelocity = avgNormalVelocity + normalVelocity
- avgVelocityZonal = avgVelocityZonal + velocityZonal
- avgVelocityMeridional = avgVelocityMeridional + velocityMeridional
- avgVertVelocityTop = avgVertVelocityTop + vertVelocityTop
- varNormalVelocity = varNormalVelocity + normalVelocity**2
- varVelocityZonal = varVelocityZonal + velocityZonal**2
- varVelocityMeridional = varVelocityMeridional + velocityMeridional**2
- avgNormalTransportVelocity = avgNormalTransportVelocity + normalTransportVelocity
- avgTransportVelocityZonal = avgTransportVelocityZonal + transportVelocityZonal
- avgTransportVelocityMeridional = avgTransportVelocityMeridional + transportVelocityMeridional
- avgVertTransportVelocityTop = avgVertTransportVelocityTop + vertTransportVelocityTop
- avgNormalGMBolusVelocity = avgNormalGMBolusVelocity + normalGMBolusVelocity
- avgGMBolusVelocityZonal = avgGMBolusVelocityZonal + GMBolusVelocityZonal
- avgGMBolusVelocityMeridional = avgGMBolusVelocityMeridional + GMBolusVelocityMeridional
- avgVertGMBolusVelocityTop = avgVertGMBolusVelocityTop + vertGMBolusVelocityTop
-
- nAverage = nAverage + 1
- end subroutine ocn_time_average_accumulate!}}}
-
- subroutine ocn_time_average_normalize(averagePool)!{{{
- type (mpas_pool_type), intent(inout) :: averagePool
-
- real (kind=RKIND), pointer :: nAverage
-
- real (kind=RKIND), dimension(:), pointer :: avgSSH, varSSH
- real (kind=RKIND), dimension(:,:), pointer :: &
- avgNormalVelocity, avgVelocityZonal, avgVelocityMeridional, avgVertVelocityTop, &
- varNormalVelocity, varVelocityZonal, varVelocityMeridional, &
- avgNormalTransportVelocity, avgTransportVelocityZonal, avgTransportVelocityMeridional, avgVertTransportVelocityTop, &
- avgNormalGMBolusVelocity, avgGMBolusVelocityZonal, avgGMBolusVelocityMeridional, avgVertGMBolusVelocityTop
-
- call mpas_pool_get_array(averagePool, 'nAverage', nAverage)
- call mpas_pool_get_array(averagePool, 'avgSSH', avgSSH)
- call mpas_pool_get_array(averagePool, 'varSSH', varSSH)
- call mpas_pool_get_array(averagePool, 'avgNormalVelocity', avgNormalVelocity)
- call mpas_pool_get_array(averagePool, 'avgVelocityZonal', avgVelocityZonal)
- call mpas_pool_get_array(averagePool, 'avgVelocityMeridional', avgVelocityMeridional)
- call mpas_pool_get_array(averagePool, 'avgVertVelocityTop', avgVertVelocityTop)
- call mpas_pool_get_array(averagePool, 'varNormalVelocity', varNormalVelocity)
- call mpas_pool_get_array(averagePool, 'varVelocityZonal', varVelocityZonal)
- call mpas_pool_get_array(averagePool, 'varVelocityMeridional', varVelocityMeridional)
- call mpas_pool_get_array(averagePool, 'avgNormalTransportVelocity', avgNormalTransportVelocity)
- call mpas_pool_get_array(averagePool, 'avgTransportVelocityZonal', avgTransportVelocityZonal)
- call mpas_pool_get_array(averagePool, 'avgTransportVelocityMeridional', avgTransportVelocityMeridional)
- call mpas_pool_get_array(averagePool, 'avgVertTransportVelocityTop', avgVertTransportVelocityTop)
- call mpas_pool_get_array(averagePool, 'avgNormalGMBolusVelocity', avgNormalGMBolusVelocity)
- call mpas_pool_get_array(averagePool, 'avgGMBolusVelocityZonal', avgGMBolusVelocityZonal)
- call mpas_pool_get_array(averagePool, 'avgGMBolusVelocityMeridional', avgGMBolusVelocityMeridional)
- call mpas_pool_get_array(averagePool, 'avgVertGMBolusVelocityTop', avgVertGMBolusVelocityTop)
-
- if(nAverage > 0) then
- avgSSH = avgSSH / nAverage
- varSSH = varSSH / nAverage
- avgNormalVelocity = avgNormalVelocity / nAverage
- avgVelocityZonal = avgVelocityZonal / nAverage
- avgVelocityMeridional = avgVelocityMeridional / nAverage
- avgVertVelocityTop = avgVertVelocityTop / nAverage
- varNormalVelocity = varNormalVelocity / nAverage
- varVelocityZonal = varVelocityZonal / nAverage
- varVelocityMeridional = varVelocityMeridional / nAverage
- avgNormalTransportVelocity = avgNormalTransportVelocity / nAverage
- avgTransportVelocityZonal = avgTransportVelocityZonal / nAverage
- avgTransportVelocityMeridional = avgTransportVelocityMeridional / nAverage
- avgVertTransportVelocityTop = avgVertTransportVelocityTop / nAverage
- avgNormalGMBolusVelocity = avgNormalGMBolusVelocity / nAverage
- avgGMBolusVelocityZonal = avgGMBolusVelocityZonal / nAverage
- avgGMBolusVelocityMeridional = avgGMBolusVelocityMeridional / nAverage
- avgVertGMBolusVelocityTop = avgVertGMBolusVelocityTop / nAverage
- end if
- end subroutine ocn_time_average_normalize!}}}
-
-end module ocn_time_average
diff --git a/src/core_ocean/shared/mpas_ocn_time_average_coupled.F b/src/core_ocean/shared/mpas_ocn_time_average_coupled.F
index 6df6612234..56dd4d8db4 100644
--- a/src/core_ocean/shared/mpas_ocn_time_average_coupled.F
+++ b/src/core_ocean/shared/mpas_ocn_time_average_coupled.F
@@ -29,7 +29,7 @@ module ocn_time_average_coupled
save
public
- contains
+ contains
!***********************************************************************
!
@@ -38,25 +38,51 @@ module ocn_time_average_coupled
!> \brief Coupled time averager initialization
!> \author Doug Jacobsen
!> \date 06/08/2013
-!> \details
+!> \details
!> This routine initializes the coupled time averaging fields
!
!-----------------------------------------------------------------------
subroutine ocn_time_average_coupled_init(forcingPool)!{{{
type (mpas_pool_type), intent(inout) :: forcingPool
- real (kind=RKIND), dimension(:,:), pointer :: avgTracersSurfaceValue, avgSurfaceVelocity, avgSSHGradient
+ real (kind=RKIND), dimension(:,:), pointer :: avgTracersSurfaceValue, avgSurfaceVelocity, avgSSHGradient, &
+ avgLandIceBoundaryLayerTracers, avgLandIceTracerTransferVelocities
+
+ real (kind=RKIND), dimension(:), pointer :: avgEffectiveDensityInLandIce
+ character (len=StrKIND), pointer :: config_land_ice_flux_mode
+
+ integer :: iCell
+ integer, pointer :: nAccumulatedCoupled, nCells
- integer, pointer :: nAccumulatedCoupled
+ call mpas_pool_get_dimension(forcingPool, 'nCells', nCells)
call mpas_pool_get_array(forcingPool, 'avgTracersSurfaceValue', avgTracersSurfaceValue)
call mpas_pool_get_array(forcingPool, 'avgSurfaceVelocity', avgSurfaceVelocity)
call mpas_pool_get_array(forcingPool, 'avgSSHGradient', avgSSHGradient)
call mpas_pool_get_array(forcingPool, 'nAccumulatedCoupled', nAccumulatedCoupled)
- avgTracersSurfaceValue(:,:) = 0.0_RKIND
- avgSurfaceVelocity(:,:) = 0.0_RKIND
- avgSSHGradient(:,:) = 0.0_RKIND
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ avgSurfaceVelocity(:, iCell) = 0.0_RKIND
+ avgTracersSurfaceValue(:, iCell) = 0.0_RKIND
+ avgSSHGradient(:, iCell) = 0.0_RKIND
+ end do
+ !$omp end do
+
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_mode', config_land_ice_flux_mode)
+ if(trim(config_land_ice_flux_mode) == 'coupled') then
+ call mpas_pool_get_array(forcingPool, 'avgLandIceBoundaryLayerTracers', avgLandIceBoundaryLayerTracers)
+ call mpas_pool_get_array(forcingPool, 'avgLandIceTracerTransferVelocities', avgLandIceTracerTransferVelocities)
+ call mpas_pool_get_array(forcingPool, 'avgEffectiveDensityInLandIce', avgEffectiveDensityInLandIce)
+
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ avgLandIceBoundaryLayerTracers(:, iCell) = 0.0_RKIND
+ avgLandIceTracerTransferVelocities(:, iCell) = 0.0_RKIND
+ avgEffectiveDensityInLandIce(iCell) = 0.0_RKIND
+ end do
+ !$omp end do
+ end if
nAccumulatedCoupled = 0
@@ -69,19 +95,26 @@ end subroutine ocn_time_average_coupled_init!}}}
!> \brief Coupled time averager accumulation
!> \author Doug Jacobsen
!> \date 06/08/2013
-!> \details
+!> \details
!> This routine accumulated the coupled time averaging fields
!
!-----------------------------------------------------------------------
- subroutine ocn_time_average_coupled_accumulate(diagnosticsPool, forcingPool)!{{{
+ subroutine ocn_time_average_coupled_accumulate(diagnosticsPool, statePool, forcingPool, timeLevel)!{{{
type (mpas_pool_type), intent(in) :: diagnosticsPool
+ type (mpas_pool_type), intent(in) :: statePool
type (mpas_pool_type), intent(inout) :: forcingPool
+ integer, intent(in) :: timeLevel
real (kind=RKIND), dimension(:,:), pointer :: surfaceVelocity, avgSurfaceVelocity
real (kind=RKIND), dimension(:,:), pointer :: tracersSurfaceValue, avgTracersSurfaceValue
real (kind=RKIND), dimension(:,:), pointer :: avgSSHGradient
- real (kind=RKIND), dimension(:,:), pointer :: gradSSHZonal, gradSSHMeridional
- integer, pointer :: index_temperature, index_SSHzonal, index_SSHmeridional, nAccumulatedCoupled
+ real (kind=RKIND), dimension(:), pointer :: gradSSHZonal, gradSSHMeridional
+ integer :: iCell
+ integer, pointer :: index_temperature, index_SSHzonal, index_SSHmeridional, nAccumulatedCoupled, nCells
+ real (kind=RKIND), dimension(:,:), pointer :: landIceBoundaryLayerTracers, landIceTracerTransferVelocities, &
+ avgLandIceBoundaryLayerTracers, avgLandIceTracerTransferVelocities
+ real (kind=RKIND), dimension(:), pointer :: effectiveDensityInLandIce, avgEffectiveDensityInLandIce
+ character (len=StrKIND), pointer :: config_land_ice_flux_mode
call mpas_pool_get_array(diagnosticsPool, 'tracersSurfaceValue', tracersSurfaceValue)
call mpas_pool_get_array(diagnosticsPool, 'surfaceVelocity', surfaceVelocity)
@@ -92,53 +125,53 @@ subroutine ocn_time_average_coupled_accumulate(diagnosticsPool, forcingPool)!{{{
call mpas_pool_get_array(forcingPool, 'avgSurfaceVelocity', avgSurfaceVelocity)
call mpas_pool_get_array(forcingPool, 'avgSSHGradient', avgSSHGradient)
+ call mpas_pool_get_dimension(forcingPool, 'nCells', nCells)
call mpas_pool_get_dimension(forcingPool, 'index_avgTemperatureSurfaceValue', index_temperature)
call mpas_pool_get_dimension(forcingPool, 'index_avgSSHGradientZonal', index_SSHzonal)
call mpas_pool_get_dimension(forcingPool, 'index_avgSSHGradientMeridional', index_SSHmeridional)
call mpas_pool_get_array(forcingPool, 'nAccumulatedCoupled', nAccumulatedCoupled)
- avgTracersSurfaceValue(:,:) = avgTracersSurfaceValue(:,:) * nAccumulatedCoupled + tracersSurfaceValue(:,:)
- avgTracersSurfaceValue(index_temperature,:) = avgTracersSurfaceValue(index_temperature,:) + T0_Kelvin
- avgTracersSurfaceValue(:,:) = avgTracersSurfaceValue(:,:) / ( nAccumulatedCoupled + 1 )
-
- avgSurfaceVelocity(:,:) = ( avgSurfaceVelocity(:,:) * nAccumulatedCoupled + surfaceVelocity(:,:) ) / ( nAccumulatedCoupled + 1 )
-
- avgSSHGradient(index_SSHzonal,:) = ( avgSSHGradient(index_SSHzonal,:) * nAccumulatedCoupled + gradSSHZonal(1,:) ) / ( nAccumulatedCoupled + 1 )
- avgSSHGradient(index_SSHmeridional,:) = ( avgSSHGradient(index_SSHmeridional,:) * nAccumulatedCoupled + gradSSHMeridional(1,:) ) / ( nAccumulatedCoupled + 1 )
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ avgTracersSurfaceValue(:, iCell) = avgTracersSurfaceValue(:, iCell) * nAccumulatedCoupled &
+ + tracersSurfaceValue(:, iCell)
+ avgTracersSurfaceValue(index_temperature, iCell) = avgTracersSurfaceValue(index_temperature, iCell) + T0_Kelvin
+ avgTracersSurfaceValue(:, iCell) = avgTracersSurfaceValue(:, iCell) / ( nAccumulatedCoupled + 1 )
+
+ avgSSHGradient(index_SSHzonal, iCell) = ( avgSSHGradient(index_SSHzonal, iCell) * nAccumulatedCoupled &
+ + gradSSHZonal(iCell) ) / ( nAccumulatedCoupled + 1 )
+ avgSSHGradient(index_SSHmeridional, iCell) = ( avgSSHGradient(index_SSHmeridional, iCell) * nAccumulatedCoupled &
+ + gradSSHMeridional(iCell) ) / ( nAccumulatedCoupled + 1 )
+ avgSurfaceVelocity(:, iCell) = ( avgSurfaceVelocity(:, iCell) * nAccumulatedCoupled + surfaceVelocity(:, iCell) ) &
+ / ( nAccumulatedCoupled + 1 )
+ end do
+ !$omp end do
+
+ call mpas_pool_get_config(ocnConfigs, 'config_land_ice_flux_mode', config_land_ice_flux_mode)
+ if(trim(config_land_ice_flux_mode) == 'coupled') then
+ call mpas_pool_get_array(diagnosticsPool, 'landIceBoundaryLayerTracers', landIceBoundaryLayerTracers)
+ call mpas_pool_get_array(diagnosticsPool, 'landIceTracerTransferVelocities', landIceTracerTransferVelocities)
+ call mpas_pool_get_array(statePool, 'effectiveDensityInLandIce', effectiveDensityInLandIce, timeLevel)
+
+ call mpas_pool_get_array(forcingPool, 'avgLandIceBoundaryLayerTracers', avgLandIceBoundaryLayerTracers)
+ call mpas_pool_get_array(forcingPool, 'avgLandIceTracerTransferVelocities', avgLandIceTracerTransferVelocities)
+ call mpas_pool_get_array(forcingPool, 'avgEffectiveDensityInLandIce', avgEffectiveDensityInLandIce)
+
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ avgLandIceBoundaryLayerTracers(:, iCell) = ( avgLandIceBoundaryLayerTracers(:, iCell) * nAccumulatedCoupled &
+ + landIceBoundaryLayerTracers(:, iCell) ) / ( nAccumulatedCoupled + 1 )
+ avgLandIceTracerTransferVelocities(:, iCell) = ( avgLandIceTracerTransferVelocities(:, iCell) * nAccumulatedCoupled &
+ + landIceTracerTransferVelocities(:, iCell) ) / ( nAccumulatedCoupled + 1)
+ avgEffectiveDensityInLandIce(iCell) = ( avgEffectiveDensityInLandIce(iCell) * nAccumulatedCoupled &
+ + effectiveDensityInLandIce(iCell) ) / ( nAccumulatedCoupled + 1)
+ end do
+ !$omp end do
+ end if
nAccumulatedCoupled = nAccumulatedCoupled + 1
end subroutine ocn_time_average_coupled_accumulate!}}}
-!***********************************************************************
-!
-! routine ocn_time_average_coupled_normalize
-!
-!> \brief Coupled time averager normalization
-!> \author Doug Jacobsen
-!> \date 06/08/2013
-!> \details
-!> This routine normalizes the coupled time averaging fields
-!
-!-----------------------------------------------------------------------
- subroutine ocn_time_average_coupled_normalize(forcingPool)!{{{
-
- type (mpas_pool_type), intent(inout) :: forcingPool
-
-! real (kind=RKIND), dimension(:,:), pointer :: avgTracersSurfaceValue, avgSurfaceVelocity, avgSSHGradient
-
-! avgTracersSurfaceValue => forcing % avgTracersSurfaceValue % array
-! avgSurfaceVelocity => forcing % avgSurfaceVelocity % array
-! avgSSHGradient => forcing % avgSSHGradient % array
-
-! if(forcing % nAccumulatedCoupled % scalar > 0) then
-! avgTracersSurfaceValue = avgTracersSurfaceValue / forcing % nAccumulatedCoupled % scalar
-! avgSurfaceVelocity = avgSurfaceVelocity / forcing % nAccumulatedCoupled % scalar
-! avgSSHGradient = avgSSHGradient / forcing % nAccumulatedCoupled % scalar
-! forcing % nAccumulatedCoupled % scalar = 0
-! end if
-
- end subroutine ocn_time_average_coupled_normalize!}}}
-
end module ocn_time_average_coupled
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_DMS.F b/src/core_ocean/shared/mpas_ocn_tracer_DMS.F
new file mode 100644
index 0000000000..aac77f26ff
--- /dev/null
+++ b/src/core_ocean/shared/mpas_ocn_tracer_DMS.F
@@ -0,0 +1,584 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_DMS
+!
+!> \brief MPAS ocean DMS
+!> \author Mathew Maltrud
+!> \date 11/01/2015
+!> \details
+!> This module contains routines for computing tracer forcing due to DMS
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_DMS
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+ use ocn_constants
+
+ use DMS_mod
+ use DMS_parms
+ use BGC_mod
+ use BGC_parms
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_tracer_DMS_compute, &
+ ocn_tracer_DMS_surface_flux_compute, &
+ ocn_tracer_DMS_init
+
+ integer, public:: &
+ numColumnsMax
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! name the necessary DMS derived types
+! all of these are defined in DMS_mod
+!-----------------------------------------------------------------------
+
+ type(DMS_indices_type) , public :: DMS_indices
+ type(DMS_input_type) , public :: DMS_input
+ type(DMS_forcing_type) , public :: DMS_forcing
+ type(DMS_output_type) , public :: DMS_output
+ type(DMS_diagnostics_type), public :: DMS_diagnostic_fields
+ type(DMS_flux_diagnostics_type), public :: DMS_flux_diagnostic_fields
+
+! hold indices in tracer pool corresponding to each tracer array
+ type(DMS_indices_type), public :: dmsIndices
+ type(BGC_indices_type) :: ecosysIndices
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_DMS_compute
+!
+!> \brief computes a tracer tendency due to DMS
+!> \author Mathew Maltrud
+!> \date 11/01/2015
+!> \details
+!> This routine computes a tracer tendency due to DMS
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_DMS_compute(activeTracers, DMSTracers, nTracersDMS, ecosysTracers, nTracersEcosys, &
+ forcingPool, nCellsSolve, maxLevelCell, &
+ nVertLevels, layerThickness, indexTemperature, indexSalinity, DMSTracersTend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ ! one dimensional arrays
+ integer, dimension(:), intent(in) :: &
+ maxLevelCell
+
+ ! two dimensional arrays
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ layerThickness
+
+ ! three dimensional arrays
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ DMSTracers
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ ecosysTracers
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ activeTracers
+
+
+ type (mpas_pool_type), intent(in) :: forcingPool
+
+ ! scalars
+ integer, intent(in) :: nTracersDMS, nTracersEcosys, nCellsSolve, nVertLevels
+ integer, intent(in) :: indexTemperature, indexSalinity
+
+
+ !
+ ! two dimensional pointers
+ !
+ real (kind=RKIND), dimension(:), pointer :: &
+ shortWaveHeatFlux
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ DMSTracersTend
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ ! source/sink wants cm instead of m
+ real (kind=RKIND) :: zTop, zBot, convertLengthScale = 100.0_RKIND
+
+ integer :: iCell, iLevel, iTracer, numColumns, column, iLevelSurface
+
+ err = 0
+
+ call mpas_pool_get_array(forcingPool, 'shortWaveHeatFlux', shortWaveHeatFlux)
+
+ numColumns = 1
+ column = 1
+ iLevelSurface = 1
+ do iCell=1,nCellsSolve
+ DMS_input%number_of_active_levels(column) = maxLevelCell(iCell)
+
+ DMS_forcing%ShortWaveFlux_surface(column) = shortWaveHeatFlux(iCell)
+ DMS_forcing%SST(column) = activeTracers(indexTemperature,iLevelSurface,iCell)
+ DMS_forcing%SSS(column) = activeTracers(indexSalinity,iLevelSurface,iCell)
+
+ do iLevel=1,maxLevelCell(iCell)
+ DMS_input%cell_thickness(iLevel,column) = layerThickness(iLevel,iCell)*convertLengthScale
+
+ DMS_input%DMS_tracers(iLevel,column,DMS_indices%dms_ind) = DMSTracers(dmsIndices%dms_ind,iLevel,iCell)
+ DMS_input%DMS_tracers(iLevel,column,DMS_indices%dmsp_ind) = DMSTracers(dmsIndices%dmsp_ind,iLevel,iCell)
+
+ DMS_input%DMS_tracers(iLevel,column,DMS_indices%no3_ind) = ecosysTracers(ecosysIndices%no3_ind,iLevel,iCell)
+ DMS_input%DMS_tracers(iLevel,column,DMS_indices%doc_ind) = ecosysTracers(ecosysIndices%doc_ind,iLevel,iCell)
+ DMS_input%DMS_tracers(iLevel,column,DMS_indices%zooC_ind) = ecosysTracers(ecosysIndices%zooC_ind,iLevel,iCell)
+ DMS_input%DMS_tracers(iLevel,column,DMS_indices%spC_ind) = ecosysTracers(ecosysIndices%spC_ind,iLevel,iCell)
+ DMS_input%DMS_tracers(iLevel,column,DMS_indices%spChl_ind) = ecosysTracers(ecosysIndices%spChl_ind,iLevel,iCell)
+ DMS_input%DMS_tracers(iLevel,column,DMS_indices%spCaCO3_ind) = ecosysTracers(ecosysIndices%spCaCO3_ind,iLevel,iCell)
+ DMS_input%DMS_tracers(iLevel,column,DMS_indices%diatC_ind) = ecosysTracers(ecosysIndices%diatC_ind,iLevel,iCell)
+ DMS_input%DMS_tracers(iLevel,column,DMS_indices%diatChl_ind) = ecosysTracers(ecosysIndices%diatChl_ind,iLevel,iCell)
+ DMS_input%DMS_tracers(iLevel,column,DMS_indices%phaeoC_ind) = ecosysTracers(ecosysIndices%phaeoC_ind,iLevel,iCell)
+ DMS_input%DMS_tracers(iLevel,column,DMS_indices%phaeoChl_ind) = ecosysTracers(ecosysIndices%phaeoChl_ind,iLevel,iCell)
+ DMS_input%DMS_tracers(iLevel,column,DMS_indices%diazC_ind) = ecosysTracers(ecosysIndices%diazC_ind,iLevel,iCell)
+ DMS_input%DMS_tracers(iLevel,column,DMS_indices%diazChl_ind) = ecosysTracers(ecosysIndices%diazChl_ind,iLevel,iCell)
+
+ enddo ! iLevel
+
+ call DMS_SourceSink(DMS_indices, DMS_input, DMS_forcing, &
+ DMS_output, DMS_diagnostic_fields, nVertLevels, &
+ numColumnsMax, numColumns)
+
+ do iLevel=1,maxLevelCell(iCell)
+
+ DMSTracersTend(dmsIndices%dms_ind,iLevel,iCell) = DMSTracersTend(dmsIndices%dms_ind,iLevel,iCell) &
+ + DMS_output%DMS_tendencies(iLevel,column,DMS_indices%dms_ind)*layerThickness(iLevel,iCell)
+ DMSTracersTend(dmsIndices%dmsp_ind,iLevel,iCell) = DMSTracersTend(dmsIndices%dmsp_ind,iLevel,iCell) &
+ + DMS_output%DMS_tendencies(iLevel,column,DMS_indices%dmsp_ind)*layerThickness(iLevel,iCell)
+
+ enddo
+
+ enddo ! iCell
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_DMS_compute!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_DMS_surface_flux_compute
+!
+!> \brief computes a tracer tendency due to DMS
+!> \author Mathew Maltrud
+!> \date 11/01/2015
+!> \details
+!> This routine computes a tracer tendency due to DMS
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_DMS_surface_flux_compute(activeTracers, DMSTracers, forcingPool, &
+ nTracers, nCellsSolve, zMid, indexTemperature, indexSalinity, DMSSurfaceFlux, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ ! two dimensional arrays
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ zMid
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ DMSSurfaceFlux
+
+ ! three dimensional arrays
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ DMSTracers
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ activeTracers
+
+ ! scalars
+ integer, intent(in) :: nTracers, nCellsSolve, indexTemperature, indexSalinity
+
+ type (mpas_pool_type), intent(inout) :: forcingPool
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mpas_pool_type), pointer :: ecosysAuxiliary, &
+ DMSSeaIceCoupling, &
+ DMSFluxDiagnostics
+
+ integer :: numColumns, column, iCell, iTracer, iLevelSurface
+
+ real (kind=RKIND), dimension(:), pointer :: &
+ seaSurfacePressure, &
+ iceFraction, &
+ windSpeedSquared10m, &
+ iceFluxDMS, &
+ iceFluxDMSP, &
+ dms_flux_diag_ifrac, &
+ dms_flux_diag_xkw, &
+ dms_flux_diag_atm_press, &
+ dms_flux_diag_pv, &
+ dms_flux_diag_schmidt,&
+ dms_flux_diag_sat, &
+ dms_flux_diag_surf, &
+ dms_flux_diag_ws
+
+ real (kind=RKIND) :: &
+ renormFluxes = 0.01_RKIND, &
+ PascalsToAtmospheres = 1.0_RKIND/101.325e+3_RKIND, &
+ mSquared_to_cmSquared = 1.0e+4_RKIND
+! PascalsToAtmospheres = 1.0_RKIND, &
+! mSquared_to_cmSquared = 1.0_RKIND
+! PascalsToAtmospheres = 0.0_RKIND, &
+! mSquared_to_cmSquared = 1.0_RKIND
+
+ err = 0
+
+ call mpas_pool_get_array(forcingPool, 'seaSurfacePressure', seaSurfacePressure)
+ call mpas_pool_get_array(forcingPool, 'iceFraction', iceFraction)
+
+ call mpas_pool_get_subpool(forcingPool, 'ecosysAuxiliary', ecosysAuxiliary)
+ call mpas_pool_get_array(ecosysAuxiliary, 'windSpeedSquared10m', windSpeedSquared10m)
+
+ call mpas_pool_get_subpool(forcingPool, 'DMSSeaIceCoupling', DMSSeaIceCoupling)
+ call mpas_pool_get_array(DMSSeaIceCoupling, 'iceFluxDMS', iceFluxDMS)
+ call mpas_pool_get_array(DMSSeaIceCoupling, 'iceFluxDMSP', iceFluxDMSP)
+
+ call mpas_pool_get_subpool(forcingPool, 'DMSFluxDiagnostics', DMSFluxDiagnostics)
+ call mpas_pool_get_array(DMSFluxDiagnostics, 'dms_flux_diag_xkw', dms_flux_diag_xkw)
+ call mpas_pool_get_array(DMSFluxDiagnostics, 'dms_flux_diag_atm_press', dms_flux_diag_atm_press)
+ call mpas_pool_get_array(DMSFluxDiagnostics, 'dms_flux_diag_pv', dms_flux_diag_pv)
+ call mpas_pool_get_array(DMSFluxDiagnostics, 'dms_flux_diag_schmidt', dms_flux_diag_schmidt)
+ call mpas_pool_get_array(DMSFluxDiagnostics, 'dms_flux_diag_sat', dms_flux_diag_sat)
+ call mpas_pool_get_array(DMSFluxDiagnostics, 'dms_flux_diag_surf', dms_flux_diag_surf)
+ call mpas_pool_get_array(DMSFluxDiagnostics, 'dms_flux_diag_ws', dms_flux_diag_ws)
+ call mpas_pool_get_array(DMSFluxDiagnostics, 'dms_flux_diag_ifrac', dms_flux_diag_ifrac)
+
+ DMS_forcing%lcalc_DMS_gas_flux = .true.
+
+ numColumns = 1
+ column = 1
+ iLevelSurface = 1
+ do iCell=1,nCellsSolve
+
+ DMS_forcing%surfacePressure(column) = seaSurfacePressure(iCell)*PascalsToAtmospheres
+ DMS_forcing%iceFraction(column) = iceFraction(iCell)
+ DMS_forcing%windSpeedSquared10m(column) = windSpeedSquared10m(iCell)*mSquared_to_cmSquared
+ DMS_forcing%SST(column) = activeTracers(indexTemperature,iLevelSurface,iCell)
+ DMS_forcing%SSS(column) = activeTracers(indexSalinity,iLevelSurface,iCell)
+
+ DMS_input%DMS_tracers(1,column,DMS_indices%dms_ind) = DMSTracers(dmsIndices%dms_ind,1,iCell)
+ DMS_input%DMS_tracers(1,column,DMS_indices%dmsp_ind) = DMSTracers(dmsIndices%dmsp_ind,1,iCell)
+
+ call DMS_SurfaceFluxes(DMS_indices, DMS_input, DMS_forcing, &
+ DMS_flux_diagnostic_fields, &
+ numColumnsMax, column)
+
+ DMSSurfaceFlux(dmsIndices%dms_ind,iCell) = DMS_forcing%netFlux(column,DMS_indices%dms_ind)*renormFluxes + &
+ iceFluxDMS(iCell)
+ DMSSurfaceFlux(dmsIndices%dmsp_ind,iCell) = DMS_forcing%netFlux(column,DMS_indices%dmsp_ind)*renormFluxes + &
+ iceFluxDMSP(iCell)
+
+ dms_flux_diag_ifrac(iCell) = DMS_flux_diagnostic_fields%diag_DMS_IFRAC(column)
+ dms_flux_diag_xkw(iCell) = DMS_flux_diagnostic_fields%diag_DMS_XKW(column)
+ dms_flux_diag_atm_press(iCell) = DMS_flux_diagnostic_fields%diag_DMS_ATM_PRESS(column)
+ dms_flux_diag_pv(iCell) = DMS_flux_diagnostic_fields%diag_DMS_PV(column)
+ dms_flux_diag_schmidt(iCell) = DMS_flux_diagnostic_fields%diag_DMS_SCHMIDT(column)
+ dms_flux_diag_sat(iCell) = DMS_flux_diagnostic_fields%diag_DMS_SAT(column)
+ dms_flux_diag_surf(iCell) = DMS_flux_diagnostic_fields%diag_DMS_SURF(column)
+ dms_flux_diag_ws(iCell) = DMS_flux_diagnostic_fields%diag_DMS_WS(column)
+
+ enddo ! iCell
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_DMS_surface_flux_compute!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_DMS_init
+!
+!> \brief Initializes ocean surface restoring
+!> \author Mathew Maltrud
+!> \date 11/01/2015
+!> \details
+!> This routine initializes fields required for tracer surface flux restoring
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_DMS_init(domain,err)!{{{
+
+!NOTE: called from mpas_ocn_forward_mode.F
+
+ type (domain_type), intent(inout) :: domain !< Input/Output: domain information
+
+ integer, intent(out) :: err !< Output: error flag
+
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: tracersPool
+
+ ! three dimensional pointers
+ real (kind=RKIND), dimension(:,:,:), pointer :: &
+ DMSTracers
+
+ ! scalars
+ integer :: nTracers, numColumnsMax
+
+ ! scalar pointers
+ integer, pointer :: nVertLevels, index_dummy
+
+ !
+ ! get tracers pools
+ !
+
+ err = 0
+
+ !
+ ! Get tracer group so we can get the number of tracers in it
+ !
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_array(tracersPool, 'DMSTracers', DMSTracers, 1)
+
+ ! make sure DMS is turned on
+
+ if (associated(DMSTracers)) then
+
+ ! cannot use DMS_tracer_cnt since it has dms, dmsp, and 12 ecosys fields
+
+ nTracers = size(DMSTracers, dim=1)
+ if (nTracers /= 2) then
+ err = 1
+ return
+ endif
+
+ !
+ ! pull nVertLevels out of the mesh structure
+ !
+
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, 'nVertLevels', nVertLevels)
+
+!-----------------------------------------------------------------------
+! initialize DMS parameters
+!-----------------------------------------------------------------------
+
+ allocate( DMS_indices%short_name(DMS_tracer_cnt) )
+ allocate( DMS_indices%long_name(DMS_tracer_cnt) )
+ allocate( DMS_indices%units(DMS_tracer_cnt) )
+
+! no need to allocate the above fields for dmsIndices (?)
+
+!-----------------------------------------------------------------------
+! sets most of DMS parameters
+! sets namelist defaults
+!-----------------------------------------------------------------------
+
+ call DMS_parms_init
+
+ ! modify namelist values here....
+
+ !
+ ! for now only do 1 column at a time
+ !
+ numColumnsMax = 1
+
+ DMS_indices%dms_ind = 1
+ DMS_indices%dmsp_ind = 2
+ DMS_indices%no3_ind = 3
+ DMS_indices%doc_ind = 4
+ DMS_indices%zooC_ind = 5
+ DMS_indices%spC_ind = 6
+ DMS_indices%spCaCO3_ind = 7
+ DMS_indices%diatC_ind = 8
+ DMS_indices%diazC_ind = 9
+ DMS_indices%phaeoC_ind = 10
+ DMS_indices%spChl_ind = 11
+ DMS_indices%diatChl_ind = 12
+ DMS_indices%diazChl_ind = 13
+ DMS_indices%phaeoChl_ind = 14
+
+ call mpas_pool_get_dimension(tracersPool, 'index_DMS', index_dummy)
+ dmsIndices%dms_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DMSP', index_dummy)
+ dmsIndices%dmsp_ind = index_dummy
+
+ call mpas_pool_get_dimension(tracersPool, 'index_NO3', index_dummy)
+ ecosysIndices%no3_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DOC', index_dummy)
+ ecosysIndices%doc_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_zooC', index_dummy)
+ ecosysIndices%zooC_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_spChl', index_dummy)
+ ecosysIndices%spChl_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_spC', index_dummy)
+ ecosysIndices%spC_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_spCaCO3', index_dummy)
+ ecosysIndices%spCaCO3_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diatChl', index_dummy)
+ ecosysIndices%diatChl_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diatC', index_dummy)
+ ecosysIndices%diatC_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diazChl', index_dummy)
+ ecosysIndices%diazChl_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diazC', index_dummy)
+ ecosysIndices%diazC_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_phaeoChl', index_dummy)
+ ecosysIndices%phaeoChl_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_phaeoC', index_dummy)
+ ecosysIndices%phaeoC_ind = index_dummy
+
+! DMS_init sets short and long names, units in DMS_indices
+
+ call DMS_init(DMS_indices)
+
+!NOTES:
+
+!also check short_name with mpas variable name
+
+!-----------------------------------------------------------------------
+! allocate input, forcing, diagnostic arrays
+!-----------------------------------------------------------------------
+
+ allocate ( DMS_input%DMS_tracers(nVertLevels, numColumnsMax, DMS_tracer_cnt) )
+ allocate ( DMS_input%cell_thickness(nVertLevels, numColumnsMax) )
+ allocate ( DMS_input%number_of_active_levels(numColumnsMax) )
+
+ allocate ( DMS_forcing%ShortWaveFlux_surface(numColumnsMax) )
+ allocate ( DMS_forcing%surfacePressure(numColumnsMax) )
+ allocate ( DMS_forcing%iceFraction(numColumnsMax) )
+ allocate ( DMS_forcing%windSpeedSquared10m(numColumnsMax) )
+ allocate ( DMS_forcing%SST(numColumnsMax) )
+ allocate ( DMS_forcing%SSS(numColumnsMax) )
+
+ allocate ( DMS_forcing%netFlux(numColumnsMax, DMS_tracer_cnt) )
+
+ allocate ( DMS_output%DMS_tendencies(nVertLevels, numColumnsMax, DMS_tracer_cnt) )
+
+ !---------------------------------------------------------------------------
+ ! allocate flux diagnostic output fields
+ !---------------------------------------------------------------------------
+
+ allocate (DMS_flux_diagnostic_fields%diag_DMS_IFRAC(numColumnsMax) )
+ allocate (DMS_flux_diagnostic_fields%diag_DMS_XKW(numColumnsMax) )
+ allocate (DMS_flux_diagnostic_fields%diag_DMS_ATM_PRESS(numColumnsMax) )
+ allocate (DMS_flux_diagnostic_fields%diag_DMS_PV(numColumnsMax) )
+ allocate (DMS_flux_diagnostic_fields%diag_DMS_SCHMIDT(numColumnsMax) )
+ allocate (DMS_flux_diagnostic_fields%diag_DMS_SAT(numColumnsMax) )
+ allocate (DMS_flux_diagnostic_fields%diag_DMS_SURF(numColumnsMax) )
+ allocate (DMS_flux_diagnostic_fields%diag_DMS_WS(numColumnsMax) )
+
+ !---------------------------------------------------------------------------
+ ! allocate diagnostic output fields
+ !---------------------------------------------------------------------------
+
+ allocate (DMS_diagnostic_fields%diag_DMS_S_DMSP(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_DMS_S_TOTAL(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_DMS_R_B(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_DMS_R_PHOT(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_DMS_R_BKGND(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_DMS_R_TOTAL(nVertLevels, numColumnsMax) )
+
+ allocate (DMS_diagnostic_fields%diag_DMSP_S_PHAEO(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_DMSP_S_NONPHAEO(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_DMSP_S_ZOO(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_DMSP_S_TOTAL(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_DMSP_R_B(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_DMSP_R_BKGND(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_DMSP_R_TOTAL(nVertLevels, numColumnsMax) )
+
+ allocate (DMS_diagnostic_fields%diag_Cyano_frac(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_Cocco_frac(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_Eukar_frac(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_diatS(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_diatN(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_phytoN(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_coccoS(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_cyanoS(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_eukarS(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_diazS(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_phaeoS(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_zooS(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_zooCC(nVertLevels, numColumnsMax) )
+ allocate (DMS_diagnostic_fields%diag_RSNzoo(nVertLevels, numColumnsMax) )
+
+ end if ! associated(DMS_tracers)
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_DMS_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_DMS
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_MacroMolecules.F b/src/core_ocean/shared/mpas_ocn_tracer_MacroMolecules.F
new file mode 100644
index 0000000000..19e74caee2
--- /dev/null
+++ b/src/core_ocean/shared/mpas_ocn_tracer_MacroMolecules.F
@@ -0,0 +1,437 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_MacroMolecules
+!
+!> \brief MPAS ocean MacroMolecules
+!> \author Mathew Maltrud
+!> \date 11/01/2015
+!> \details
+!> This module contains routines for computing tracer forcing due to MacroMolecules
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_MacroMolecules
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+ use ocn_constants
+
+ use MACROS_mod
+ use MACROS_parms
+ use BGC_mod
+ use BGC_parms
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_tracer_MacroMolecules_compute, &
+ ocn_tracer_MacroMolecules_surface_flux_compute, &
+ ocn_tracer_MacroMolecules_init
+
+ integer, public:: &
+ numColumnsMax
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! name the necessary MacroMolecules derived types
+! all of these are defined in MacroMolecules_mod
+!-----------------------------------------------------------------------
+
+ type(MACROS_indices_type) , public :: MacroMolecules_indices
+ type(MACROS_input_type) , public :: MacroMolecules_input
+ type(MACROS_output_type) , public :: MacroMolecules_output
+ type(MACROS_diagnostics_type), public :: MacroMolecules_diagnostic_fields
+
+! hold indices in tracer pool corresponding to each tracer array
+ type(MACROS_indices_type), public :: macrosIndices
+ type(BGC_indices_type) :: ecosysIndices
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_MacroMolecules_compute
+!
+!> \brief computes a tracer tendency due to MacroMolecules
+!> \author Mathew Maltrud
+!> \date 11/01/2015
+!> \details
+!> This routine computes a tracer tendency due to MacroMolecules
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_MacroMolecules_compute(MacroMoleculesTracers, nTracersMacroMolecules, &
+ ecosysTracers, nTracersEcosys, forcingPool, &
+ nCellsSolve, maxLevelCell, nVertLevels, layerThickness, MacroMoleculesTracersTend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ ! one dimensional arrays
+ integer, dimension(:), intent(in) :: &
+ maxLevelCell
+
+ ! two dimensional arrays
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ layerThickness
+
+ ! three dimensional arrays
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ MacroMoleculesTracers
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ ecosysTracers
+
+ type (mpas_pool_type), intent(in) :: forcingPool
+
+ ! scalars
+ integer, intent(in) :: nTracersMacroMolecules, nTracersEcosys, nCellsSolve, nVertLevels
+
+ !
+ ! two dimensional pointers
+ !
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ MacroMoleculesTracersTend
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ ! source/sink wants cm instead of m
+
+ real (kind=RKIND) :: zTop, zBot, convertLengthScale = 100.0_RKIND
+
+ integer :: iCell, iLevel, iTracer, numColumns, column
+
+ err = 0
+
+ numColumns = 1
+ column = 1
+ do iCell=1,nCellsSolve
+ MacroMolecules_input%number_of_active_levels(column) = maxLevelCell(iCell)
+ do iLevel=1,maxLevelCell(iCell)
+ MacroMolecules_input%cell_thickness(iLevel,column) = layerThickness(iLevel,iCell)*convertLengthScale
+
+ MacroMolecules_input%MACROS_tracers(iLevel,column,MacroMolecules_indices%prot_ind) = &
+ MacroMoleculesTracers(macrosIndices%prot_ind,iLevel,iCell)
+ MacroMolecules_input%MACROS_tracers(iLevel,column,MacroMolecules_indices%poly_ind) = &
+ MacroMoleculesTracers(macrosIndices%poly_ind,iLevel,iCell)
+ MacroMolecules_input%MACROS_tracers(iLevel,column,MacroMolecules_indices%lip_ind) = &
+ MacroMoleculesTracers(macrosIndices%lip_ind,iLevel,iCell)
+
+ MacroMolecules_input%MACROS_tracers(iLevel,column,MacroMolecules_indices%zooC_ind) = &
+ ecosysTracers(ecosysIndices%zooC_ind,iLevel,iCell)
+ MacroMolecules_input%MACROS_tracers(iLevel,column,MacroMolecules_indices%spC_ind) = &
+ ecosysTracers(ecosysIndices%spC_ind,iLevel,iCell)
+ MacroMolecules_input%MACROS_tracers(iLevel,column,MacroMolecules_indices%diatC_ind) = &
+ ecosysTracers(ecosysIndices%diatC_ind,iLevel,iCell)
+ MacroMolecules_input%MACROS_tracers(iLevel,column,MacroMolecules_indices%phaeoC_ind) = &
+ ecosysTracers(ecosysIndices%phaeoC_ind,iLevel,iCell)
+ MacroMolecules_input%MACROS_tracers(iLevel,column,MacroMolecules_indices%diazC_ind) = &
+ ecosysTracers(ecosysIndices%diazC_ind,iLevel,iCell)
+
+ enddo ! iLevel
+
+ call MACROS_SourceSink(MacroMolecules_indices, MacroMolecules_input, &
+ MacroMolecules_output, MacroMolecules_diagnostic_fields, nVertLevels, &
+ numColumnsMax, numColumns)
+
+ do iLevel=1,maxLevelCell(iCell)
+
+ MacroMoleculesTracersTend(macrosIndices%prot_ind,iLevel,iCell) = &
+ MacroMoleculesTracersTend(macrosIndices%prot_ind,iLevel,iCell) &
+ + MacroMolecules_output%MACROS_tendencies(iLevel,column,MacroMolecules_indices%prot_ind)
+ MacroMoleculesTracersTend(macrosIndices%poly_ind,iLevel,iCell) = &
+ MacroMoleculesTracersTend(macrosIndices%poly_ind,iLevel,iCell) &
+ + MacroMolecules_output%MACROS_tendencies(iLevel,column,MacroMolecules_indices%poly_ind)
+ MacroMoleculesTracersTend(macrosIndices%lip_ind,iLevel,iCell) = &
+ MacroMoleculesTracersTend(macrosIndices%lip_ind,iLevel,iCell) &
+ + MacroMolecules_output%MACROS_tendencies(iLevel,column,MacroMolecules_indices%lip_ind)
+
+ enddo
+
+ enddo ! iCell
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_MacroMolecules_compute!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_MacroMolecules_surface_flux_compute
+!
+!> \brief computes a tracer tendency due to MacroMolecules
+!> \author Mathew Maltrud
+!> \date 11/01/2015
+!> \details
+!> This routine computes a tracer tendency due to MacroMolecules
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_MacroMolecules_surface_flux_compute(activeTracers, MacroMoleculesTracers, forcingPool, &
+ nTracers, nCellsSolve, zMid, indexTemperature, indexSalinity, MacroMoleculesSurfaceFlux, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ ! two dimensional arrays
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ zMid
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ MacroMoleculesSurfaceFlux
+
+ ! three dimensional arrays
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ MacroMoleculesTracers
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ activeTracers
+
+ ! scalars
+ integer, intent(in) :: nTracers, nCellsSolve, indexTemperature, indexSalinity
+
+ type (mpas_pool_type), intent(inout) :: forcingPool
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iCell
+
+ err = 0
+
+ ! fluxes are zero
+
+ do iCell = 1, nCellsSolve
+
+ MacroMoleculesSurfaceFlux(macrosIndices%prot_ind,iCell) = 0.0_RKIND
+ MacroMoleculesSurfaceFlux(macrosIndices%poly_ind,iCell) = 0.0_RKIND
+ MacroMoleculesSurfaceFlux(macrosIndices%lip_ind, iCell) = 0.0_RKIND
+
+ enddo ! iCell
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_MacroMolecules_surface_flux_compute!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_MacroMolecules_init
+!
+!> \brief Initializes ocean surface restoring
+!> \author Mathew Maltrud
+!> \date 11/01/2015
+!> \details
+!> This routine initializes fields required for tracer surface flux restoring
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_MacroMolecules_init(domain,err)!{{{
+
+!NOTE: called from mpas_ocn_forward_mode.F
+
+ type (domain_type), intent(inout) :: domain !< Input/Output: domain information
+
+ integer, intent(out) :: err !< Output: error flag
+
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: tracersPool
+
+ ! three dimensional pointers
+ real (kind=RKIND), dimension(:,:,:), pointer :: &
+ MacroMoleculesTracers
+
+ ! scalars
+ integer :: nTracers, numColumnsMax
+
+ ! scalar pointers
+ integer, pointer :: nVertLevels, index_dummy
+
+ !
+ ! get tracers pools
+ !
+
+ err = 0
+
+ !
+ ! Get tracer group so we can get the number of tracers in it
+ !
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_array(tracersPool, 'MacroMoleculesTracers', MacroMoleculesTracers, 1)
+
+ ! make sure MacrosMolecules is turned on
+
+ if (associated(MacroMoleculesTracers)) then
+
+ ! cannot use MacroMolecules_tracer_cnt since it has poly, prot, lip and 5 ecosys fields
+
+ nTracers = size(MacroMoleculesTracers, dim=1)
+ if (nTracers /= 3) then
+ err = 1
+ return
+ endif
+
+ !
+ ! pull nVertLevels out of the mesh structure
+ !
+
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, 'nVertLevels', nVertLevels)
+
+!-----------------------------------------------------------------------
+! initialize MacroMolecules parameters
+!-----------------------------------------------------------------------
+
+ allocate( MacroMolecules_indices%short_name(MACROS_tracer_cnt) )
+ allocate( MacroMolecules_indices%long_name(MACROS_tracer_cnt) )
+ allocate( MacroMolecules_indices%units(MACROS_tracer_cnt) )
+
+! no need to allocate the above fields for macrosIndices (?)
+
+!-----------------------------------------------------------------------
+! sets most of MacroMolecules parameters
+! sets namelist defaults
+!-----------------------------------------------------------------------
+
+ call MACROS_parms_init
+
+! modify namelist values here....
+
+ !
+ ! for now only do 1 column at a time
+ !
+ numColumnsMax = 1
+
+ MacroMolecules_indices%prot_ind = 1
+ MacroMolecules_indices%poly_ind = 2
+ MacroMolecules_indices%lip_ind = 3
+ MacroMolecules_indices%zooC_ind = 4
+ MacroMolecules_indices%spC_ind = 5
+ MacroMolecules_indices%diatC_ind = 6
+ MacroMolecules_indices%diazC_ind = 7
+ MacroMolecules_indices%phaeoC_ind = 8
+
+ call mpas_pool_get_dimension(tracersPool, 'index_PROT', index_dummy)
+ macrosIndices%prot_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_POLY', index_dummy)
+ macrosIndices%poly_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_LIP', index_dummy)
+ macrosIndices%lip_ind = index_dummy
+
+ call mpas_pool_get_dimension(tracersPool, 'index_zooC', index_dummy)
+ ecosysIndices%zooC_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_spC', index_dummy)
+ ecosysIndices%spC_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diatC', index_dummy)
+ ecosysIndices%diatC_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diazC', index_dummy)
+ ecosysIndices%diazC_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_phaeoC', index_dummy)
+ ecosysIndices%phaeoC_ind = index_dummy
+
+! MacroMolecules_init sets short and long names, units in MacroMolecules_indices
+
+ call MACROS_init(MacroMolecules_indices)
+
+!NOTES:
+
+!also check short_name with mpas variable name
+
+!-----------------------------------------------------------------------
+! allocate input, forcing, diagnostic arrays
+!-----------------------------------------------------------------------
+
+ allocate ( MacroMolecules_input%MACROS_tracers(nVertLevels, numColumnsMax, MACROS_tracer_cnt) )
+ allocate ( MacroMolecules_input%cell_thickness(nVertLevels, numColumnsMax) )
+ allocate ( MacroMolecules_input%number_of_active_levels(numColumnsMax) )
+
+ allocate ( MacroMolecules_output%MACROS_tendencies(nVertLevels, numColumnsMax, MACROS_tracer_cnt) )
+
+ !---------------------------------------------------------------------------
+ ! allocate diagnostic output fields
+ !---------------------------------------------------------------------------
+
+ allocate (MacroMolecules_diagnostic_fields%diag_PROT_S_TOTAL(nVertLevels, numColumnsMax) )
+ allocate (MacroMolecules_diagnostic_fields%diag_POLY_S_TOTAL(nVertLevels, numColumnsMax) )
+ allocate (MacroMolecules_diagnostic_fields%diag_LIP_S_TOTAL(nVertLevels, numColumnsMax) )
+ allocate (MacroMolecules_diagnostic_fields%diag_PROT_R_TOTAL(nVertLevels, numColumnsMax) )
+ allocate (MacroMolecules_diagnostic_fields%diag_POLY_R_TOTAL(nVertLevels, numColumnsMax) )
+ allocate (MacroMolecules_diagnostic_fields%diag_LIP_R_TOTAL(nVertLevels, numColumnsMax) )
+
+ end if ! associated(MacroMoleculesTracers)
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_MacroMolecules_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_MacroMolecules
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_TTD.F b/src/core_ocean/shared/mpas_ocn_tracer_TTD.F
new file mode 100644
index 0000000000..86365b4c1b
--- /dev/null
+++ b/src/core_ocean/shared/mpas_ocn_tracer_TTD.F
@@ -0,0 +1,160 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_TTD
+!
+!> \brief MPAS ocean restoring
+!> \author Todd Ringler
+!> \date 06/08/2015
+!> \details
+!> This module contains routines for computing the tracer tendency due to
+!> to transit time distribution
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_TTD
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+ use ocn_constants
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_tracer_TTD_compute, &
+ ocn_tracer_TTD_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_TTD_compute
+!
+!> \brief computes a tracer tendency to approximate transit time distribution
+!> \author Todd Ringler
+!> \date 06/09/2015
+!> \details
+!> This routine computes a tracer tendency to approximate transit time distribution
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_TTD_compute(nTracers, nCellsSolve, maxLevelCell, layerThickness, &
+ TTDMask, tracers, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ ! one dimensional arrays
+ integer, dimension(:), intent(in) :: &
+ maxLevelCell
+
+ ! two dimensional arrays
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ layerThickness, &
+ TTDMask
+
+ integer, intent(in) :: nTracers, nCellsSolve
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ ! three dimensional arrays
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tracers
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iCell, iLevel, iTracer
+
+ !move to ocean constants
+ real (kind=RKIND), parameter :: c0 = 0.0_RKIND
+ real (kind=RKIND), parameter :: c1 = 1.0_RKIND
+
+ err = 0
+
+ ! zero tracers at surface to TTDMask at top-most layer
+ ! TTDMask should be 1 within region of interest and zero elsewhere
+ !$omp do schedule(runtime)
+ do iCell = 1, nCellsSolve
+ tracers(:, 1, iCell) = TTDMask(:, iCell)
+ end do
+ !$omp end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_TTD_compute!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_TTD_init
+!
+!> \brief Initializes ocean ideal age
+!> \author Todd Ringler
+!> \date 06/09/2015
+!> \details
+!> This routine initializes fields required for tracer ideal age
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_TTD_init(err)!{{{
+
+ integer, intent(out) :: err !< Output: error flag
+
+ err = 0
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_TTD_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_TTD
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_advection.F b/src/core_ocean/shared/mpas_ocn_tracer_advection.F
index 92c78709f2..9f37028b56 100644
--- a/src/core_ocean/shared/mpas_ocn_tracer_advection.F
+++ b/src/core_ocean/shared/mpas_ocn_tracer_advection.F
@@ -14,7 +14,7 @@
!> \date 03/09/12
!> \details
!> This module contains driver routine for tracer advection tendencys
-!> as well as the routines for setting up advection coefficients and
+!> as well as the routines for setting up advection coefficients and
!> initialization of the advection routines.
!
!-----------------------------------------------------------------------
@@ -27,11 +27,11 @@ module ocn_tracer_advection
use mpas_sort
use mpas_hash
- use mpas_tracer_advection_std
- use mpas_tracer_advection_mono
+ use ocn_tracer_advection_std
+ use ocn_tracer_advection_mono
use ocn_constants
-
+
implicit none
private
save
@@ -56,7 +56,8 @@ module ocn_tracer_advection
!> advection of tracers.
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_advection_tend(tracers, normalThicknessFlux, w, layerThickness, verticalCellSize, dt, meshPool, tend_layerThickness, tend)!{{{
+ subroutine ocn_tracer_advection_tend(tracers, normalThicknessFlux, w, layerThickness, verticalCellSize, dt, meshPool, & !{{{
+ scratchPool, tend_layerThickness, tend)
real (kind=RKIND), dimension(:,:,:), intent(inout) :: tend !< Input/Output: tracer tendency
real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !< Input/Output: tracer values
@@ -66,6 +67,7 @@ subroutine ocn_tracer_advection_tend(tracers, normalThicknessFlux, w, layerThick
real (kind=RKIND), dimension(:,:), intent(in) :: verticalCellSize !< Input: Distance between vertical interfaces of a cell
real (kind=RKIND), intent(in) :: dt !< Input: Time step
type (mpas_pool_type), intent(in) :: meshPool !< Input: mesh information
+ type (mpas_pool_type), intent(in) :: scratchPool !< Input: scratch fields
real (kind=RKIND), dimension(:,:), intent(in) :: tend_layerThickness !< Input: Thickness tendency information
real (kind=RKIND), dimension(:,:), pointer :: advCoefs, advCoefs3rd
@@ -85,15 +87,15 @@ subroutine ocn_tracer_advection_tend(tracers, normalThicknessFlux, w, layerThick
call mpas_pool_get_array(meshPool, 'advCellsForEdge', advCellsForEdge)
if(monotonicOn) then
- call mpas_tracer_advection_mono_tend(tracers, advCoefs, advCoefs3rd, &
+ call ocn_tracer_advection_mono_tend(tracers, advCoefs, advCoefs3rd, &
nAdvCellsForEdge, advCellsForEdge, normalThicknessFlux, w, layerThickness, &
- verticalCellSize, dt, meshPool, tend_layerThickness, tend, maxLevelCell, maxLevelEdgeTop, &
- highOrderAdvectionMask, edgeSignOnCell_in = edgeSignOnCell)
+ verticalCellSize, dt, meshPool, scratchPool, tend_layerThickness, tend, maxLevelCell, maxLevelEdgeTop, &
+ highOrderAdvectionMask, edgeSignOnCell)
else
- call mpas_tracer_advection_std_tend(tracers, advCoefs, advCoefs3rd, &
+ call ocn_tracer_advection_std_tend(tracers, advCoefs, advCoefs3rd, &
nAdvCellsForEdge, advCellsForEdge, normalThicknessFlux, w, layerThickness, &
- verticalCellSize, dt, meshPool, tend_layerThickness, tend, maxLevelCell, maxLevelEdgeTop, &
- highOrderAdvectionMask, edgeSignOnCell_in = edgeSignOnCell)
+ verticalCellSize, dt, meshPool, scratchPool, tend_layerThickness, tend, maxLevelCell, maxLevelEdgeTop, &
+ highOrderAdvectionMask, edgeSignOnCell)
endif
end subroutine ocn_tracer_advection_tend!}}}
@@ -105,7 +107,7 @@ end subroutine ocn_tracer_advection_tend!}}}
!> \author Doug Jacobsen
!> \date 03/09/12
!> \details
-!> This routine is the driver routine for initialization of
+!> This routine is the driver routine for initialization of
!> the tracer advection routines.
!
!-----------------------------------------------------------------------
@@ -134,8 +136,10 @@ subroutine ocn_tracer_advection_init(err)!{{{
if(config_disable_tr_adv) tracerAdvOn = .false.
- call mpas_tracer_advection_std_init(config_horiz_tracer_adv_order, config_vert_tracer_adv_order, config_coef_3rd_order, config_dzdk_positive, config_check_tracer_monotonicity, err_tmp)
- call mpas_tracer_advection_mono_init(config_num_halos, config_horiz_tracer_adv_order, config_vert_tracer_adv_order, config_coef_3rd_order, config_dzdk_positive, config_check_tracer_monotonicity, err_tmp)
+ call ocn_tracer_advection_std_init(config_horiz_tracer_adv_order, config_vert_tracer_adv_order, config_coef_3rd_order, &
+ config_dzdk_positive, config_check_tracer_monotonicity, err_tmp)
+ call ocn_tracer_advection_mono_init(config_num_halos, config_horiz_tracer_adv_order, config_vert_tracer_adv_order, &
+ config_coef_3rd_order, config_dzdk_positive, config_check_tracer_monotonicity, err_tmp)
err = ior(err, err_tmp)
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_advection_mono.F b/src/core_ocean/shared/mpas_ocn_tracer_advection_mono.F
new file mode 100644
index 0000000000..93e07de3fa
--- /dev/null
+++ b/src/core_ocean/shared/mpas_ocn_tracer_advection_mono.F
@@ -0,0 +1,512 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_advection_mono
+!
+!> \brief MPAS monotonic tracer advection with FCT
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \details
+!> This module contains routines for monotonic advection of tracers using a FCT
+!
+!-----------------------------------------------------------------------
+module ocn_tracer_advection_mono
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_io_units
+ use mpas_threading
+
+ use mpas_tracer_advection_helpers
+
+ implicit none
+ private
+ save
+
+ real (kind=RKIND) :: coef_3rd_order
+ integer :: horizOrder
+ logical :: vert2ndOrder, vert3rdOrder, vert4thOrder
+ logical :: positiveDzDk, monotonicityCheck
+
+ public :: ocn_tracer_advection_mono_tend, &
+ ocn_tracer_advection_mono_init
+
+ contains
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine ocn_tracer_advection_mono_tend
+!
+!> \brief MPAS monotonic tracer advection tendency with FCT
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \details
+!> This routine computes the monotonic tracer advection tendencity using a FCT.
+!> Both horizontal and vertical.
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_tracer_advection_mono_tend(tracers, adv_coefs, adv_coefs_3rd, nAdvCellsForEdge, advCellsForEdge, &!{{{
+ normalThicknessFlux, w, layerThickness, verticalCellSize, dt, meshPool, &
+ scratchPool, tend_layerThickness, tend, maxLevelCell, maxLevelEdgeTop, &
+ highOrderAdvectionMask, edgeSignOnCell)
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !< Input: current tracer values
+ real (kind=RKIND), dimension(:,:), intent(in) :: adv_coefs !< Input: Advection coefficients for 2nd order advection
+ real (kind=RKIND), dimension(:,:), intent(in) :: adv_coefs_3rd !< Input: Advection coeffs for mising 3rd/4th order advection
+ integer, dimension(:), intent(in) :: nAdvCellsForEdge !< Input: Number of advection cells for each edge
+ integer, dimension(:,:), intent(in) :: advCellsForEdge !< Input: List of advection cells for each edge
+ real (kind=RKIND), dimension(:,:), intent(in) :: normalThicknessFlux !< Input: Thichness weighted velocitiy
+ real (kind=RKIND), dimension(:,:), intent(in) :: w !< Input: Vertical velocity
+ real (kind=RKIND), dimension(:,:), intent(in) :: layerThickness !< Input: Thickness
+ real (kind=RKIND), dimension(:,:), intent(in) :: verticalCellSize !< Input: Distance between vertical interfaces of a cell
+ real (kind=RKIND), dimension(:,:), intent(in) :: tend_layerThickness !< Input: Tendency for thickness field
+ real (kind=RKIND), intent(in) :: dt !< Input: Timestep
+ type (mpas_pool_type), intent(in) :: meshPool !< Input: Mesh information
+ type (mpas_pool_type), intent(in) :: scratchPool !< Input: Scratch fields
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: tend !< Input/Output: Tracer tendency
+ integer, dimension(:), pointer :: maxLevelCell !< Input: Index to max level at cell center
+ integer, dimension(:), pointer :: maxLevelEdgeTop !< Input: Index to max level at edge with non-land cells on both sides
+ integer, dimension(:,:), pointer :: highOrderAdvectionMask !< Input: Mask for high order advection
+ integer, dimension(:, :), pointer :: edgeSignOnCell !< Input: Sign for flux from edge on each cell.
+
+ integer :: i, iCell, iEdge, k, iTracer, cell1, cell2, nVertLevels, num_tracers
+ integer, pointer :: nCells, nEdges, nCellsSolve, maxEdges
+ integer, dimension(:), pointer :: nEdgesOnCell
+ integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnCell, edgesOnCell
+
+ real (kind=RKIND) :: flux_upwind, tracer_min_new, tracer_max_new, tracer_upwind_new, scale_factor
+ real (kind=RKIND) :: flux, tracer_weight, invAreaCell1, invAreaCell2
+ real (kind=RKIND) :: verticalWeightK, verticalWeightKm1
+ real (kind=RKIND), dimension(:), pointer :: dvEdge, areaCell, verticalDivergenceFactor
+ real (kind=RKIND), dimension(:,:), pointer :: tracer_cur, tracer_new, upwind_tendency, inv_h_new, tracer_max, tracer_min
+ real (kind=RKIND), dimension(:,:), pointer :: flux_incoming, flux_outgoing, high_order_horiz_flux, high_order_vert_flux
+
+ type (field2DReal), pointer :: highOrderHorizFluxField, tracerNewField, &
+ tracerCurField, upwindTendencyField, inverseLayerThicknessField, tracerMinField, &
+ tracerMaxField, fluxIncomingField, fluxOutgoingField, highOrderVertFluxField
+
+
+ real (kind=RKIND), parameter :: eps = 1.e-10_RKIND
+
+ ! Get dimensions
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+ call mpas_pool_get_dimension(meshPool, 'maxEdges', maxEdges)
+ nVertLevels = size(tracers,dim=2)
+ num_tracers = size(tracers,dim=1)
+
+ ! Initialize pointers
+ call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge)
+ call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
+ call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell)
+ call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell)
+ call mpas_pool_get_array(meshPool, 'areaCell', areaCell)
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell)
+
+ allocate(verticalDivergenceFactor(nVertLevels))
+ verticalDivergenceFactor = 1.0_RKIND
+
+ call mpas_pool_get_field(scratchPool, 'highOrderHorizFlux', highOrderHorizFluxField)
+ call mpas_pool_get_field(scratchPool, 'tracerValue', tracerNewField, 2)
+ call mpas_pool_get_field(scratchPool, 'tracerValue', tracerCurField, 1)
+ call mpas_pool_get_field(scratchPool, 'upwindTendency', upwindTendencyField)
+ call mpas_pool_get_field(scratchPool, 'inverseLayerThickness', inverseLayerThicknessField)
+ call mpas_pool_get_field(scratchPool, 'tracerMin', tracerMinField)
+ call mpas_pool_get_field(scratchPool, 'tracerMax', tracerMaxField)
+ call mpas_pool_get_field(scratchPool, 'fluxIncoming', fluxIncomingField)
+ call mpas_pool_get_field(scratchPool, 'fluxOutgoing', fluxOutgoingField)
+ call mpas_pool_get_field(scratchPool, 'highOrderVertFlux', highOrderVertFluxField)
+
+ call mpas_allocate_scratch_field(highOrderHorizFluxField, .true.)
+ call mpas_allocate_scratch_field(tracerNewField, .true.)
+ call mpas_allocate_scratch_field(tracerCurField, .true.)
+ call mpas_allocate_scratch_field(upwindTendencyField, .true.)
+ call mpas_allocate_scratch_field(inverseLayerThicknessField, .true.)
+ call mpas_allocate_scratch_field(tracerMinField, .true.)
+ call mpas_allocate_scratch_field(tracerMaxField, .true.)
+ call mpas_allocate_scratch_field(fluxIncomingField, .true.)
+ call mpas_allocate_scratch_field(fluxOutgoingField, .true.)
+ call mpas_allocate_scratch_field(highOrderVertFluxField, .true.)
+ call mpas_threading_barrier()
+
+ ! Setup high order horizontal flux field
+ high_order_horiz_flux => highOrderHorizFluxField % array
+
+ ! allocate nCells arrays
+ tracer_new => tracerNewField % array
+ tracer_cur => tracerCurField % array
+ upwind_tendency => upwindTendencyField % array
+ inv_h_new => inverseLayerThicknessField % array
+ tracer_max => tracerMaxField % array
+ tracer_min => tracerMinField % array
+ flux_incoming => fluxIncomingField % array
+ flux_outgoing => fluxOutgoingField % array
+
+ ! allocate nVertLevels+1 and nCells arrays
+ high_order_vert_flux => highOrderVertFluxField % array
+
+ !$omp do schedule(runtime) private(k)
+ do iCell = 1, nCells
+ do k=1, maxLevelCell(iCell)
+ inv_h_new(k, iCell) = 1.0 / (layerThickness(k, iCell) + dt * tend_layerThickness(k, iCell))
+ end do
+ end do
+ !$omp end do
+
+ ! Loop over tracers. One tracer is advected at a time. It is copied into a temporary array in order to improve locality
+ do iTracer = 1, num_tracers
+ ! Initialize variables for use in this iTracer iteration
+ !$omp do schedule(runtime) private(k)
+ do iCell = 1, nCells
+ high_order_vert_flux(:, iCell) = 0.0_RKIND
+ do k=1, maxLevelCell(iCell)
+ tracer_cur(k,iCell) = tracers(iTracer,k,iCell)
+ upwind_tendency(k, iCell) = 0.0_RKIND
+
+ !tracer_new is supposed to be the "new" tracer state. This allows bounds checks.
+ if (monotonicityCheck) then
+ tracer_new(k,iCell) = 0.0_RKIND
+ end if
+ end do ! k loop
+ end do ! iCell loop
+ !$omp end do
+
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ high_order_horiz_flux(:, iEdge) = 0.0_RKIND
+ end do
+ !$omp end do
+
+ ! Compute the high order vertical flux. Also determine bounds on tracer_cur.
+ !$omp do schedule(runtime) private(k, verticalWeightK, verticalWeightKm1, i)
+ do iCell = 1, nCells
+ k = 1
+ tracer_max(k,iCell) = max(tracer_cur(k,iCell),tracer_cur(k+1,iCell))
+ tracer_min(k,iCell) = min(tracer_cur(k,iCell),tracer_cur(k+1,iCell))
+
+ k = max(1, min(maxLevelCell(iCell), 2))
+ verticalWeightK = verticalCellSize(k-1, iCell) / (verticalCellSize(k, iCell) + verticalCellSize(k-1, iCell))
+ verticalWeightKm1 = verticalCellSize(k, iCell) / (verticalCellSize(k, iCell) + verticalCellSize(k-1, iCell))
+ high_order_vert_flux(k,iCell) = w(k,iCell)*(verticalWeightK*tracer_cur(k,iCell)+verticalWeightKm1*tracer_cur(k-1,iCell))
+ tracer_max(k,iCell) = max(tracer_cur(k-1,iCell),tracer_cur(k,iCell),tracer_cur(k+1,iCell))
+ tracer_min(k,iCell) = min(tracer_cur(k-1,iCell),tracer_cur(k,iCell),tracer_cur(k+1,iCell))
+
+ do k=3,maxLevelCell(iCell)-1
+ if(vert4thOrder) then
+ high_order_vert_flux(k, iCell) = mpas_tracer_advection_vflux4( tracer_cur(k-2,iCell),tracer_cur(k-1,iCell), &
+ tracer_cur(k ,iCell),tracer_cur(k+1,iCell), w(k,iCell))
+ else if(vert3rdOrder) then
+ high_order_vert_flux(k, iCell) = mpas_tracer_advection_vflux3( tracer_cur(k-2,iCell),tracer_cur(k-1,iCell), &
+ tracer_cur(k ,iCell),tracer_cur(k+1,iCell), w(k,iCell), coef_3rd_order )
+ else if (vert2ndOrder) then
+ verticalWeightK = verticalCellSize(k-1, iCell) / (verticalCellSize(k, iCell) + verticalCellSize(k-1, iCell))
+ verticalWeightKm1 = verticalCellSize(k, iCell) / (verticalCellSize(k, iCell) + verticalCellSize(k-1, iCell))
+ high_order_vert_flux(k,iCell) = w(k,iCell) * (verticalWeightK * tracer_cur(k,iCell) + verticalWeightKm1 &
+ * tracer_cur(k-1,iCell))
+ end if
+ tracer_max(k,iCell) = max(tracer_cur(k-1,iCell),tracer_cur(k,iCell),tracer_cur(k+1,iCell))
+ tracer_min(k,iCell) = min(tracer_cur(k-1,iCell),tracer_cur(k,iCell),tracer_cur(k+1,iCell))
+ end do
+
+ k = max(1, maxLevelCell(iCell))
+ verticalWeightK = verticalCellSize(k-1, iCell) / (verticalCellSize(k, iCell) + verticalCellSize(k-1, iCell))
+ verticalWeightKm1 = verticalCellSize(k, iCell) / (verticalCellSize(k, iCell) + verticalCellSize(k-1, iCell))
+ high_order_vert_flux(k,iCell) = w(k,iCell)*(verticalWeightK*tracer_cur(k,iCell)+verticalWeightKm1*tracer_cur(k-1,iCell))
+ tracer_max(k,iCell) = max(tracer_cur(k,iCell),tracer_cur(k-1,iCell))
+ tracer_min(k,iCell) = min(tracer_cur(k,iCell),tracer_cur(k-1,iCell))
+
+ ! pull tracer_min and tracer_max from the (horizontal) surrounding cells
+ do i = 1, nEdgesOnCell(iCell)
+ do k=1, min(maxLevelCell(iCell), maxLevelCell(cellsOnCell(i, iCell)))
+ tracer_max(k,iCell) = max(tracer_max(k,iCell),tracer_cur(k, cellsOnCell(i,iCell)))
+ tracer_min(k,iCell) = min(tracer_min(k,iCell),tracer_cur(k, cellsOnCell(i,iCell)))
+ end do ! k loop
+ end do ! i loop over nEdgesOnCell
+ end do ! iCell Loop
+ !$omp end do
+
+ ! Compute the high order horizontal flux
+ !$omp do schedule(runtime) private(cell1, cell2, k, tracer_weight, i, iCell)
+ do iEdge = 1, nEdges
+ cell1 = cellsOnEdge(1, iEdge)
+ cell2 = cellsOnEdge(2, iEdge)
+
+ ! Compute 2nd order fluxes where needed.
+ do k = 1, maxLevelEdgeTop(iEdge)
+ tracer_weight = iand(highOrderAdvectionMask(k, iEdge)+1, 1) * (dvEdge(iEdge) * 0.5_RKIND) &
+ * normalThicknessFlux(k, iEdge)
+
+ high_order_horiz_flux(k, iEdge) = high_order_horiz_flux(k, iedge) + tracer_weight * (tracer_cur(k, cell1) &
+ + tracer_cur(k, cell2))
+ end do ! k loop
+
+ ! Compute 3rd or 4th fluxes where requested.
+ do i = 1, nAdvCellsForEdge(iEdge)
+ iCell = advCellsForEdge(i,iEdge)
+ do k = 1, maxLevelCell(iCell)
+ tracer_weight = highOrderAdvectionMask(k, iEdge) * (adv_coefs(i,iEdge) &
+ + coef_3rd_order*sign(1.0_RKIND,normalThicknessFlux(k,iEdge))*adv_coefs_3rd(i,iEdge))
+
+ tracer_weight = normalThicknessFlux(k,iEdge)*tracer_weight
+ high_order_horiz_flux(k,iEdge) = high_order_horiz_flux(k,iEdge) + tracer_weight * tracer_cur(k,iCell)
+ end do ! k loop
+ end do ! i loop over nAdvCellsForEdge
+ end do ! iEdge loop
+ !$omp end do
+
+ ! low order upwind vertical flux (monotonic and diffused)
+ ! Remove low order flux from the high order flux.
+ ! Store left over high order flux in high_order_vert_flux array.
+ ! Upwind fluxes are accumulated in upwind_tendency
+ !$omp do schedule(runtime) private(k, flux_upwind)
+ do iCell = 1, nCells
+ do k = 2, maxLevelCell(iCell)
+ flux_upwind = min(0.0_RKIND,w(k,iCell))*tracer_cur(k-1,iCell) + max(0.0_RKIND,w(k,iCell))*tracer_cur(k,iCell)
+ upwind_tendency(k-1,iCell) = upwind_tendency(k-1,iCell) + flux_upwind
+ upwind_tendency(k ,iCell) = upwind_tendency(k ,iCell) - flux_upwind
+ high_order_vert_flux(k,iCell) = high_order_vert_flux(k,iCell) - flux_upwind
+ end do ! k loop
+
+ ! flux_incoming contains the total remaining high order flux into iCell
+ ! it is positive.
+ ! flux_outgoing contains the total remaining high order flux out of iCell
+ ! it is negative
+ do k = 1, maxLevelCell(iCell)
+ flux_incoming (k, iCell) = max(0.0_RKIND, high_order_vert_flux(k+1, iCell)) &
+ - min(0.0_RKIND, high_order_vert_flux(k, iCell))
+ flux_outgoing(k, iCell) = min(0.0_RKIND, high_order_vert_flux(k+1, iCell)) &
+ - max(0.0_RKIND, high_order_vert_flux(k, iCell))
+ end do ! k Loop
+ end do ! iCell Loop
+ !$omp end do
+
+ ! low order upwind horizontal flux (monotinc and diffused)
+ ! Remove low order flux from the high order flux
+ ! Store left over high order flux in high_order_horiz_flux array
+ ! Upwind fluxes are accumulated in upwind_tendency
+ !$omp do schedule(runtime) private(cell1, cell2, invAreaCell1, invAreaCell2, k, flux_upwind)
+ do iEdge = 1, nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+
+ invAreaCell1 = 1.0_RKIND / areaCell(cell1)
+ invAreaCell2 = 1.0_RKIND / areaCell(cell2)
+
+ do k = 1, maxLevelEdgeTop(iEdge)
+ flux_upwind = dvEdge(iEdge) * (max(0.0_RKIND,normalThicknessFlux(k,iEdge))*tracer_cur(k,cell1) &
+ + min(0.0_RKIND,normalThicknessFlux(k,iEdge))*tracer_cur(k,cell2))
+ high_order_horiz_flux(k,iEdge) = high_order_horiz_flux(k,iEdge) - flux_upwind
+ end do ! k loop
+ end do ! iEdge loop
+ !$omp end do
+
+ !$omp do schedule(runtime) private(invAreaCell1, i, iEdge, cell1, cell2, k, flux_upwind)
+ do iCell = 1, nCells
+ invAreaCell1 = 1.0_RKIND / areaCell(iCell)
+ do i = 1, nEdgesOnCell(iCell)
+ iEdge = edgesOnCell(i, iCell)
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ do k = 1, maxLevelEdgeTop(iEdge)
+ flux_upwind = dvEdge(iEdge) * (max(0.0_RKIND,normalThicknessFlux(k,iEdge))*tracer_cur(k,cell1) &
+ + min(0.0_RKIND,normalThicknessFlux(k,iEdge))*tracer_cur(k,cell2))
+
+ upwind_tendency(k,iCell) = upwind_tendency(k,iCell) + edgeSignOncell(i, iCell) * flux_upwind * invAreaCell1
+
+ ! Accumulate remaining high order fluxes
+ flux_outgoing(k,iCell) = flux_outgoing(k,iCell) + min(0.0_RKIND, edgeSignOnCell(i, iCell) &
+ * high_order_horiz_flux(k, iEdge)) * invAreaCell1
+ flux_incoming(k,iCell) = flux_incoming(k,iCell) + max(0.0_RKIND, edgeSignOnCell(i, iCell) &
+ * high_order_horiz_flux(k, iEdge)) * invAreaCell1
+ end do
+ end do
+ end do
+ !$omp end do
+
+ ! Build the factors for the FCT
+ ! Computed using the bounds that were computed previously, and the bounds on the newly updated value
+ ! Factors are placed in the flux_incoming and flux_outgoing arrays
+ !$omp do schedule(runtime) private(k, tracer_max_new, tracer_min_new, tracer_upwind_new, scale_factor)
+ do iCell = 1, nCells
+ do k = 1, maxLevelCell(iCell)
+ tracer_min_new = (tracer_cur(k,iCell)*layerThickness(k,iCell) + dt*(upwind_tendency(k,iCell)+flux_outgoing(k,iCell))) &
+ * inv_h_new(k,iCell)
+ tracer_max_new = (tracer_cur(k,iCell)*layerThickness(k,iCell) + dt*(upwind_tendency(k,iCell)+flux_incoming(k,iCell))) &
+ * inv_h_new(k,iCell)
+ tracer_upwind_new = (tracer_cur(k,iCell)*layerThickness(k,iCell) + dt*upwind_tendency(k,iCell)) * inv_h_new(k,iCell)
+
+ scale_factor = (tracer_max(k,iCell)-tracer_upwind_new)/(tracer_max_new-tracer_upwind_new+eps)
+ flux_incoming(k,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) )
+
+ scale_factor = (tracer_upwind_new-tracer_min(k,iCell))/(tracer_upwind_new-tracer_min_new+eps)
+ flux_outgoing(k,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) )
+ end do ! k loop
+ end do ! iCell loop
+ !$omp end do
+
+ ! rescale the high order horizontal fluxes
+ !$omp do schedule(runtime) private(cell1, cell2, k, flux)
+ do iEdge = 1, nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ do k = 1, maxLevelEdgeTop(iEdge)
+ flux = high_order_horiz_flux(k,iEdge)
+ flux = max(0.0_RKIND,flux) * min(flux_outgoing(k,cell1), flux_incoming(k,cell2)) &
+ + min(0.0_RKIND,flux) * min(flux_incoming(k,cell1), flux_outgoing(k,cell2))
+ high_order_horiz_flux(k,iEdge) = flux
+ end do ! k loop
+ end do ! iEdge loop
+ !$omp end do
+
+ ! rescale the high order vertical flux
+ !$omp do schedule(runtime) private(k, flux)
+ do iCell = 1, nCellsSolve
+ do k = 2, maxLevelCell(iCell)
+ flux = high_order_vert_flux(k,iCell)
+ flux = max(0.0_RKIND,flux) * min(flux_outgoing(k ,iCell), flux_incoming(k-1,iCell)) &
+ + min(0.0_RKIND,flux) * min(flux_outgoing(k-1,iCell), flux_incoming(k ,iCell))
+ high_order_vert_flux(k,iCell) = flux
+ end do ! k loop
+ end do ! iCell loop
+ !$omp end do
+
+ ! Accumulate the scaled high order horizontal tendencies
+ !$omp do schedule(runtime) private(invAreaCell1, i, iEdge, k)
+ do iCell = 1, nCells
+ invAreaCell1 = 1.0_RKIND / areaCell(iCell)
+ do i = 1, nEdgesOnCell(iCell)
+ iEdge = edgesOnCell(i, iCell)
+ do k = 1, maxLevelEdgeTop(iEdge)
+ tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + edgeSignOnCell(i, iCell) * high_order_horiz_flux(k, iEdge) &
+ * invAreaCell1
+
+ if(monotonicityCheck) then
+ tracer_new(k, iCell) = tracer_new(k, iCell) + edgeSignOnCell(i, iCell) * high_order_horiz_flux(k, iEdge) &
+ * invAreaCell1
+ end if
+ end do
+ end do
+ end do
+ !$omp end do
+
+ ! Accumulate the scaled high order vertical tendencies, and the upwind tendencies
+ !$omp do schedule(runtime) private(k)
+ do iCell = 1, nCellsSolve
+ do k = 1,maxLevelCell(iCell)
+ tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + verticalDivergenceFactor(k) * (high_order_vert_flux(k+1, iCell) &
+ - high_order_vert_flux(k, iCell)) + upwind_tendency(k,iCell)
+
+ if (monotonicityCheck) then
+ !tracer_new holds a tendency for now. Only for a check on monotonicity
+ tracer_new(k, iCell) = tracer_new(k, iCell) + verticalDivergenceFactor(k) * (high_order_vert_flux(k+1, iCell) &
+ - high_order_vert_flux(k, iCell)) + upwind_tendency(k,iCell)
+
+ !tracer_new is now the new state of the tracer. Only for a check on monotonicity
+ tracer_new(k, iCell) = (tracer_cur(k, iCell)*layerThickness(k, iCell) + dt * tracer_new(k, iCell)) &
+ * inv_h_new(k, iCell)
+ end if
+ end do ! k loop
+ end do ! iCell loop
+ !$omp end do
+
+ if (monotonicityCheck) then
+ !build min and max bounds on old and new tracer for check on monotonicity.
+ !$omp do schedule(runtime) private(k)
+ do iCell = 1, nCellsSolve
+ do k = 1, maxLevelCell(iCell)
+ if(tracer_new(k,iCell) < tracer_min(k, iCell)-eps) then
+ write(stderrUnit,*) 'Minimum out of bounds on tracer ', iTracer, tracer_min(k, iCell), tracer_new(k,iCell)
+ end if
+
+ if(tracer_new(k,iCell) > tracer_max(k,iCell)+eps) then
+ write(stderrUnit,*) 'Maximum out of bounds on tracer ', iTracer, tracer_max(k, iCell), tracer_new(k,iCell)
+ end if
+ end do
+ end do
+ !$omp end do
+ end if
+ end do ! iTracer loop
+
+ call mpas_threading_barrier()
+ call mpas_deallocate_scratch_field(highOrderHorizFluxField, .true.)
+ call mpas_deallocate_scratch_field(tracerNewField, .true.)
+ call mpas_deallocate_scratch_field(tracerCurField, .true.)
+ call mpas_deallocate_scratch_field(upwindTendencyField, .true.)
+ call mpas_deallocate_scratch_field(inverseLayerThicknessField, .true.)
+ call mpas_deallocate_scratch_field(tracerMinField, .true.)
+ call mpas_deallocate_scratch_field(tracerMaxField, .true.)
+ call mpas_deallocate_scratch_field(fluxIncomingField, .true.)
+ call mpas_deallocate_scratch_field(fluxOutgoingField, .true.)
+ call mpas_deallocate_scratch_field(highOrderVertFluxField, .true.)
+
+ deallocate(verticalDivergenceFactor)
+
+ end subroutine ocn_tracer_advection_mono_tend!}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine ocn_tracer_advection_mono_init
+!
+!> \brief MPAS initialize monotonic tracer advection tendency with FCT
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \details
+!> This routine initializes the monotonic tracer advection tendencity using a FCT.
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_tracer_advection_mono_init(nHalos, horiz_adv_order, vert_adv_order, coef_3rd_order_in, dzdk_positive, & !{{{
+ check_monotonicity, err)
+
+ use mpas_dmpar
+ integer, intent(in) :: nHalos !< Input: number of halos in current simulation
+ integer, intent(in) :: horiz_adv_order !< Input: Order for horizontal advection
+ integer, intent(in) :: vert_adv_order !< Input: Order for vertical advection
+ real (kind=RKIND), intent(in) :: coef_3rd_order_in !< Input: coefficient for blending advection orders.
+ logical, intent(in) :: dzdk_positive !< Input: Logical flag determining if dzdk is positive or negative.
+ logical, intent(in) :: check_monotonicity !< Input: Logical flag determining check on monotonicity of tracers
+ integer, intent(inout) :: err !< Input/Output: Error Flag
+
+ err = 0
+
+ vert2ndOrder = .false.
+ vert3rdOrder = .false.
+ vert4thOrder = .false.
+
+ if ( horiz_adv_order == 3) then
+ coef_3rd_order = coef_3rd_order_in
+ else if(horiz_adv_order == 2 .or. horiz_adv_order == 4) then
+ coef_3rd_order = 0.0_RKIND
+ end if
+
+ horizOrder = horiz_adv_order
+
+ if (vert_adv_order == 3) then
+ vert3rdOrder = .true.
+ else if (vert_adv_order == 4) then
+ vert4thOrder = .true.
+ else
+ vert2ndOrder = .true.
+ if(vert_adv_order /= 2) then
+ write(stderrUnit,*) 'Invalid value for vert_adv_order, defaulting to 2nd order'
+ end if
+ end if
+
+ if (nHalos < 3) then
+ call mpas_dmpar_global_abort('MPAS-ocean: ERROR: Monotonic advection cannot be used with less than 3 halos.')
+ end if
+
+ positiveDzDk = dzdk_positive
+ monotonicityCheck = check_monotonicity
+
+ end subroutine ocn_tracer_advection_mono_init!}}}
+
+end module ocn_tracer_advection_mono
+
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_advection_std.F b/src/core_ocean/shared/mpas_ocn_tracer_advection_std.F
new file mode 100644
index 0000000000..b6085fec5c
--- /dev/null
+++ b/src/core_ocean/shared/mpas_ocn_tracer_advection_std.F
@@ -0,0 +1,287 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_advection_std
+!
+!> \brief MPAS standard tracer advection
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \details
+!> This module contains routines for standard advection of tracers
+!
+!-----------------------------------------------------------------------
+module ocn_tracer_advection_std
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_io_units
+ use mpas_threading
+
+ use mpas_tracer_advection_helpers
+
+ implicit none
+ private
+ save
+
+ real (kind=RKIND) :: coef_3rd_order
+ integer :: horizOrder
+ logical :: vert2ndOrder, vert3rdOrder, vert4thOrder
+ logical :: positiveDzDk, monotonicityCheck
+
+ public :: ocn_tracer_advection_std_tend, &
+ ocn_tracer_advection_std_init
+
+ contains
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine ocn_tracer_advection_std_tend
+!
+!> \brief MPAS standard tracer advection tendency
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \details
+!> This routine computes the standard tracer advection tendencity.
+!> Both horizontal and vertical.
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_tracer_advection_std_tend(tracers, adv_coefs, adv_coefs_3rd, nAdvCellsForEdge, advCellsForEdge, &!{{{
+ normalThicknessFlux, w, layerThickness, verticalCellSize, dt, meshPool, &
+ scratchPool, tend_layerThickness, tend, maxLevelCell, maxLevelEdgeTop, &
+ highOrderAdvectionMask, edgeSignOnCell)
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !< Input: current tracer values
+ real (kind=RKIND), dimension(:,:), intent(in) :: adv_coefs !< Input: Advection coefficients for 2nd order advection
+ real (kind=RKIND), dimension(:,:), intent(in) :: adv_coefs_3rd !< Input: Advection coeffs for blending in 3rd/4th order
+ integer, dimension(:), intent(in) :: nAdvCellsForEdge !< Input: Number of advection cells for each edge
+ integer, dimension(:,:), intent(in) :: advCellsForEdge !< Input: List of advection cells for each edge
+ real (kind=RKIND), dimension(:,:), intent(in) :: normalThicknessFlux !< Input: Thichness weighted velocitiy
+ real (kind=RKIND), dimension(:,:), intent(in) :: w !< Input: Vertical velocity
+ real (kind=RKIND), dimension(:,:), intent(in) :: layerThickness !< Input: Thickness
+ real (kind=RKIND), dimension(:,:), intent(in) :: verticalCellSize !< Input: Distance between vertical interfaces of a cell
+ real (kind=RKIND), dimension(:,:), intent(in) :: tend_layerThickness !< Input: Tendency for thickness field
+ real (kind=RKIND), intent(in) :: dt !< Input: Timestep
+ type (mpas_pool_type), intent(in) :: meshPool !< Input: Mesh information
+ type (mpas_pool_type), intent(in) :: scratchPool !< Input: Scratch fields
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: tend !< Input/Output: Tracer tendency
+ integer, dimension(:), pointer :: maxLevelCell !< Input: Index to max level at cell center
+ integer, dimension(:), pointer :: maxLevelEdgeTop !< Input: Index to max level at edge with non-land cells on both sides
+ integer, dimension(:,:), pointer :: highOrderAdvectionMask !< Input: Mask for high order advection
+ integer, dimension(:, :), pointer :: edgeSignOnCell !< Input: Sign for flux from edge on each cell.
+
+ integer :: i, iCell, iEdge, k, iTracer, cell1, cell2
+ integer :: nVertLevels, num_tracers
+ integer, pointer :: nCells, nEdges, nCellsSolve, maxEdges
+ integer, dimension(:), pointer :: nEdgesOnCell
+ integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnCell, edgesOnCell
+
+ real (kind=RKIND) :: tracer_weight, invAreaCell1
+ real (kind=RKIND) :: verticalWeightK, verticalWeightKm1
+ real (kind=RKIND), dimension(:), pointer :: dvEdge, areaCell, verticalDivergenceFactor
+ real (kind=RKIND), dimension(:,:), pointer :: tracer_cur, high_order_horiz_flux, high_order_vert_flux
+
+ type (field2DReal), pointer :: highOrderHorizFluxField, tracerCurField, highOrderVertFluxField
+
+ real (kind=RKIND), parameter :: eps = 1.e-10_RKIND
+
+ ! Get dimensions
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+ call mpas_pool_get_dimension(meshPool, 'maxEdges', maxEdges)
+ nVertLevels = size(tracers,dim=2)
+ num_tracers = size(tracers,dim=1)
+
+ ! Initialize pointers
+ call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge)
+ call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
+ call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell)
+ call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell)
+ call mpas_pool_get_array(meshPool, 'areaCell', areaCell)
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell)
+
+ allocate(verticalDivergenceFactor(nVertLevels))
+ verticalDivergenceFactor = 1.0_RKIND
+
+ call mpas_pool_get_field(scratchPool, 'highOrderHorizFlux', highOrderHorizFluxField)
+ call mpas_pool_get_field(scratchPool, 'tracerValue', tracerCurField, 1)
+ call mpas_pool_get_field(scratchPool, 'highOrderVertFlux', highOrderVertFluxField)
+
+ call mpas_allocate_scratch_field(highOrderHorizFluxField, .true.)
+ call mpas_allocate_scratch_field(tracerCurField, .true.)
+ call mpas_allocate_scratch_field(highOrderVertFluxField, .true.)
+ call mpas_threading_barrier()
+
+ high_order_horiz_flux => highOrderHorizFluxField % array
+ tracer_cur => tracerCurField % array
+ high_order_vert_flux => highOrderVertFluxField % array
+
+ ! Loop over tracers. One tracer is advected at a time. It is copied into a temporary array in order to improve locality
+ do iTracer = 1, num_tracers
+ ! Initialize variables for use in this iTracer iteration
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ tracer_cur(:, iCell) = tracers(iTracer, :, iCell)
+
+ high_order_vert_flux(:, iCell) = 0.0_RKIND
+ end do
+ !$omp end do
+
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ high_order_horiz_flux(:, iEdge) = 0.0_RKIND
+ end do
+ !$omp end do
+
+ ! Compute the high order vertical flux. Also determine bounds on tracer_cur.
+ !$omp do schedule(runtime) private(k, verticalWeightK, verticalWeightKm1)
+ do iCell = 1, nCells
+ k = max(1, min(maxLevelCell(iCell), 2))
+ verticalWeightK = verticalCellSize(k-1, iCell) / (verticalCellSize(k, iCell) + verticalCellSize(k-1, iCell))
+ verticalWeightKm1 = verticalCellSize(k, iCell) / (verticalCellSize(k, iCell) + verticalCellSize(k-1, iCell))
+ high_order_vert_flux(k,iCell) = w(k,iCell)*(verticalWeightK*tracer_cur(k,iCell)+verticalWeightKm1*tracer_cur(k-1,iCell))
+
+ do k=3,maxLevelCell(iCell)-1
+ if(vert4thOrder) then
+ high_order_vert_flux(k, iCell) = mpas_tracer_advection_vflux4( tracer_cur(k-2,iCell),tracer_cur(k-1,iCell), &
+ tracer_cur(k ,iCell),tracer_cur(k+1,iCell), w(k,iCell))
+ else if(vert3rdOrder) then
+ high_order_vert_flux(k, iCell) = mpas_tracer_advection_vflux3( tracer_cur(k-2,iCell),tracer_cur(k-1,iCell), &
+ tracer_cur(k ,iCell),tracer_cur(k+1,iCell), w(k,iCell), coef_3rd_order )
+ else if (vert2ndOrder) then
+ verticalWeightK = verticalCellSize(k-1, iCell) / (verticalCellSize(k, iCell) + verticalCellSize(k-1, iCell))
+ verticalWeightKm1 = verticalCellSize(k, iCell) / (verticalCellSize(k, iCell) + verticalCellSize(k-1, iCell))
+ high_order_vert_flux(k,iCell) = w(k, iCell) * (verticalWeightK * tracer_cur(k, iCell) &
+ + verticalWeightKm1 * tracer_cur(k-1, iCell))
+ end if
+ end do
+
+ k = max(1, maxLevelCell(iCell))
+ verticalWeightK = verticalCellSize(k-1, iCell) / (verticalCellSize(k, iCell) + verticalCellSize(k-1, iCell))
+ verticalWeightKm1 = verticalCellSize(k, iCell) / (verticalCellSize(k, iCell) + verticalCellSize(k-1, iCell))
+ high_order_vert_flux(k,iCell) = w(k,iCell)*(verticalWeightK*tracer_cur(k,iCell)+verticalWeightKm1*tracer_cur(k-1,iCell))
+ end do ! iCell Loop
+ !$omp end do
+
+ ! Compute the high order horizontal flux
+ !$omp do schedule(runtime) private(cell1, cell2, k, tracer_weight, i, iCell)
+ do iEdge = 1, nEdges
+ cell1 = cellsOnEdge(1, iEdge)
+ cell2 = cellsOnEdge(2, iEdge)
+
+ ! Compute 2nd order fluxes where needed.
+ do k = 1, maxLevelEdgeTop(iEdge)
+ tracer_weight = iand(highOrderAdvectionMask(k, iEdge)+1, 1) * (dvEdge(iEdge) * 0.5_RKIND) &
+ * normalThicknessFlux(k, iEdge)
+
+ high_order_horiz_flux(k, iEdge) = high_order_horiz_flux(k, iedge) + tracer_weight &
+ * (tracer_cur(k, cell1) + tracer_cur(k, cell2))
+ end do ! k loop
+
+ ! Compute 3rd or 4th fluxes where requested.
+ do i = 1, nAdvCellsForEdge(iEdge)
+ iCell = advCellsForEdge(i,iEdge)
+ do k = 1, maxLevelCell(iCell)
+ tracer_weight = highOrderAdvectionMask(k, iEdge) * (adv_coefs(i,iEdge) + coef_3rd_order &
+ * sign(1.0_RKIND,normalThicknessFlux(k,iEdge))*adv_coefs_3rd(i,iEdge))
+
+ tracer_weight = normalThicknessFlux(k,iEdge)*tracer_weight
+ high_order_horiz_flux(k,iEdge) = high_order_horiz_flux(k,iEdge) + tracer_weight * tracer_cur(k,iCell)
+ end do ! k loop
+ end do ! i loop over nAdvCellsForEdge
+ end do ! iEdge loop
+ !$omp end do
+
+ ! Accumulate the scaled high order horizontal tendencies
+ !$omp do schedule(runtime) private(invAreaCell1, i, iEdge, k)
+ do iCell = 1, nCells
+ invAreaCell1 = 1.0_RKIND / areaCell(iCell)
+ do i = 1, nEdgesOnCell(iCell)
+ iEdge = edgesOnCell(i, iCell)
+ do k = 1, maxLevelEdgeTop(iEdge)
+ tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + edgeSignOnCell(i, iCell) * high_order_horiz_flux(k, iEdge) &
+ * invAreaCell1
+ end do
+ end do
+ end do
+ !$omp end do
+
+ ! Accumulate the scaled high order vertical tendencies.
+ !$omp do schedule(runtime) private(k)
+ do iCell = 1, nCellsSolve
+ do k = 1,maxLevelCell(iCell)
+ tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + verticalDivergenceFactor(k) * (high_order_vert_flux(k+1, iCell) &
+ - high_order_vert_flux(k, iCell))
+ end do ! k loop
+ end do ! iCell loop
+ !$omp end do
+ end do ! iTracer loop
+
+ call mpas_threading_barrier()
+ call mpas_deallocate_scratch_field(highOrderHorizFluxField, .true.)
+ call mpas_deallocate_scratch_field(tracerCurField, .true.)
+ call mpas_deallocate_scratch_field(highOrderVertFluxField, .true.)
+
+ deallocate(verticalDivergenceFactor)
+
+ end subroutine ocn_tracer_advection_std_tend!}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine ocn_tracer_advection_std_init
+!
+!> \brief MPAS initialize standard tracer advection tendency.
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \details
+!> This routine initializes the standard tracer advection tendencity.
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_tracer_advection_std_init(horiz_adv_order, vert_adv_order, coef_3rd_order_in, dzdk_positive, & !{{{
+ check_monotonicity, err)
+ integer, intent(in) :: horiz_adv_order !< Input: Order for horizontal advection
+ integer, intent(in) :: vert_adv_order !< Input: Order for vertical advection
+ real (kind=RKIND), intent(in) :: coef_3rd_order_in !< Input: coefficient for blending advection orders.
+ logical, intent(in) :: dzdk_positive !< Input: Logical flag determining if dzdk is positive or negative.
+ logical, intent(in) :: check_monotonicity !< Input: Logical flag determining check on monotonicity of tracers
+ integer, intent(inout) :: err !< Input/Output: Error Flag
+
+ err = 0
+
+ vert2ndOrder = .false.
+ vert3rdOrder = .false.
+ vert4thOrder = .false.
+
+ if ( horiz_adv_order == 3) then
+ coef_3rd_order = coef_3rd_order_in
+ else if(horiz_adv_order == 2 .or. horiz_adv_order == 4) then
+ coef_3rd_order = 0.0_RKIND
+ end if
+
+ horizOrder = horiz_adv_order
+
+ if (vert_adv_order == 3) then
+ vert3rdOrder = .true.
+ else if (vert_adv_order == 4) then
+ vert4thOrder = .true.
+ else
+ vert2ndOrder = .true.
+ if(vert_adv_order /= 2) then
+ write(stderrUnit,*) 'Invalid value for vert_adv_order, defaulting to 2nd order'
+ end if
+ end if
+
+ positiveDzDk = dzdk_positive
+ monotonicityCheck = check_monotonicity
+
+ end subroutine ocn_tracer_advection_std_init!}}}
+
+end module ocn_tracer_advection_std
+
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_ecosys.F b/src/core_ocean/shared/mpas_ocn_tracer_ecosys.F
new file mode 100755
index 0000000000..0f5b61b3a0
--- /dev/null
+++ b/src/core_ocean/shared/mpas_ocn_tracer_ecosys.F
@@ -0,0 +1,1216 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_ecosys
+!
+!> \brief MPAS ocean ecosys
+!> \author Mathew Maltrud
+!> \date 11/01/2015
+!> \details
+!> This module contains routines for computing tracer forcing due to ecosys
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_ecosys
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+ use ocn_constants
+
+! use BGC_mod
+! use BGC_parms
+ use bgc_mod
+ use bgc_parms
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_tracer_ecosys_compute, &
+ ocn_tracer_ecosys_surface_flux_compute, &
+ ocn_tracer_ecosys_init
+
+ integer, public:: &
+ numColumnsMax
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! name the necessary BGC derived types
+! all of these are defined in BGC_mod
+!-----------------------------------------------------------------------
+
+! autotroph_cnt comes from BGC_parms module
+ type(autotroph_type), dimension(autotroph_cnt), public :: autotrophs
+ type(BGC_indices_type) , public :: BGC_indices
+ type(BGC_input_type) , public :: BGC_input
+ type(BGC_forcing_type) , public :: BGC_forcing
+ type(BGC_output_type) , public :: BGC_output
+ type(BGC_diagnostics_type), public :: BGC_diagnostic_fields
+ type(BGC_flux_diagnostics_type), public :: BGC_flux_diagnostic_fields
+
+! hold indices in tracer pool corresponding to each eco tracer array
+ type(BGC_indices_type), public :: ecosysIndices
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_ecosys_compute
+!
+!> \brief computes a tracer tendency due to ecosys
+!> \author Mathew Maltrud
+!> \date 11/01/2015
+!> \details
+!> This routine computes a tracer tendency due to ecosys
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_ecosys_compute(activeTracers, ecosysTracers, forcingPool, nTracers, nCellsSolve, &
+ maxLevelCell, nVertLevels, layerThickness, zMid, indexTemperature, indexSalinity, ecosysTracersTend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ ! one dimensional arrays
+ integer, dimension(:), intent(in) :: &
+ maxLevelCell
+
+ ! two dimensional arrays
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ zMid, layerThickness
+
+ ! three dimensional arrays
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ ecosysTracers
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ activeTracers
+
+ ! scalars
+ integer, intent(in) :: nTracers, nCellsSolve, nVertLevels, indexTemperature, indexSalinity
+
+ type (mpas_pool_type), intent(inout) :: forcingPool
+
+ !
+ ! two dimensional pointers
+ !
+ real (kind=RKIND), dimension(:), pointer :: &
+ dust_FLUX_IN, PAR_surface, shortWaveHeatFlux
+
+ ! two dimensional arrays
+ real (kind=RKIND), dimension(:,:), pointer :: &
+ PH_PREV_3D, PH_PREV_ALT_CO2_3D, FESEDFLUX
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ ecosysTracersTend
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mpas_pool_type), pointer :: ecosysAuxiliary ! additional forcing fields
+ type (mpas_pool_type), pointer :: ecosysDiagsLevel1 ! diagnostics
+
+ real (kind=RKIND), dimension(:), pointer :: &
+ ecosys_diag_tot_CaCO3_form_zint, &
+ ecosys_diag_photoC_TOT_zint, &
+ ecosys_diag_Jint_Ctot, &
+ ecosys_diag_Jint_100m_Ctot, &
+ ecosys_diag_Jint_Ntot, &
+ ecosys_diag_Jint_100m_Ntot, &
+ ecosys_diag_Jint_Ptot, &
+ ecosys_diag_Jint_100m_Ptot, &
+ ecosys_diag_Jint_Sitot, &
+ ecosys_diag_Jint_100m_Sitot, &
+ ecosys_diag_O2_ZMIN, &
+ ecosys_diag_O2_ZMIN_DEPTH
+
+ ! two dimensional arrays
+ real (kind=RKIND), dimension(:,:), pointer :: &
+ ecosys_diag_tot_Nfix, &
+ ecosys_diag_NITRIF, &
+ ecosys_diag_DENITRIF, &
+ ecosys_diag_O2_PRODUCTION, &
+ ecosys_diag_O2_CONSUMPTION, &
+ ecosys_diag_PAR_avg, &
+ ecosys_diag_zoo_loss, &
+ ecosys_diag_auto_graze_TOT, &
+ ecosys_diag_photoC_TOT, &
+ ecosys_diag_DOC_prod, &
+ ecosys_diag_DOC_remin, &
+ ecosys_diag_DON_prod, &
+ ecosys_diag_DON_remin, &
+ ecosys_diag_DOP_prod, &
+ ecosys_diag_DOP_remin, &
+ ecosys_diag_DOFe_prod, &
+ ecosys_diag_DOFe_remin, &
+ ecosys_diag_Fe_scavenge, &
+ ecosys_diag_Fe_scavenge_rate, &
+ ecosys_diag_POC_FLUX_IN, &
+ ecosys_diag_POC_PROD, &
+ ecosys_diag_POC_REMIN, &
+ ecosys_diag_CaCO3_FLUX_IN, &
+ ecosys_diag_CaCO3_PROD, &
+ ecosys_diag_CaCO3_REMIN, &
+ ecosys_diag_SiO2_FLUX_IN, &
+ ecosys_diag_SiO2_PROD, &
+ ecosys_diag_SiO2_REMIN, &
+ ecosys_diag_dust_FLUX_IN, &
+ ecosys_diag_dust_REMIN, &
+ ecosys_diag_P_iron_FLUX_IN, &
+ ecosys_diag_P_iron_PROD, &
+ ecosys_diag_P_iron_REMIN
+
+ ! source/sink wants cm instead of m
+ real (kind=RKIND) :: zTop, zBot, convertLengthScale = 100.0_RKIND
+
+ integer :: iCell, iLevel, iTracer, numColumns, column
+
+ err = 0
+
+ call mpas_pool_get_subpool(forcingPool, 'ecosysAuxiliary', ecosysAuxiliary)
+
+ call mpas_pool_get_array(ecosysAuxiliary, 'PH_PREV_3D', PH_PREV_3D)
+ call mpas_pool_get_array(ecosysAuxiliary, 'PH_PREV_ALT_CO2_3D', PH_PREV_ALT_CO2_3D)
+ call mpas_pool_get_array(ecosysAuxiliary, 'FESEDFLUX', FESEDFLUX)
+ call mpas_pool_get_array(ecosysAuxiliary, 'dust_FLUX_IN', dust_FLUX_IN)
+ call mpas_pool_get_array(ecosysAuxiliary, 'PAR_surface', PAR_surface)
+
+ call mpas_pool_get_array(forcingPool, 'shortWaveHeatFlux', shortWaveHeatFlux)
+
+!maltrud change to diagnostics pool at some point (needs to be passed in)
+ call mpas_pool_get_subpool(forcingPool, 'ecosysDiagsLevel1', ecosysDiagsLevel1)
+
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_tot_CaCO3_form_zint', ecosys_diag_tot_CaCO3_form_zint)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_photoC_TOT_zint', ecosys_diag_photoC_TOT_zint)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_Jint_Ctot', ecosys_diag_Jint_Ctot)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_Jint_100m_Ctot', ecosys_diag_Jint_100m_Ctot)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_Jint_Ntot', ecosys_diag_Jint_Ntot)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_Jint_100m_Ntot', ecosys_diag_Jint_100m_Ntot)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_Jint_Ptot', ecosys_diag_Jint_Ptot)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_Jint_100m_Ptot', ecosys_diag_Jint_100m_Ptot)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_Jint_Sitot', ecosys_diag_Jint_Sitot)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_Jint_100m_Sitot', ecosys_diag_Jint_100m_Sitot)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_O2_ZMIN', ecosys_diag_O2_ZMIN)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_O2_ZMIN_DEPTH', ecosys_diag_O2_ZMIN_DEPTH)
+
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_tot_Nfix', ecosys_diag_tot_Nfix)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_NITRIF', ecosys_diag_NITRIF)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_DENITRIF', ecosys_diag_DENITRIF)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_O2_PRODUCTION', ecosys_diag_O2_PRODUCTION)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_O2_CONSUMPTION', ecosys_diag_O2_CONSUMPTION)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_PAR_avg', ecosys_diag_PAR_avg)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_zoo_loss', ecosys_diag_zoo_loss)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_auto_graze_TOT', ecosys_diag_auto_graze_TOT)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_photoC_TOT', ecosys_diag_photoC_TOT)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_DOC_prod', ecosys_diag_DOC_prod)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_DOC_remin', ecosys_diag_DOC_remin)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_DON_prod', ecosys_diag_DON_prod)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_DON_remin', ecosys_diag_DON_remin)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_DOP_prod', ecosys_diag_DOP_prod)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_DOP_remin', ecosys_diag_DOP_remin)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_DOFe_prod', ecosys_diag_DOFe_prod)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_DOFe_remin', ecosys_diag_DOFe_remin)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_Fe_scavenge', ecosys_diag_Fe_scavenge)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_Fe_scavenge_rate', ecosys_diag_Fe_scavenge_rate)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_POC_FLUX_IN', ecosys_diag_POC_FLUX_IN)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_POC_PROD', ecosys_diag_POC_PROD)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_POC_REMIN', ecosys_diag_POC_REMIN)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_CaCO3_FLUX_IN', ecosys_diag_CaCO3_FLUX_IN)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_CaCO3_PROD', ecosys_diag_CaCO3_PROD)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_CaCO3_REMIN', ecosys_diag_CaCO3_REMIN)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_SiO2_FLUX_IN', ecosys_diag_SiO2_FLUX_IN)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_SiO2_PROD', ecosys_diag_SiO2_PROD)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_SiO2_REMIN', ecosys_diag_SiO2_REMIN)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_dust_FLUX_IN', ecosys_diag_dust_FLUX_IN)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_dust_REMIN', ecosys_diag_dust_REMIN)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_P_iron_FLUX_IN', ecosys_diag_P_iron_FLUX_IN)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_P_iron_PROD', ecosys_diag_P_iron_PROD)
+ call mpas_pool_get_array(ecosysDiagsLevel1, 'ecosys_diag_P_iron_REMIN', ecosys_diag_P_iron_REMIN)
+
+ numColumns = 1
+ column = 1
+ do iCell=1,nCellsSolve
+ BGC_input%number_of_active_levels(column) = maxLevelCell(iCell)
+ BGC_forcing%dust_FLUX_IN(column) = dust_FLUX_IN(iCell)
+ BGC_forcing%ShortWaveFlux_surface(column) = shortWaveHeatFlux(iCell)
+ zTop = 0.0_RKIND
+ do iLevel=1,maxLevelCell(iCell)
+ BGC_input%PotentialTemperature(iLevel,column) = activeTracers(indexTemperature,iLevel,iCell)
+ BGC_input%Salinity(iLevel,column) = activeTracers(indexSalinity,iLevel,iCell)
+ BGC_input%cell_center_depth(iLevel,column) = -1.0_RKIND*zMid(iLevel,iCell)*convertLengthScale
+ BGC_input%cell_thickness(iLevel,column) = layerThickness(iLevel,iCell)*convertLengthScale
+ zBot = zTop + layerThickness(iLevel,iCell)
+ BGC_input%cell_bottom_depth(iLevel,column) = zBot*convertLengthScale
+ zTop = zBot
+
+ BGC_output%PH_PREV_3D(iLevel,column) = PH_PREV_3D(iLevel,iCell)
+ BGC_output%PH_PREV_ALT_CO2_3D(iLevel,column) = PH_PREV_ALT_CO2_3D(iLevel,iCell)
+
+ BGC_forcing%FESEDFLUX(iLevel,column) = FESEDFLUX(iLevel,iCell)
+ BGC_forcing%NUTR_RESTORE_RTAU(iLevel,column) = 0.0_RKIND
+ BGC_forcing%NO3_CLIM(iLevel,column) = 0.0_RKIND
+ BGC_forcing%PO4_CLIM(iLevel,column) = 0.0_RKIND
+ BGC_forcing%SiO3_CLIM(iLevel,column) = 0.0_RKIND
+
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%po4_ind) = &
+ ecosysTracers(ecosysIndices%po4_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%no3_ind) = &
+ ecosysTracers(ecosysIndices%no3_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%sio3_ind) = &
+ ecosysTracers(ecosysIndices%sio3_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%nh4_ind) = &
+ ecosysTracers(ecosysIndices%nh4_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%fe_ind) = &
+ ecosysTracers(ecosysIndices%fe_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%o2_ind) = &
+ ecosysTracers(ecosysIndices%o2_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%dic_ind) = &
+ ecosysTracers(ecosysIndices%dic_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%dic_alt_co2_ind) = &
+ ecosysTracers(ecosysIndices%dic_alt_co2_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%alk_ind) = &
+ ecosysTracers(ecosysIndices%alk_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%doc_ind) = &
+ ecosysTracers(ecosysIndices%doc_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%don_ind) = &
+ ecosysTracers(ecosysIndices%don_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%dofe_ind) = &
+ ecosysTracers(ecosysIndices%dofe_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%dop_ind) = &
+ ecosysTracers(ecosysIndices%dop_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%donr_ind) = &
+ ecosysTracers(ecosysIndices%donr_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%dopr_ind) = &
+ ecosysTracers(ecosysIndices%dopr_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%zooC_ind) = &
+ ecosysTracers(ecosysIndices%zooC_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%spC_ind) = &
+ ecosysTracers(ecosysIndices%spC_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%spChl_ind) = &
+ ecosysTracers(ecosysIndices%spChl_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%spFe_ind) = &
+ ecosysTracers(ecosysIndices%spFe_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%spCaCO3_ind) = &
+ ecosysTracers(ecosysIndices%spCaCO3_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%diatC_ind) = &
+ ecosysTracers(ecosysIndices%diatC_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%diatChl_ind) = &
+ ecosysTracers(ecosysIndices%diatChl_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%diatFe_ind) = &
+ ecosysTracers(ecosysIndices%diatFe_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%diatSi_ind) = &
+ ecosysTracers(ecosysIndices%diatSi_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%phaeoC_ind) = &
+ ecosysTracers(ecosysIndices%phaeoC_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%phaeoChl_ind) = &
+ ecosysTracers(ecosysIndices%phaeoChl_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%phaeoFe_ind) = &
+ ecosysTracers(ecosysIndices%phaeoFe_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%diazC_ind) = &
+ ecosysTracers(ecosysIndices%diazC_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%diazChl_ind) = &
+ ecosysTracers(ecosysIndices%diazChl_ind,iLevel,iCell)
+ BGC_input%BGC_tracers(iLevel,column,BGC_indices%diazFe_ind) = &
+ ecosysTracers(ecosysIndices%diazFe_ind,iLevel,iCell)
+
+ enddo ! iLevel
+
+ call BGC_SourceSink(autotrophs, BGC_indices, BGC_input, BGC_forcing, &
+ BGC_output, BGC_diagnostic_fields, nVertLevels, &
+ numColumnsMax, numColumns)
+
+ do iLevel=1,maxLevelCell(iCell)
+
+ ecosysTracersTend(ecosysIndices%po4_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%po4_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%po4_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%no3_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%no3_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%no3_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%sio3_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%sio3_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%sio3_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%nh4_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%nh4_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%nh4_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%fe_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%fe_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%fe_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%o2_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%o2_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%o2_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%dic_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%dic_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%dic_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%dic_alt_co2_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%dic_alt_co2_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%dic_alt_co2_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%alk_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%alk_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%alk_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%doc_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%doc_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%doc_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%don_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%don_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%don_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%dofe_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%dofe_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%dofe_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%dop_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%dop_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%dop_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%dopr_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%dopr_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%dopr_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%donr_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%donr_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%donr_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%zooC_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%zooC_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%zooC_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%spC_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%spC_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%spC_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%spChl_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%spChl_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%spChl_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%spFe_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%spFe_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%spFe_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%spCaCO3_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%spCaCO3_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%spCaCO3_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%diatC_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%diatC_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%diatC_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%diatChl_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%diatChl_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%diatChl_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%diatFe_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%diatFe_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%diatFe_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%diatSi_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%diatSi_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%diatSi_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%diazC_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%diazC_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%diazC_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%diazChl_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%diazChl_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%diazChl_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%diazFe_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%diazFe_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%diazFe_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%phaeoC_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%phaeoC_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%phaeoC_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%phaeoChl_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%phaeoChl_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%phaeoChl_ind)*layerThickness(iLevel,iCell)
+ ecosysTracersTend(ecosysIndices%phaeoFe_ind,iLevel,iCell) = &
+ ecosysTracersTend(ecosysIndices%phaeoFe_ind,iLevel,iCell) &
+ + BGC_output%BGC_tendencies(iLevel,column,BGC_indices%phaeoFe_ind)*layerThickness(iLevel,iCell)
+
+ PH_PREV_3D(iLevel,iCell) = BGC_output%PH_PREV_3D(iLevel,column)
+ PH_PREV_ALT_CO2_3D(iLevel,iCell) = BGC_output%PH_PREV_ALT_CO2_3D(iLevel,column)
+
+ ecosys_diag_tot_CaCO3_form_zint(iCell) = &
+ BGC_diagnostic_fields%diag_tot_CaCO3_form_zint(column)
+ ecosys_diag_photoC_TOT_zint(iCell) = &
+ BGC_diagnostic_fields%diag_photoC_TOT_zint(column)
+ ecosys_diag_Jint_Ctot(iCell) = &
+ BGC_diagnostic_fields%diag_Jint_Ctot(column)
+ ecosys_diag_Jint_100m_Ctot(iCell) = &
+ BGC_diagnostic_fields%diag_Jint_100m_Ctot(column)
+ ecosys_diag_Jint_Ntot(iCell) = &
+ BGC_diagnostic_fields%diag_Jint_Ntot(column)
+ ecosys_diag_Jint_100m_Ntot(iCell) = &
+ BGC_diagnostic_fields%diag_Jint_100m_Ntot(column)
+ ecosys_diag_Jint_Ptot(iCell) = &
+ BGC_diagnostic_fields%diag_Jint_Ptot(column)
+ ecosys_diag_Jint_100m_Ptot(iCell) = &
+ BGC_diagnostic_fields%diag_Jint_100m_Ptot(column)
+ ecosys_diag_Jint_Sitot(iCell) = &
+ BGC_diagnostic_fields%diag_Jint_Sitot(column)
+ ecosys_diag_Jint_100m_Sitot(iCell) = &
+ BGC_diagnostic_fields%diag_Jint_100m_Sitot(column)
+ ecosys_diag_O2_ZMIN(iCell) = &
+ BGC_diagnostic_fields%diag_O2_ZMIN(column)
+ ecosys_diag_O2_ZMIN_DEPTH(iCell) = &
+ BGC_diagnostic_fields%diag_O2_ZMIN_DEPTH(column)
+
+ ecosys_diag_tot_Nfix(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_tot_Nfix(iLevel,column)
+ ecosys_diag_NITRIF(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_NITRIF(iLevel,column)
+ ecosys_diag_DENITRIF(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_DENITRIF(iLevel,column)
+ ecosys_diag_O2_PRODUCTION(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_O2_PRODUCTION(iLevel,column)
+ ecosys_diag_O2_CONSUMPTION(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_O2_CONSUMPTION(iLevel,column)
+ ecosys_diag_PAR_avg(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_PAR_avg(iLevel,column)
+ ecosys_diag_zoo_loss(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_zoo_loss(iLevel,column)
+ ecosys_diag_auto_graze_TOT(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_auto_graze_TOT(iLevel,column)
+ ecosys_diag_photoC_TOT(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_photoC_TOT(iLevel,column)
+ ecosys_diag_DOC_prod(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_DOC_prod(iLevel,column)
+ ecosys_diag_DOC_remin(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_DOC_remin(iLevel,column)
+ ecosys_diag_DON_prod(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_DON_prod(iLevel,column)
+ ecosys_diag_DON_remin(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_DON_remin(iLevel,column)
+ ecosys_diag_DOP_prod(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_DOP_prod(iLevel,column)
+ ecosys_diag_DOP_remin(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_DOP_remin(iLevel,column)
+ ecosys_diag_DOFe_prod(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_DOFe_prod(iLevel,column)
+ ecosys_diag_DOFe_remin(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_DOFe_remin(iLevel,column)
+ ecosys_diag_Fe_scavenge(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_Fe_scavenge(iLevel,column)
+ ecosys_diag_Fe_scavenge_rate(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_Fe_scavenge_rate(iLevel,column)
+ ecosys_diag_POC_FLUX_IN(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_POC_FLUX_IN(iLevel,column)
+ ecosys_diag_POC_PROD(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_POC_PROD(iLevel,column)
+ ecosys_diag_POC_REMIN(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_POC_REMIN(iLevel,column)
+ ecosys_diag_CaCO3_FLUX_IN(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_CaCO3_FLUX_IN(iLevel,column)
+ ecosys_diag_CaCO3_PROD(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_CaCO3_PROD(iLevel,column)
+ ecosys_diag_CaCO3_REMIN(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_CaCO3_REMIN(iLevel,column)
+ ecosys_diag_SiO2_FLUX_IN(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_SiO2_FLUX_IN(iLevel,column)
+ ecosys_diag_SiO2_PROD(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_SiO2_PROD(iLevel,column)
+ ecosys_diag_SiO2_REMIN(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_SiO2_REMIN(iLevel,column)
+ ecosys_diag_dust_FLUX_IN(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_dust_FLUX_IN(iLevel,column)
+ ecosys_diag_dust_REMIN(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_dust_REMIN(iLevel,column)
+ ecosys_diag_P_iron_FLUX_IN(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_P_iron_FLUX_IN(iLevel,column)
+ ecosys_diag_P_iron_PROD(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_P_iron_PROD(iLevel,column)
+ ecosys_diag_P_iron_REMIN(iLevel,iCell) = &
+ BGC_diagnostic_fields%diag_P_iron_REMIN(iLevel,column)
+
+ enddo
+
+ enddo ! iCell
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_ecosys_compute!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_ecosys_surface_flux_compute
+!
+!> \brief computes a tracer tendency due to ecosys
+!> \author Mathew Maltrud
+!> \date 11/01/2015
+!> \details
+!> This routine computes a tracer tendency due to ecosys
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_ecosys_surface_flux_compute(activeTracers, ecosysTracers, forcingPool, &
+ nTracers, nCellsSolve, zMid, indexTemperature, indexSalinity, ecosysSurfaceFlux, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ ! two dimensional arrays
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ zMid
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ ecosysSurfaceFlux
+
+ ! three dimensional arrays
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ ecosysTracers
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ activeTracers
+
+ ! scalars
+ integer, intent(in) :: nTracers, nCellsSolve, indexTemperature, indexSalinity
+
+ type (mpas_pool_type), intent(inout) :: forcingPool
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mpas_pool_type), pointer :: ecosysAuxiliary, & ! additional forcing fields
+ ecosysSeaIceCoupling
+
+ integer :: numColumns, column, iCell, iTracer, iLevelSurface
+
+! input flux components in ecosysAuxiliary
+ real (kind=RKIND), dimension(:), pointer :: &
+ seaSurfacePressure, &
+ iceFraction, &
+ windSpeedSquared10m, &
+ depositionFluxNO3, &
+ depositionFluxNH4, &
+ IRON_FLUX_IN, &
+ riverFluxNO3, &
+ riverFluxPO4, &
+ riverFluxDON, &
+ riverFluxDOP, &
+ riverFluxSiO3, &
+ riverFluxFe, &
+ riverFluxDIC, &
+ riverFluxALK, &
+ riverFluxDOC, &
+ atmosphericCO2, &
+ atmosphericCO2_ALT_CO2
+
+! input flux components in ecosysSeaIceCoupling
+ real (kind=RKIND), dimension(:), pointer :: &
+ iceFluxDIC, &
+ iceFluxDON, &
+ iceFluxNO3, &
+ iceFluxSiO3, &
+ iceFluxNH4, &
+ iceFluxDOCr, &
+ iceFluxFeDissolved
+
+ real (kind=RKIND), dimension(:,:), pointer :: iceFluxPhytoC, &
+ iceFluxDOC
+
+
+! specific output fluxes
+ real (kind=RKIND), dimension(:), pointer :: &
+ CO2_gas_flux, &
+ CO2_alt_gas_flux
+
+! input/output terms
+ real (kind=RKIND), dimension(:), pointer :: &
+ PH_PREV, &
+ PH_PREV_ALT_CO2
+
+ real (kind=RKIND) :: &
+ renormFluxes = 0.01_RKIND, &
+ PascalsToAtmospheres = 1.0_RKIND/101.325e+3_RKIND, &
+ mSquared_to_cmSquared = 1.0e+4_RKIND
+! PascalsToAtmospheres = 1.0_RKIND, &
+! mSquared_to_cmSquared = 1.0_RKIND
+! PascalsToAtmospheres = 0.0_RKIND, &
+! mSquared_to_cmSquared = 1.0_RKIND
+
+ err = 0
+
+ call mpas_pool_get_array(forcingPool, 'seaSurfacePressure', seaSurfacePressure)
+ call mpas_pool_get_array(forcingPool, 'iceFraction', iceFraction)
+
+ call mpas_pool_get_subpool(forcingPool, 'ecosysAuxiliary', ecosysAuxiliary)
+
+ call mpas_pool_get_array(ecosysAuxiliary, 'windSpeedSquared10m', windSpeedSquared10m)
+ call mpas_pool_get_array(ecosysAuxiliary, 'PH_PREV', PH_PREV)
+ call mpas_pool_get_array(ecosysAuxiliary, 'PH_PREV_ALT_CO2', PH_PREV_ALT_CO2)
+ call mpas_pool_get_array(ecosysAuxiliary, 'depositionFluxNO3', depositionFluxNO3)
+ call mpas_pool_get_array(ecosysAuxiliary, 'depositionFluxNH4', depositionFluxNH4)
+ call mpas_pool_get_array(ecosysAuxiliary, 'IRON_FLUX_IN', IRON_FLUX_IN)
+ call mpas_pool_get_array(ecosysAuxiliary, 'riverFluxNO3', riverFluxNO3)
+ call mpas_pool_get_array(ecosysAuxiliary, 'riverFluxPO4', riverFluxPO4)
+ call mpas_pool_get_array(ecosysAuxiliary, 'riverFluxDON', riverFluxDON)
+ call mpas_pool_get_array(ecosysAuxiliary, 'riverFluxDOP', riverFluxDOP)
+ call mpas_pool_get_array(ecosysAuxiliary, 'riverFluxSiO3', riverFluxSiO3)
+ call mpas_pool_get_array(ecosysAuxiliary, 'riverFluxFe', riverFluxFe)
+ call mpas_pool_get_array(ecosysAuxiliary, 'riverFluxDIC', riverFluxDIC)
+ call mpas_pool_get_array(ecosysAuxiliary, 'riverFluxALK', riverFluxALK)
+ call mpas_pool_get_array(ecosysAuxiliary, 'riverFluxDOC', riverFluxDOC)
+ call mpas_pool_get_array(ecosysAuxiliary, 'atmosphericCO2', atmosphericCO2)
+ call mpas_pool_get_array(ecosysAuxiliary, 'atmosphericCO2_ALT_CO2', atmosphericCO2_ALT_CO2)
+
+ call mpas_pool_get_array(ecosysAuxiliary, 'CO2_gas_flux', CO2_gas_flux)
+ call mpas_pool_get_array(ecosysAuxiliary, 'CO2_alt_gas_flux', CO2_alt_gas_flux)
+
+ call mpas_pool_get_subpool(forcingPool, 'ecosysSeaIceCoupling', ecosysSeaIceCoupling)
+
+ call mpas_pool_get_array(ecosysSeaIceCoupling, 'iceFluxPhytoC', iceFluxPhytoC)
+ call mpas_pool_get_array(ecosysSeaIceCoupling, 'iceFluxDIC', iceFluxDIC)
+ call mpas_pool_get_array(ecosysSeaIceCoupling, 'iceFluxNO3', iceFluxNO3)
+ call mpas_pool_get_array(ecosysSeaIceCoupling, 'iceFluxSiO3', iceFluxSiO3)
+ call mpas_pool_get_array(ecosysSeaIceCoupling, 'iceFluxNH4', iceFluxNH4)
+ call mpas_pool_get_array(ecosysSeaIceCoupling, 'iceFluxDOCr', iceFluxDOCr)
+ call mpas_pool_get_array(ecosysSeaIceCoupling, 'iceFluxDOC', iceFluxDOC)
+ call mpas_pool_get_array(ecosysSeaIceCoupling, 'iceFluxDON', iceFluxDON)
+ call mpas_pool_get_array(ecosysSeaIceCoupling, 'iceFluxFeDissolved', iceFluxFeDissolved)
+
+ BGC_forcing%lcalc_O2_gas_flux = .true.
+ BGC_forcing%lcalc_CO2_gas_flux = .true.
+
+ numColumns = 1
+ column = 1
+ iLevelSurface = 1
+ do iCell=1,nCellsSolve
+
+ BGC_forcing%surfacePressure(column) = seaSurfacePressure(iCell)*PascalsToAtmospheres
+ BGC_forcing%iceFraction(column) = iceFraction(iCell)
+ BGC_forcing%windSpeedSquared10m(column) = windSpeedSquared10m(iCell)*mSquared_to_cmSquared
+ BGC_forcing%atmCO2(column) = atmosphericCO2(iCell)
+ BGC_forcing%atmCO2_ALT_CO2(column) = atmosphericCO2_ALT_CO2(iCell)
+ BGC_forcing%surface_pH(column) = PH_PREV(iCell)
+ BGC_forcing%surface_pH_alt_co2(column) = PH_PREV_ALT_CO2(iCell)
+ BGC_forcing%surfaceDepth(column) = -1.0_RKIND*zMid(iLevelSurface,iCell)
+ BGC_forcing%SST(column) = activeTracers(indexTemperature,iLevelSurface,iCell)
+ BGC_forcing%SSS(column) = activeTracers(indexSalinity,iLevelSurface,iCell)
+
+ BGC_input%BGC_tracers(1,column,BGC_indices%dic_ind) = ecosysTracers(ecosysIndices%dic_ind,1,iCell)
+ BGC_input%BGC_tracers(1,column,BGC_indices%alk_ind) = ecosysTracers(ecosysIndices%alk_ind,1,iCell)
+ BGC_input%BGC_tracers(1,column,BGC_indices%po4_ind) = ecosysTracers(ecosysIndices%po4_ind,1,iCell)
+ BGC_input%BGC_tracers(1,column,BGC_indices%sio3_ind) = ecosysTracers(ecosysIndices%sio3_ind,1,iCell)
+
+ BGC_input%BGC_tracers(1,column,BGC_indices%o2_ind) = ecosysTracers(ecosysIndices%o2_ind,1,iCell)
+
+! NOTE pass in total Fe and mult by parm_Fe_bioavail inside the flux routine
+! divide river Fe by bioavail since it is already the available to make it total
+
+ BGC_forcing%depositionFlux(column,BGC_indices%no3_ind) = depositionFluxNO3(iCell)
+ BGC_forcing%depositionFlux(column,BGC_indices%nh4_ind) = depositionFluxNH4(iCell)
+ BGC_forcing%depositionFlux(column,BGC_indices%fe_ind) = IRON_FLUX_IN(iCell)
+
+ BGC_forcing%riverFlux(column,BGC_indices%no3_ind) = riverFluxNO3(iCell)
+ BGC_forcing%riverFlux(column,BGC_indices%po4_ind) = riverFluxPO4(iCell)
+ BGC_forcing%riverFlux(column,BGC_indices%don_ind) = riverFluxDON(iCell) * 0.9_BGC_r8
+ BGC_forcing%riverFlux(column,BGC_indices%donr_ind) = riverFluxDON(iCell) * 0.1_BGC_r8
+ BGC_forcing%riverFlux(column,BGC_indices%dop_ind) = riverFluxDOP(iCell) * 0.975_BGC_r8
+ BGC_forcing%riverFlux(column,BGC_indices%dopr_ind) = riverFluxDOP(iCell) * 0.025_BGC_r8
+ BGC_forcing%riverFlux(column,BGC_indices%sio3_ind) = riverFluxSiO3(iCell)
+ BGC_forcing%riverFlux(column,BGC_indices%fe_ind) = riverFluxFe(iCell) / parm_Fe_bioavail
+ BGC_forcing%riverFlux(column,BGC_indices%dic_ind) = riverFluxDIC(iCell)
+ BGC_forcing%riverFlux(column,BGC_indices%dic_alt_co2_ind) = riverFluxDIC(iCell)
+ BGC_forcing%riverFlux(column,BGC_indices%alk_ind) = riverFluxALK(iCell)
+ BGC_forcing%riverFlux(column,BGC_indices%doc_ind) = riverFluxDOC(iCell)
+
+!maltrud debug
+! BGC_forcing%seaIceFlux(column,BGC_indices%no3_ind) = iceFluxNO3(iCell)
+! BGC_forcing%seaIceFlux(column,BGC_indices%don_ind) = iceFluxDON(iCell)
+!maltrud renorm value?
+! BGC_forcing%seaIceFlux(column,BGC_indices%donr_ind) = iceFluxDOCr(iCell) * ????
+! BGC_forcing%seaIceFlux(column,BGC_indices%donr_ind) = iceFluxDOCr(iCell)
+! BGC_forcing%seaIceFlux(column,BGC_indices%sio3_ind) = iceFluxSiO3(iCell)
+! BGC_forcing%seaIceFlux(column,BGC_indices%nh4_ind) = iceFluxNH4(iCell)
+! BGC_forcing%seaIceFlux(column,BGC_indices%fe_ind) = iceFluxFeDissolved(iCell) / parm_Fe_bioavail
+! BGC_forcing%seaIceFlux(column,BGC_indices%dic_ind) = iceFluxDIC(iCell)
+! BGC_forcing%seaIceFlux(column,BGC_indices%dic_alt_co2_ind) = iceFluxDIC(iCell)
+
+! BGC_forcing%seaIceFlux(column,BGC_indices%doc_ind) = iceFluxDOC(1,iCell) + iceFluxDOC(2,iCell)
+
+! BGC_forcing%seaIceFlux(column,BGC_indices%diatC_ind) = iceFluxPhytoC(1,iCell)
+! BGC_forcing%seaIceFlux(column,BGC_indices%spC_ind) = iceFluxPhytoC(2,iCell)
+! BGC_forcing%seaIceFlux(column,BGC_indices%phaeoC_ind) = iceFluxPhytoC(3,iCell)
+
+ call BGC_SurfaceFluxes(BGC_indices, BGC_input, BGC_forcing, &
+ BGC_flux_diagnostic_fields, &
+ numColumnsMax, column)
+
+ PH_PREV(iCell) = BGC_forcing%surface_pH(column)
+ PH_PREV_ALT_CO2(iCell) = BGC_forcing%surface_pH_alt_co2(column)
+
+ ecosysSurfaceFlux(ecosysIndices%no3_ind,iCell) = BGC_forcing%netFlux(column,BGC_indices%no3_ind)*renormFluxes
+ ecosysSurfaceFlux(ecosysIndices%po4_ind,iCell) = BGC_forcing%netFlux(column,BGC_indices%po4_ind)*renormFluxes
+ ecosysSurfaceFlux(ecosysIndices%sio3_ind,iCell) = BGC_forcing%netFlux(column,BGC_indices%sio3_ind)*renormFluxes
+ ecosysSurfaceFlux(ecosysIndices%nh4_ind,iCell) = BGC_forcing%netFlux(column,BGC_indices%nh4_ind)*renormFluxes
+ ecosysSurfaceFlux(ecosysIndices%don_ind,iCell) = BGC_forcing%netFlux(column,BGC_indices%don_ind)*renormFluxes
+ ecosysSurfaceFlux(ecosysIndices%donr_ind,iCell) = BGC_forcing%netFlux(column,BGC_indices%donr_ind)*renormFluxes
+ ecosysSurfaceFlux(ecosysIndices%dop_ind,iCell) = BGC_forcing%netFlux(column,BGC_indices%dop_ind)*renormFluxes
+ ecosysSurfaceFlux(ecosysIndices%dopr_ind,iCell) = BGC_forcing%netFlux(column,BGC_indices%dopr_ind)*renormFluxes
+ ecosysSurfaceFlux(ecosysIndices%fe_ind,iCell) = BGC_forcing%netFlux(column,BGC_indices%fe_ind)*renormFluxes
+ ecosysSurfaceFlux(ecosysIndices%alk_ind,iCell) = BGC_forcing%netFlux(column,BGC_indices%alk_ind)*renormFluxes
+ ecosysSurfaceFlux(ecosysIndices%doc_ind,iCell) = BGC_forcing%netFlux(column,BGC_indices%doc_ind)*renormFluxes
+ ecosysSurfaceFlux(ecosysIndices%o2_ind,iCell) = BGC_forcing%netFlux(column,BGC_indices%o2_ind)*renormFluxes
+ ecosysSurfaceFlux(ecosysIndices%dic_ind,iCell) = BGC_forcing%netFlux(column,BGC_indices%dic_ind)*renormFluxes
+ ecosysSurfaceFlux(ecosysIndices%dic_alt_co2_ind,iCell) = &
+ BGC_forcing%netFlux(column,BGC_indices%dic_alt_co2_ind)*renormFluxes
+
+!explicitly set the rest to 0
+! NOTE: some will not be zero when we get sea ice fluxes
+ ecosysSurfaceFlux(ecosysIndices%dofe_ind,iCell) = 0.0_RKIND
+ ecosysSurfaceFlux(ecosysIndices%zooC_ind,iCell) = 0.0_RKIND
+ ecosysSurfaceFlux(ecosysIndices%spC_ind,iCell) = 0.0_RKIND
+ ecosysSurfaceFlux(ecosysIndices%spChl_ind,iCell) = 0.0_RKIND
+ ecosysSurfaceFlux(ecosysIndices%spFe_ind,iCell) = 0.0_RKIND
+ ecosysSurfaceFlux(ecosysIndices%spCaCO3_ind,iCell) = 0.0_RKIND
+ ecosysSurfaceFlux(ecosysIndices%diatC_ind,iCell) = 0.0_RKIND
+ ecosysSurfaceFlux(ecosysIndices%diatChl_ind,iCell) = 0.0_RKIND
+ ecosysSurfaceFlux(ecosysIndices%diatFe_ind,iCell) = 0.0_RKIND
+ ecosysSurfaceFlux(ecosysIndices%diatSi_ind,iCell) = 0.0_RKIND
+ ecosysSurfaceFlux(ecosysIndices%diazC_ind,iCell) = 0.0_RKIND
+ ecosysSurfaceFlux(ecosysIndices%diazChl_ind,iCell) = 0.0_RKIND
+ ecosysSurfaceFlux(ecosysIndices%diazFe_ind,iCell) = 0.0_RKIND
+ ecosysSurfaceFlux(ecosysIndices%phaeoC_ind,iCell) = 0.0_RKIND
+ ecosysSurfaceFlux(ecosysIndices%phaeoChl_ind,iCell) = 0.0_RKIND
+ ecosysSurfaceFlux(ecosysIndices%phaeoFe_ind,iCell) = 0.0_RKIND
+
+ CO2_gas_flux(iCell) = BGC_forcing%gasFlux(column,BGC_indices%dic_ind)*renormFluxes
+ CO2_alt_gas_flux(iCell) = BGC_forcing%gasFlux(column,BGC_indices%dic_alt_co2_ind)*renormFluxes
+
+ enddo ! iCell
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_ecosys_surface_flux_compute!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_ecosys_init
+!
+!> \brief Initializes ocean surface restoring
+!> \author Mathew Maltrud
+!> \date 11/01/2015
+!> \details
+!> This routine initializes fields required for tracer surface flux restoring
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_ecosys_init(domain,err)!{{{
+
+!NOTE: called from mpas_ocn_forward_mode.F
+
+ type (domain_type), intent(inout) :: domain !< Input/Output: domain information
+
+ integer, intent(out) :: err !< Output: error flag
+
+ type (mpas_pool_type), pointer :: statePool
+ type (mpas_pool_type), pointer :: tracersPool
+
+ ! three dimensional pointers
+ real (kind=RKIND), dimension(:,:,:), pointer :: &
+ ecosysTracers
+
+ ! scalars
+ integer :: nTracers, numColumnsMax
+
+ ! scalar pointers
+ integer, pointer :: nVertLevels, index_dummy
+
+ !
+ ! get tracers pools
+ !
+
+ err = 0
+
+ !
+ ! Get tracer group so we can get the number of tracers in it
+ !
+
+ call mpas_pool_get_subpool(domain % blocklist % structs, 'state', statePool)
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+ call mpas_pool_get_array(tracersPool, 'ecosysTracers', ecosysTracers, 1)
+
+ if (associated(ecosysTracers)) then
+
+ nTracers = size(ecosysTracers, dim=1)
+ if (BGC_tracer_cnt /= nTracers) then
+ err = 1
+ return
+ endif
+
+ !
+ ! pull nVertLevels out of the mesh structure
+ !
+
+ call mpas_pool_get_dimension(domain % blocklist % dimensions, 'nVertLevels', nVertLevels)
+
+!-----------------------------------------------------------------------
+! initialize ecosystem parameters
+!-----------------------------------------------------------------------
+
+ allocate( BGC_indices%short_name(BGC_tracer_cnt) )
+ allocate( BGC_indices%long_name(BGC_tracer_cnt) )
+ allocate( BGC_indices%units(BGC_tracer_cnt) )
+
+! no need to allocate the above fields for ecosysIndices (?)
+
+!-----------------------------------------------------------------------
+! sets most of BGC parameters
+! sets namelist defaults
+! sets autotroph sp_ind, diat_ind, diaz_ind, phaeo_ind (swang)
+!-----------------------------------------------------------------------
+
+ call BGC_parms_init(BGC_indices, autotrophs)
+
+! modify autotroph values here....
+! for example to change sp_kFe
+! autotrophs(BGC_indices%sp_ind)%kFe = 0.05e-3_BGC_r8
+
+!maltrud how to handle this?
+ T0_Kelvin_BGC = T0_Kelvin
+
+ !
+ ! for now only do 1 column at a time
+ !
+ numColumnsMax = 1
+
+ BGC_indices%po4_ind = 1
+ BGC_indices%no3_ind = 2
+ BGC_indices%sio3_ind = 3
+ BGC_indices%nh4_ind = 4
+ BGC_indices%fe_ind = 5
+ BGC_indices%o2_ind = 6
+ BGC_indices%dic_ind = 7
+ BGC_indices%dic_alt_co2_ind = 8
+ BGC_indices%alk_ind = 9
+ BGC_indices%doc_ind = 10
+ BGC_indices%don_ind = 11
+ BGC_indices%dofe_ind = 12
+ BGC_indices%dop_ind = 13
+ BGC_indices%dopr_ind = 14
+ BGC_indices%donr_ind = 15
+ BGC_indices%zooC_ind = 16
+ BGC_indices%spChl_ind = 17
+ BGC_indices%spC_ind = 18
+ BGC_indices%spFe_ind = 19
+ BGC_indices%spCaCO3_ind = 20
+ BGC_indices%diatChl_ind = 21
+ BGC_indices%diatC_ind = 22
+ BGC_indices%diatFe_ind = 23
+ BGC_indices%diatSi_ind = 24
+ BGC_indices%diazChl_ind = 25
+ BGC_indices%diazC_ind = 26
+ BGC_indices%diazFe_ind = 27
+ BGC_indices%phaeoChl_ind = 28
+ BGC_indices%phaeoC_ind = 29
+ BGC_indices%phaeoFe_ind = 30
+
+ call mpas_pool_get_dimension(tracersPool, 'index_PO4', index_dummy)
+ ecosysIndices%po4_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_NO3', index_dummy)
+ ecosysIndices%no3_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_SiO3', index_dummy)
+ ecosysIndices%sio3_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_NH4', index_dummy)
+ ecosysIndices%nh4_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_Fe', index_dummy)
+ ecosysIndices%fe_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_O2', index_dummy)
+ ecosysIndices%o2_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DIC', index_dummy)
+ ecosysIndices%dic_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DIC_ALT_CO2', index_dummy)
+ ecosysIndices%dic_alt_co2_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_ALK', index_dummy)
+ ecosysIndices%alk_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DOC', index_dummy)
+ ecosysIndices%doc_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DON', index_dummy)
+ ecosysIndices%don_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DOFe', index_dummy)
+ ecosysIndices%dofe_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DOP', index_dummy)
+ ecosysIndices%dop_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DOPr', index_dummy)
+ ecosysIndices%dopr_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_DONr', index_dummy)
+ ecosysIndices%donr_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_zooC', index_dummy)
+ ecosysIndices%zooC_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_spChl', index_dummy)
+ ecosysIndices%spChl_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_spC', index_dummy)
+ ecosysIndices%spC_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_spFe', index_dummy)
+ ecosysIndices%spFe_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_spCaCO3', index_dummy)
+ ecosysIndices%spCaCO3_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diatChl', index_dummy)
+ ecosysIndices%diatChl_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diatC', index_dummy)
+ ecosysIndices%diatC_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diatFe', index_dummy)
+ ecosysIndices%diatFe_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diatSi', index_dummy)
+ ecosysIndices%diatSi_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diazChl', index_dummy)
+ ecosysIndices%diazChl_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diazC', index_dummy)
+ ecosysIndices%diazC_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_diazFe', index_dummy)
+ ecosysIndices%diazFe_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_phaeoChl', index_dummy)
+ ecosysIndices%phaeoChl_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_phaeoC', index_dummy)
+ ecosysIndices%phaeoC_ind = index_dummy
+ call mpas_pool_get_dimension(tracersPool, 'index_phaeoFe', index_dummy)
+ ecosysIndices%phaeoFe_ind = index_dummy
+
+! BGC_init sets short and long names, units in BGC_indices
+! also sets autotroph indices within the autotroph derived type
+
+ call BGC_init(BGC_indices, autotrophs)
+
+!NOTES:
+
+!also check short_name with mpas variable name
+
+!-----------------------------------------------------------------------
+! allocate input, forcing, diagnostic arrays
+!-----------------------------------------------------------------------
+
+ allocate ( BGC_input%BGC_tracers(nVertLevels, numColumnsMax, BGC_tracer_cnt) )
+ allocate ( BGC_input%PotentialTemperature(nVertLevels, numColumnsMax) )
+ allocate ( BGC_input%Salinity(nVertLevels, numColumnsMax) )
+ allocate ( BGC_input%cell_center_depth(nVertLevels, numColumnsMax) )
+ allocate ( BGC_input%cell_thickness(nVertLevels, numColumnsMax) )
+ allocate ( BGC_input%cell_bottom_depth(nVertLevels, numColumnsMax) )
+ allocate ( BGC_input%number_of_active_levels(numColumnsMax) )
+
+ allocate ( BGC_forcing%FESEDFLUX(nVertLevels, numColumnsMax) )
+ allocate ( BGC_forcing%NUTR_RESTORE_RTAU(nVertLevels, numColumnsMax) )
+ allocate ( BGC_forcing%NO3_CLIM(nVertLevels, numColumnsMax) )
+ allocate ( BGC_forcing%PO4_CLIM(nVertLevels, numColumnsMax) )
+ allocate ( BGC_forcing%SiO3_CLIM(nVertLevels, numColumnsMax) )
+
+ allocate ( BGC_forcing%dust_FLUX_IN(numColumnsMax) )
+ allocate ( BGC_forcing%ShortWaveFlux_surface(numColumnsMax) )
+ allocate ( BGC_forcing%surfacePressure(numColumnsMax) )
+ allocate ( BGC_forcing%iceFraction(numColumnsMax) )
+ allocate ( BGC_forcing%windSpeedSquared10m(numColumnsMax) )
+ allocate ( BGC_forcing%atmCO2(numColumnsMax) )
+ allocate ( BGC_forcing%atmCO2_ALT_CO2(numColumnsMax) )
+ allocate ( BGC_forcing%surface_pH(numColumnsMax) )
+ allocate ( BGC_forcing%surface_pH_alt_co2(numColumnsMax) )
+ allocate ( BGC_forcing%surfaceDepth(numColumnsMax) )
+ allocate ( BGC_forcing%SST(numColumnsMax) )
+ allocate ( BGC_forcing%SSS(numColumnsMax) )
+
+ allocate ( BGC_forcing%depositionFlux(numColumnsMax, BGC_tracer_cnt) )
+ allocate ( BGC_forcing%riverFlux(numColumnsMax, BGC_tracer_cnt) )
+ allocate ( BGC_forcing%gasFlux(numColumnsMax, BGC_tracer_cnt) )
+ allocate ( BGC_forcing%seaIceFlux(numColumnsMax, BGC_tracer_cnt) )
+ allocate ( BGC_forcing%netFlux(numColumnsMax, BGC_tracer_cnt) )
+ BGC_forcing%depositionFlux = 0.0_RKIND
+ BGC_forcing%riverFlux = 0.0_RKIND
+ BGC_forcing%gasFlux = 0.0_RKIND
+ BGC_forcing%seaIceFlux = 0.0_RKIND
+ BGC_forcing%netFlux = 0.0_RKIND
+
+ allocate ( BGC_output%BGC_tendencies(nVertLevels, numColumnsMax, BGC_tracer_cnt) )
+ allocate ( BGC_output%PH_PREV_3D(nVertLevels, numColumnsMax) )
+ allocate ( BGC_output%PH_PREV_ALT_CO2_3D(nVertLevels, numColumnsMax) )
+
+ !---------------------------------------------------------------------------
+ ! allocate flux diagnostic output fields
+ !---------------------------------------------------------------------------
+
+ allocate (BGC_flux_diagnostic_fields%pistonVel_O2(numColumnsMax) )
+ allocate (BGC_flux_diagnostic_fields%pistonVel_CO2(numColumnsMax) )
+ allocate (BGC_flux_diagnostic_fields%SCHMIDT_O2(numColumnsMax) )
+ allocate (BGC_flux_diagnostic_fields%SCHMIDT_CO2(numColumnsMax) )
+ allocate (BGC_flux_diagnostic_fields%O2SAT(numColumnsMax) )
+ allocate (BGC_flux_diagnostic_fields%xkw(numColumnsMax) )
+ allocate (BGC_flux_diagnostic_fields%co2star(numColumnsMax) )
+ allocate (BGC_flux_diagnostic_fields%dco2star(numColumnsMax) )
+ allocate (BGC_flux_diagnostic_fields%pco2surf(numColumnsMax) )
+ allocate (BGC_flux_diagnostic_fields%dpco2(numColumnsMax) )
+ allocate (BGC_flux_diagnostic_fields%co2star_alt_co2(numColumnsMax) )
+ allocate (BGC_flux_diagnostic_fields%dco2star_alt_co2(numColumnsMax) )
+ allocate (BGC_flux_diagnostic_fields%pco2surf_alt_co2(numColumnsMax) )
+ allocate (BGC_flux_diagnostic_fields%dpco2_alt_co2(numColumnsMax) )
+
+ !---------------------------------------------------------------------------
+ ! allocate diagnostic output fields
+ !---------------------------------------------------------------------------
+
+ ! 3D stuff
+ allocate (BGC_diagnostic_fields%diag_tot_Nfix(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_O2_PRODUCTION(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_O2_CONSUMPTION(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_AOU(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_PO4_RESTORE(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_NO3_RESTORE(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_SiO3_RESTORE(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_PAR_avg(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_POC_FLUX_IN(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_POC_PROD(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_POC_REMIN(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_POC_ACCUM(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_CaCO3_FLUX_IN(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_CaCO3_PROD(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_CaCO3_REMIN(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_SiO2_FLUX_IN(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_SiO2_PROD(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_SiO2_REMIN(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_dust_FLUX_IN(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_dust_REMIN(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_P_iron_FLUX_IN(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_P_iron_PROD(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_P_iron_REMIN(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_auto_graze_TOT(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_zoo_loss(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_photoC_TOT(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_photoC_NO3_TOT(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_DOC_prod(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_DOC_remin(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_DON_prod(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_DON_remin(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_DOFe_prod(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_DOFe_remin(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_DOP_prod(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_DOP_remin(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_Fe_scavenge(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_Fe_scavenge_rate(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_NITRIF(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_DENITRIF(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_DONr_remin(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_DOPr_remin(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_CO3(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_HCO3(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_H2CO3(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_pH_3D(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_CO3_ALT_CO2(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_HCO3_ALT_CO2(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_H2CO3_ALT_CO2(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_pH_3D_ALT_CO2(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_co3_sat_calc(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_co3_sat_arag(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_calcToSed(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_pocToSed(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_ponToSed(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_popToSed(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_bsiToSed(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_dustToSed(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_pfeToSed(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_SedDenitrif(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_OtherRemin(nVertLevels, numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_tot_CaCO3_form(nVertLevels, numColumnsMax) )
+
+! 3D stuff for each autotroph
+ allocate (BGC_diagnostic_fields%diag_N_lim(nVertLevels, numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_P_lim(nVertLevels, numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_Fe_lim(nVertLevels, numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_SiO3_lim(nVertLevels, numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_light_lim(nVertLevels, numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_photoC(nVertLevels, numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_photoC_NO3(nVertLevels, numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_photoFe(nVertLevels, numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_photoNO3(nVertLevels, numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_photoNH4(nVertLevels, numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_DOP_uptake(nVertLevels, numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_PO4_uptake(nVertLevels, numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_auto_graze(nVertLevels, numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_auto_loss(nVertLevels, numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_auto_agg(nVertLevels, numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_bSi_form(nVertLevels, numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_CaCO3_form(nVertLevels, numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_Nfix(nVertLevels, numColumnsMax, autotroph_cnt) )
+
+! 2D stuff for each autotroph
+ allocate (BGC_diagnostic_fields%diag_photoC_zint(numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_photoC_NO3_zint(numColumnsMax, autotroph_cnt) )
+ allocate (BGC_diagnostic_fields%diag_CaCO3_form_zint(numColumnsMax, autotroph_cnt) )
+
+! 2D vertical integrals for photoC
+ allocate (BGC_diagnostic_fields%diag_photoC_TOT_zint(numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_photoC_NO3_TOT_zint(numColumnsMax) )
+
+! 2D vertical integrals for nutrients
+ allocate (BGC_diagnostic_fields%diag_Jint_Ctot(numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_Jint_100m_Ctot(numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_Jint_Ntot(numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_Jint_100m_Ntot(numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_Jint_Ptot(numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_Jint_100m_Ptot(numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_Jint_Sitot(numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_Jint_100m_Sitot(numColumnsMax) )
+
+! 2D stuff
+ allocate (BGC_diagnostic_fields%diag_tot_bSi_form(numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_tot_CaCO3_form_zint(numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_zsatcalc(numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_zsatarag(numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_O2_ZMIN(numColumnsMax) )
+ allocate (BGC_diagnostic_fields%diag_O2_ZMIN_DEPTH(numColumnsMax) )
+
+ end if ! associated(ecosysTracers)
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_ecosys_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_ecosys
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_exponential_decay.F b/src/core_ocean/shared/mpas_ocn_tracer_exponential_decay.F
new file mode 100644
index 0000000000..2c31edc904
--- /dev/null
+++ b/src/core_ocean/shared/mpas_ocn_tracer_exponential_decay.F
@@ -0,0 +1,166 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_exponential_decay
+!
+!> \brief MPAS ocean exponential decay
+!> \author Todd Ringler
+!> \date 06/08/2015
+!> \details
+!> This module contains routines for computing tracer forcing due to exponential decay
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_exponential_decay
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+ use ocn_constants
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_tracer_exponential_decay_compute, &
+ ocn_tracer_exponential_decay_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_exponential_decay_compute
+!
+!> \brief computes a tracer tendency due to exponential decay
+!> \author Todd Ringler
+!> \date 06/09/2015
+!> \details
+!> This routine computes a tracer tendency due to exponential decay
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_exponential_decay_compute(nTracers, nCellsSolve, maxLevelCell, layerThickness, tracers, & !{{{
+ tracersExponentialDecayRate, tracer_tend, err)
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ ! one dimensional arrays
+ integer, dimension(:), intent(in) :: &
+ maxLevelCell
+
+ real (kind=RKIND), dimension(:), intent(in) :: &
+ tracersExponentialDecayRate
+
+ ! two dimensional arrays
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ layerThickness
+
+ ! three dimensional arrays
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers
+
+ ! scalars
+ integer, intent(in) :: nTracers, nCellsSolve
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tracer_tend
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iCell, iLevel, iTracer
+
+ err = 0
+
+ !$omp do schedule(runtime) private(iLevel, iTracer)
+ do iCell=1,nCellsSolve
+ do iLevel=1,maxLevelCell(iCell)
+ do iTracer=1,nTracers
+ tracer_tend(iTracer,iLevel,iCell) = tracer_tend(iTracer,iLevel,iCell) &
+ - ( layerThickness(iLevel,iCell) &
+ * tracers(iTracer,iLevel,iCell) &
+ * exp(-tracersExponentialDecayRate(iTracer)) )
+ enddo
+ enddo
+ enddo
+ !$omp end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_exponential_decay_compute!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_exponential_decay_init
+!
+!> \brief Initializes ocean surface restoring
+!> \author Todd Ringler
+!> \date 06/09/2015
+!> \details
+!> This routine initializes fields required for tracer surface flux restoring
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_exponential_decay_init(err)!{{{
+
+ integer, intent(out) :: err !< Output: error flag
+
+ err = 0
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_exponential_decay_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_exponential_decay
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_hmix.F b/src/core_ocean/shared/mpas_ocn_tracer_hmix.F
index a7cfbd8b88..956552b25d 100644
--- a/src/core_ocean/shared/mpas_ocn_tracer_hmix.F
+++ b/src/core_ocean/shared/mpas_ocn_tracer_hmix.F
@@ -13,8 +13,8 @@
!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
!> \date September 2011
!> \details
-!> This module contains the main driver routine for computing
-!> horizontal mixing tendencies.
+!> This module contains the main driver routine for computing
+!> horizontal mixing tendencies.
!>
!> It provides an init and a tend function. Each are described below.
!
@@ -28,6 +28,7 @@ module ocn_tracer_hmix
use ocn_constants
use ocn_tracer_hmix_del2
use ocn_tracer_hmix_del4
+ use ocn_tracer_hmix_redi
implicit none
private
@@ -67,7 +68,7 @@ module ocn_tracer_hmix
!> \brief Computes tendency term for horizontal tracer mixing
!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the horizontal mixing tendency for tracer
!> based on current state and user choices of mixing parameterization.
!> Multiple parameterizations may be chosen and added together. These
@@ -77,7 +78,7 @@ module ocn_tracer_hmix
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_hmix_tend(meshPool, scratchPool, layerThickness, layerThicknessEdge, zMid, tracers, &
+ subroutine ocn_tracer_hmix_tend(meshPool, scratchPool, layerThicknessEdge, zMid, tracers, &
relativeSlopeTopOfEdge, relativeSlopeTapering, relativeSlopeTaperingCell, tend, err)!{{{
@@ -90,7 +91,6 @@ subroutine ocn_tracer_hmix_tend(meshPool, scratchPool, layerThickness, layerThic
type (mpas_pool_type), intent(in) :: scratchPool !< Input: Scratch information
real (kind=RKIND), dimension(:,:), intent(in) :: &
- layerThickness, &!< Input: thickness at cell centers
layerThicknessEdge, &!< Input: thickness at edge
zMid !< Input: Z coordinate at the center of a cell
@@ -130,7 +130,7 @@ subroutine ocn_tracer_hmix_tend(meshPool, scratchPool, layerThickness, layerThic
!-----------------------------------------------------------------
!
! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
+ ! note that the user can choose multiple options and the
! tendencies will be added together
!
!-----------------------------------------------------------------
@@ -138,12 +138,15 @@ subroutine ocn_tracer_hmix_tend(meshPool, scratchPool, layerThickness, layerThic
if(.not.tracerHmixOn) return
call mpas_timer_start("del2")
- call ocn_tracer_hmix_del2_tend(meshPool, scratchPool, layerThickness, layerThicknessEdge, zMid, tracers, &
- relativeSlopeTopOfEdge, relativeSlopeTapering, relativeSlopeTaperingCell, tend, err1)
+ call ocn_tracer_hmix_del2_tend(meshPool, layerThicknessEdge, tracers, tend, err1)
call mpas_timer_stop("del2")
call mpas_timer_start("del4")
- call ocn_tracer_hmix_del4_tend(meshPool, layerThicknessEdge, tracers, tend, err2)
+ call ocn_tracer_hmix_del4_tend(meshPool, scratchPool, layerThicknessEdge, tracers, tend, err2)
call mpas_timer_stop("del4")
+ call mpas_timer_start("redi")
+ call ocn_tracer_hmix_redi_tend(meshPool, scratchPool, layerThicknessEdge, zMid, tracers, &
+ relativeSlopeTopOfEdge, relativeSlopeTapering, relativeSlopeTaperingCell, tend, err1)
+ call mpas_timer_stop("redi")
err = ior(err1, err2)
@@ -158,11 +161,11 @@ end subroutine ocn_tracer_hmix_tend!}}}
!> \brief Initializes ocean tracer horizontal mixing quantities
!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
!> \date September 2011
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity mixing in the ocean. Since a variety of
+!> \details
+!> This routine initializes a variety of quantities related to
+!> horizontal velocity mixing in the ocean. Since a variety of
!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
+!> individual init routines for each parameterization.
!
!-----------------------------------------------------------------------
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_hmix_del2.F b/src/core_ocean/shared/mpas_ocn_tracer_hmix_del2.F
index aca1d227a4..1ccd6853ae 100644
--- a/src/core_ocean/shared/mpas_ocn_tracer_hmix_del2.F
+++ b/src/core_ocean/shared/mpas_ocn_tracer_hmix_del2.F
@@ -13,8 +13,8 @@
!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
!> \date September 2011
!> \details
-!> This module contains the main driver routine for computing
-!> horizontal mixing tendencies.
+!> This module contains the main driver routine for computing
+!> horizontal mixing tendencies.
!>
!> It provides an init and a tend function. Each are described below.
!
@@ -24,6 +24,7 @@ module ocn_tracer_hmix_del2
use mpas_derived_types
use mpas_pool_routines
+ use mpas_threading
use ocn_constants
@@ -53,12 +54,7 @@ module ocn_tracer_hmix_del2
!--------------------------------------------------------------------
logical :: del2On
- logical, pointer :: config_use_standardGM
- logical, pointer :: config_disable_redi_horizontal_term1
- logical, pointer :: config_disable_redi_horizontal_term2
- logical, pointer :: config_disable_redi_horizontal_term3
real (kind=RKIND) :: eddyDiff2
- real (kind=RKIND), pointer :: config_Redi_kappa
!***********************************************************************
@@ -72,16 +68,13 @@ module ocn_tracer_hmix_del2
!> \brief Computes Laplacian tendency term for horizontal tracer mixing
!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the horizontal mixing tendency for tracers
!> based on current state using a Laplacian parameterization.
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_hmix_del2_tend(meshPool, scratchPool, layerThickness, layerThicknessEdge, zMid, tracers, &
- relativeSlopeTopOfEdge, relativeSlopeTapering, relativeSlopeTaperingCell, tend, err)!{{{
-
-
+ subroutine ocn_tracer_hmix_del2_tend(meshPool, layerThicknessEdge, tracers, tend, err)!{{{
!-----------------------------------------------------------------
!
! input variables
@@ -89,15 +82,9 @@ subroutine ocn_tracer_hmix_del2_tend(meshPool, scratchPool, layerThickness, laye
!-----------------------------------------------------------------
type (mpas_pool_type), intent(in) :: meshPool !< Input: Mesh information
- type (mpas_pool_type), intent(in) :: scratchPool !< Input: Scratch information
real (kind=RKIND), dimension(:,:), intent(in) :: &
- layerThickness, &!< Input: thickness at cell centers
- layerThicknessEdge, &!< Input: thickness at edge
- zMid, &!< Input: Z coordinate at the center of a cell
- relativeSlopeTopOfEdge, &!< Input: slope of coordinate relative to neutral surface at edges
- relativeSlopeTapering, &!< Input: tapering of slope of coordinate relative to neutral surface at edges
- relativeSlopeTaperingCell !< Input: tapering of slope of coordinate relative to neutral surface at cells
+ layerThicknessEdge !< Input: thickness at edges
real (kind=RKIND), dimension(:,:,:), intent(in) :: &
tracers !< Input: tracer quantities
@@ -127,36 +114,25 @@ subroutine ocn_tracer_hmix_del2_tend(meshPool, scratchPool, layerThickness, laye
integer :: iCell, iEdge, cell1, cell2
integer :: i, k, iTracer, num_tracers
- integer, pointer :: nCells, nVertLevels, nEdges
+ integer, pointer :: nCells, nVertLevels
- integer, dimension(:,:), allocatable :: boundaryMask
-
- integer, dimension(:), pointer :: maxLevelEdgeTop, nEdgesOnCell, maxLevelCell
+ integer, dimension(:), pointer :: maxLevelEdgeTop, nEdgesOnCell
integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell, edgeSignOnCell
- real (kind=RKIND) :: invAreaCell1, invAreaCell2, invAreaCell, areaEdge
- real (kind=RKIND) :: tracer_turb_flux, flux, s_tmp, r_tmp, h1, h2, s_tmpU, s_tmpD
+ real (kind=RKIND) :: invAreaCell
+ real (kind=RKIND) :: tracer_turb_flux, flux, r_tmp
real (kind=RKIND), dimension(:), pointer :: areaCell, dvEdge, dcEdge
real (kind=RKIND), dimension(:), pointer :: meshScalingDel2
- real (kind=RKIND), dimension(:,:), pointer :: gradTracerEdge, gradTracerTopOfEdge, gradHTracerSlopedTopOfCell, &
- dTracerdZTopOfCell, dTracerdZTopOfEdge, areaCellSum
-
- type (field2DReal), pointer :: gradTracerEdgeField, gradTracerTopOfEdgeField, gradHTracerSlopedTopOfCellField, dTracerdZTopOfCellField, dTracerdZTopOfEdgeField, &
- areaCellSumField
-
err = 0
if (.not.del2On) return
call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
- call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
- call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
num_tracers = size(tracers, dim=1)
call mpas_pool_get_array(meshPool, 'maxLevelEdgeTop', maxLevelEdgeTop)
- call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
call mpas_pool_get_array(meshPool, 'areaCell', areaCell)
call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge)
@@ -170,15 +146,16 @@ subroutine ocn_tracer_hmix_del2_tend(meshPool, scratchPool, layerThickness, laye
!
! compute a boundary mask to enforce insulating boundary conditions in the horizontal
!
+ !$omp do schedule(runtime) private(invAreaCell, i, iEdge, cell1, cell2, r_tmp, k, iTracer, tracer_turb_flux, flux)
do iCell = 1, nCells
- invAreaCell = 1.0 / areaCell(iCell)
+ invAreaCell = 1.0_RKIND / areaCell(iCell)
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
r_tmp = meshScalingDel2(iEdge) * eddyDiff2 * dvEdge(iEdge) / dcEdge(iEdge)
-
+
do k = 1, maxLevelEdgeTop(iEdge)
do iTracer = 1, num_tracers
! \kappa_2 \nabla \phi on edge
@@ -193,192 +170,7 @@ subroutine ocn_tracer_hmix_del2_tend(meshPool, scratchPool, layerThickness, laye
end do
end do
-
- !
- ! COMPUTE the extra terms arising due to mismatch between the constant coordinate surfaces and the
- ! isopycnal surfaces.
- !
- ! mrp note: Redi diffusion should be put in a separate subroutine
- if (config_use_standardGM) then
-
- call mpas_pool_get_field(scratchPool, 'gradTracerEdge', gradTracerEdgeField)
- call mpas_pool_get_field(scratchPool, 'gradTracerTopOfEdge', gradTracerTopOfEdgeField)
- call mpas_pool_get_field(scratchPool, 'gradHTracerSlopedTopOfCell', gradHTracerSlopedTopOfCellField)
- call mpas_pool_get_field(scratchPool, 'dTracerdZTopOfCell', dTracerdZTopOfCellField)
- call mpas_pool_get_field(scratchPool, 'dTracerdZTopOfEdge', dTracerdZTopOfEdgeField)
- call mpas_pool_get_field(scratchPool, 'areaCellSum', areaCellSumField)
-
- call mpas_allocate_scratch_field(gradTracerEdgeField, .true.)
- call mpas_allocate_scratch_field(gradTracerTopOfEdgeField, .true.)
- call mpas_allocate_scratch_field(gradHTracerSlopedTopOfCellField, .true.)
- call mpas_allocate_scratch_field(dTracerdZTopOfCellField, .true.)
- call mpas_allocate_scratch_field(dTracerdZTopOfEdgeField, .true.)
- call mpas_allocate_scratch_field(areaCellSumField, .True.)
-
- gradTracerEdge => gradTracerEdgeField % array
- gradTracerTopOfEdge => gradTracerTopOfEdgeField % array
- gradHTracerSlopedTopOfCell => gradHTracerSlopedTopOfCellField % array
- dTracerdZTopOfCell => dTracerdZTopOfCellField % array
- dTracerdZTopOfEdge => dTracerdZTopOfEdgeField % array
- areaCellSum => areaCellSumField % array
-
- gradTracerEdge = 0.0
- gradTracerTopOfEdge = 0.0
- gradHTracerSlopedTopOfCell = 0.0
- dTracerdZTopOfCell = 0.0
- dTracerdZTopOfEdge = 0.0
-
- ! this is the "standard" del2 term, but forced to use config_redi_kappa
- if(.not.config_disable_redi_horizontal_term1) then
- do iCell = 1, nCells
- invAreaCell = 1.0 / areaCell(iCell)
- do i = 1, nEdgesOnCell(iCell)
- iEdge = edgesOnCell(i, iCell)
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
-
- r_tmp = config_redi_kappa * dvEdge(iEdge) / dcEdge(iEdge)
-
- do k = 1, maxLevelEdgeTop(iEdge)
-
- ! this is the tapering of config_redi_kappa where abs(slope) > config_max_relative_slope
- s_tmp = relativeSlopeTapering(k,iEdge)
-
- do iTracer = 1, num_tracers
- ! \kappa_2 \nabla \phi on edge
- tracer_turb_flux = tracers(iTracer, k, cell2) - tracers(iTracer, k, cell1)
-
- ! div(h \kappa_2 \nabla \phi) at cell center
- flux = layerThicknessEdge(k, iEdge) * tracer_turb_flux * r_tmp * s_tmp
-
- tend(iTracer, k, iCell) = tend(iTracer, k, iCell) - edgeSignOnCell(i, iCell) * flux * invAreaCell
- end do
- end do
-
- end do
- end do
- endif
-
- ! Compute vertical derivative of tracers at cell center and top of layer
- do iTracer = 1, num_tracers
-
- do iCell = 1, nCells
- do k = 2, maxLevelCell(iCell)
- dTracerdZTopOfCell(k,iCell) = (tracers(iTracer,k-1,iCell) - tracers(iTracer,k,iCell)) / (zMid(k-1,iCell) - zMid(k,iCell))
- end do
-
- ! Approximation of dTracerdZTopOfCell on the top and bottom interfaces through the idea of having
- ! ghost cells above the top and below the bottom layers of the same depths and tracer density.
- ! Essentially, this enforces the boundary condition (d tracer)/dz = 0 at the top and bottom.
- dTracerdZTopOfCell(1,iCell) = 0.0
- dTracerdZTopOfCell(maxLevelCell(iCell)+1,iCell) = 0.0
- end do
-
- ! Compute tracer gradient (gradTracerEdge) along the constant coordinate surface.
- ! The computed variables lives at edge and mid-layer depth
- do iEdge = 1, nEdges
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
-
- do k=1,maxLevelEdgeTop(iEdge)
- gradTracerEdge(k,iEdge) = (tracers(iTracer,k,cell2) - tracers(iTracer,k,cell1)) / dcEdge(iEdge)
- end do
- end do
-
- ! Interpolate dTracerdZTopOfCell to edge and top of layer
- do iEdge = 1, nEdges
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
- do k = 1, maxLevelEdgeTop(iEdge)
- dTracerdZTopOfEdge(k,iEdge) = 0.5 * (dTracerdZTopOfCell(k,cell1) + dTracerdZTopOfCell(k,cell2))
- end do
- dTracerdZTopOfEdge(maxLevelEdgeTop(iEdge)+1,iEdge) = 0.0
- end do
-
- ! Interpolate gradTracerEdge to edge and top of layer
- do iEdge = 1, nEdges
- do k = 2, maxLevelEdgeTop(iEdge)
- h1 = layerThicknessEdge(k-1,iEdge)
- h2 = layerThicknessEdge(k,iEdge)
-
- ! Using second-order interpolation below
- gradTracerTopOfEdge(k,iEdge) = (h2 * gradTracerEdge(k-1,iEdge) + h1 * gradTracerEdge(k,iEdge)) / (h1 + h2)
- end do
-
- ! Approximation of values on the top and bottom interfaces through the idea of having ghost cells above
- ! the top and below the bottom layers of the same depths and tracer concentration.
- gradTracerTopOfEdge(1,iEdge) = gradTracerEdge(1,iEdge)
- gradTracerTopOfEdge(maxLevelEdgeTop(iEdge)+1,iEdge) = gradTracerEdge(max(maxLevelEdgeTop(iEdge),1),iEdge)
- end do
-
- ! Compute \nabla\cdot(relativeSlope d\phi/dz)
- if(.not.config_disable_redi_horizontal_term2) then
- do iEdge = 1, nEdges
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
- invAreaCell1 = 1./areaCell(cell1)
- invAreaCell2 = 1./areaCell(cell2)
-
- do k = 1, maxLevelEdgeTop(iEdge)
- s_tmpU = relativeSlopeTapering(k , iEdge) * relativeSlopeTopOfEdge(k,iEdge)*dTracerdZTopOfEdge(k,iEdge)
- s_tmpD = relativeSlopeTapering(k+1, iEdge) * relativeSlopeTopOfEdge(k+1,iEdge)*dTracerdZTopOfEdge(k+1,iEdge)
- flux = 0.5*dvEdge(iEdge)*(s_tmpU + s_tmpD)
- flux = flux * layerThicknessEdge(k, iEdge)
- tend(iTracer,k,cell1) = tend(iTracer,k,cell1) + config_Redi_kappa * flux * invAreaCell1
- tend(iTracer,k,cell2) = tend(iTracer,k,cell2) - config_Redi_kappa * flux * invAreaCell2
- end do
-
- end do
- endif
-
- ! Compute dz * d(relativeSlope\cdot\nabla\phi)/dz (so the dz cancel out)
- gradHTracerSlopedTopOfCell = 0.0
-
- ! Compute relativeSlope\cdot\nabla\phi (variable gradHTracerSlopedTopOfCell) at non-boundary edges
- areaCellSum = 1.0e-34
- do iEdge = 1, nEdges
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
- ! contribution of cell area from this edge:
- areaEdge = 0.25 * dcEdge(iEdge) * dvEdge(iEdge)
-
- do k = 1, maxLevelEdgeTop(iEdge)
- r_tmp = 2.0 * areaEdge * relativeSlopeTopOfEdge(k,iEdge) * gradTracerTopOfEdge(k,iEdge)
- gradHTracerSlopedTopOfCell(k,cell1) = gradHTracerSlopedTopOfCell(k,cell1) + r_tmp
- gradHTracerSlopedTopOfCell(k,cell2) = gradHTracerSlopedTopOfCell(k,cell2) + r_tmp
-
- areaCellSum(k,cell1) = areaCellSum(k,cell1) + areaEdge
- areaCellSum(k,cell2) = areaCellSum(k,cell2) + areaEdge
-
- end do
- end do
- do iCell=1,nCells
- do k = 1, maxLevelCell(iCell)
- gradHTracerSlopedTopOfCell(k,iCell) = gradHTracerSlopedTopOfCell(k,iCell)/areaCellSum(k,iCell)
- end do
- end do
-
- if(.not.config_disable_redi_horizontal_term3) then
- do iCell = 1, nCells
- ! impose no-flux boundary conditions at top and bottom of column
- gradHTracerSlopedTopOfCell(1,iCell) = 0.0
- gradHTracerSlopedTopOfCell(maxLevelCell(iCell)+1,iCell) = 0.0
- do k = 1, maxLevelCell(iCell)
- s_tmp = relativeSlopeTaperingCell(k,iCell)
- tend(iTracer,k,iCell) = tend(iTracer,k,iCell) + s_tmp * config_Redi_kappa * (gradHTracerSlopedTopOfCell(k,iCell) - gradHTracerSlopedTopOfCell(k+1,iCell))
- end do
- end do
- endif
-
- end do ! iTracer
-
- call mpas_deallocate_scratch_field(gradTracerEdgeField, .true.)
- call mpas_deallocate_scratch_field(gradTracerTopOfEdgeField, .true.)
- call mpas_deallocate_scratch_field(gradHTracerSlopedTopOfCellField, .true.)
- call mpas_deallocate_scratch_field(dTracerdZTopOfCellField, .true.)
- call mpas_deallocate_scratch_field(dTracerdZTopOfEdgeField, .true.)
-
- end if ! config_use_standardGM
+ !$omp end do
!--------------------------------------------------------------------
@@ -391,9 +183,9 @@ end subroutine ocn_tracer_hmix_del2_tend!}}}
!> \brief Initializes ocean tracer horizontal mixing quantities
!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
!> \date September 2011
-!> \details
-!> This routine initializes a variety of quantities related to
-!> Laplacian horizontal velocity mixing in the ocean.
+!> \details
+!> This routine initializes a variety of quantities related to
+!> Laplacian horizontal velocity mixing in the ocean.
!
!-----------------------------------------------------------------------
@@ -416,28 +208,16 @@ subroutine ocn_tracer_hmix_del2_init(err)!{{{
call mpas_pool_get_config(ocnConfigs, 'config_use_tracer_del2', config_use_tracer_del2)
call mpas_pool_get_config(ocnConfigs, 'config_tracer_del2', config_tracer_del2)
- call mpas_pool_get_config(ocnConfigs, 'config_use_standardGM',config_use_standardGM)
- call mpas_pool_get_config(ocnConfigs, 'config_Redi_kappa',config_Redi_kappa)
- call mpas_pool_get_config(ocnConfigs, 'config_disable_redi_horizontal_term1',config_disable_redi_horizontal_term1)
- call mpas_pool_get_config(ocnConfigs, 'config_disable_redi_horizontal_term2',config_disable_redi_horizontal_term2)
- call mpas_pool_get_config(ocnConfigs, 'config_disable_redi_horizontal_term3',config_disable_redi_horizontal_term3)
del2on = .false.
if ( config_use_tracer_del2 ) then
- if ( config_tracer_del2 > 0.0 ) then
- del2On = .true.
- eddyDiff2 = config_tracer_del2
- endif
+ if ( config_tracer_del2 > 0.0_RKIND ) then
+ del2On = .true.
+ eddyDiff2 = config_tracer_del2
+ endif
endif
- if ( config_use_standardGM ) then
- if ( config_Redi_kappa > 0.0 ) then
- del2On = .true.
- endif
- endif
-
-
!--------------------------------------------------------------------
end subroutine ocn_tracer_hmix_del2_init!}}}
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_hmix_del4.F b/src/core_ocean/shared/mpas_ocn_tracer_hmix_del4.F
index 7db07db729..cf8e0aae44 100644
--- a/src/core_ocean/shared/mpas_ocn_tracer_hmix_del4.F
+++ b/src/core_ocean/shared/mpas_ocn_tracer_hmix_del4.F
@@ -13,8 +13,8 @@
!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
!> \date September 2011
!> \details
-!> This module contains the main driver routine for computing
-!> horizontal mixing tendencies.
+!> This module contains the main driver routine for computing
+!> horizontal mixing tendencies.
!>
!> It provides an init and a tend function. Each are described below.
!
@@ -24,6 +24,7 @@ module ocn_tracer_hmix_del4
use mpas_derived_types
use mpas_pool_routines
+ use mpas_threading
use ocn_constants
implicit none
@@ -67,13 +68,13 @@ module ocn_tracer_hmix_del4
!> \brief Computes biharmonic tendency term for horizontal tracer mixing
!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the horizontal mixing tendency for tracers
!> based on current state using a biharmonic parameterization.
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_hmix_del4_tend(meshPool, layerThicknessEdge, tracers, tend, err)!{{{
+ subroutine ocn_tracer_hmix_del4_tend(meshPool, scratchPool, layerThicknessEdge, tracers, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -87,6 +88,8 @@ subroutine ocn_tracer_hmix_del4_tend(meshPool, layerThicknessEdge, tracers, tend
type (mpas_pool_type), intent(in) :: &
meshPool !< Input: mesh information
+ type (mpas_pool_type), intent(in) :: scratchPool !< Input: scratch variables
+
real (kind=RKIND), dimension(:,:,:), intent(in) :: &
tracers !< Input: tracer quantities
@@ -122,7 +125,9 @@ subroutine ocn_tracer_hmix_del4_tend(meshPool, layerThicknessEdge, tracers, tend
real (kind=RKIND) :: invAreaCell1, invAreaCell2, tracer_turb_flux, flux, invdcEdge, r_tmp1, r_tmp2
- real (kind=RKIND), dimension(:,:,:), allocatable :: delsq_tracer
+ !real (kind=RKIND), dimension(:,:,:), allocatable :: delsq_tracer
+ real (kind=RKIND), dimension(:,:,:), pointer :: delsq_tracer
+ type (field3DReal), pointer :: delsq_tracerField
real (kind=RKIND), dimension(:), pointer :: dcEdge, dvEdge, areaCell, meshScalingDel4
@@ -130,7 +135,7 @@ subroutine ocn_tracer_hmix_del4_tend(meshPool, layerThicknessEdge, tracers, tend
!-----------------------------------------------------------------
!
! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
+ ! note that the user can choose multiple options and the
! tendencies will be added together
!
!-----------------------------------------------------------------
@@ -159,13 +164,20 @@ subroutine ocn_tracer_hmix_del4_tend(meshPool, layerThicknessEdge, tracers, tend
call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell)
call mpas_pool_get_array(meshPool, 'edgeSignOnCell', edgeSignOnCell)
- allocate(delsq_tracer(num_tracers,nVertLevels, nCells+1))
+ !allocate(delsq_tracer(num_tracers,nVertLevels, nCells+1))
+ call mpas_pool_get_field(scratchPool, 'delsq_tracer', delsq_tracerField)
+
+ call mpas_allocate_scratch_field(delsq_tracerField, .true.)
+
+ call mpas_threading_barrier()
- delsq_tracer(:,:,:) = 0.0
+ delsq_tracer => delsq_tracerField % array
! first del2: div(h \nabla \phi) at cell center
+ !$omp do schedule(runtime) private(invAreaCell1, i, iEdge, invdcEdge, cell1, cell2, k, iTracer, r_tmp1, r_tmp2)
do iCell = 1, nCells
- invAreaCell1 = 1.0 / areaCell(iCell)
+ delsq_tracer(:, :, iCell) = 0.0_RKIND
+ invAreaCell1 = 1.0_RKIND / areaCell(iCell)
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
invdcEdge = dvEdge(iEdge) / dcEdge(iEdge)
@@ -178,15 +190,18 @@ subroutine ocn_tracer_hmix_del4_tend(meshPool, layerThicknessEdge, tracers, tend
r_tmp1 = invdcEdge * layerThicknessEdge(k, iEdge) * tracers(iTracer, k, cell1)
r_tmp2 = invdcEdge * layerThicknessEdge(k, iEdge) * tracers(iTracer, k, cell2)
- delsq_tracer(iTracer, k, iCell) = delsq_tracer(iTracer, k, iCell) - edgeSignOnCell(i, iCell) * (r_tmp2 - r_tmp1) * invAreaCell1
+ delsq_tracer(iTracer, k, iCell) = delsq_tracer(iTracer, k, iCell) - edgeSignOnCell(i, iCell) &
+ * (r_tmp2 - r_tmp1) * invAreaCell1
end do
end do
end do
end do
+ !$omp end do
! second del2: div(h \nabla [delsq_tracer]) at cell center
+ !$omp do schedule(runtime) private(invAreaCell1, i, iEdge, cell1, cell2, invdcEdge, k, iTracer, tracer_turb_flux, flux)
do iCell = 1, nCells
- invAreaCell1 = 1.0 / areaCell(iCell)
+ invAreaCell1 = 1.0_RKIND / areaCell(iCell)
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
cell1 = cellsOnEdge(1, iEdge)
@@ -197,7 +212,7 @@ subroutine ocn_tracer_hmix_del4_tend(meshPool, layerThicknessEdge, tracers, tend
do k = 1, maxLevelEdgeTop(iEdge)
do iTracer = 1, num_tracers * edgeMask(k, iEdge)
tracer_turb_flux = (delsq_tracer(iTracer, k, cell2) - delsq_tracer(iTracer, k, cell1))
-
+
flux = tracer_turb_flux * invdcEdge
tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + edgeSignOnCell(i, iCell) * flux * invAreaCell1
@@ -205,8 +220,11 @@ subroutine ocn_tracer_hmix_del4_tend(meshPool, layerThicknessEdge, tracers, tend
end do
end do
end do
+ !$omp end do
+
+ call mpas_threading_barrier()
+ call mpas_deallocate_scratch_field(delsq_tracerField, .true.)
- deallocate(delsq_tracer)
!--------------------------------------------------------------------
end subroutine ocn_tracer_hmix_del4_tend!}}}
@@ -218,9 +236,9 @@ end subroutine ocn_tracer_hmix_del4_tend!}}}
!> \brief Initializes ocean tracer horizontal mixing quantities
!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
!> \date September 2011
-!> \details
-!> This routine initializes a variety of quantities related to
-!> biharmonic horizontal velocity mixing in the ocean.
+!> \details
+!> This routine initializes a variety of quantities related to
+!> biharmonic horizontal velocity mixing in the ocean.
!
!-----------------------------------------------------------------------
@@ -246,7 +264,7 @@ subroutine ocn_tracer_hmix_del4_init(err)!{{{
del4on = .false.
- if ( config_tracer_del4 > 0.0 ) then
+ if ( config_tracer_del4 > 0.0_RKIND ) then
del4On = .true.
eddyDiff4 = config_tracer_del4
endif
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_hmix_redi.F b/src/core_ocean/shared/mpas_ocn_tracer_hmix_redi.F
new file mode 100644
index 0000000000..5f3687f653
--- /dev/null
+++ b/src/core_ocean/shared/mpas_ocn_tracer_hmix_redi.F
@@ -0,0 +1,437 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_hmix_redi
+!
+!> \brief MPAS ocean horizontal tracer mixing driver
+!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
+!> \date September 2011
+!> \details
+!> This module contains the main driver routine for computing
+!> horizontal mixing tendencies.
+!>
+!> It provides an init and a tend function. Each are described below.
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_hmix_redi
+
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_threading
+
+ use ocn_constants
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_tracer_hmix_redi_tend, &
+ ocn_tracer_hmix_redi_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: rediOn
+ logical, pointer :: config_disable_redi_horizontal_term1
+ logical, pointer :: config_disable_redi_horizontal_term2
+ logical, pointer :: config_disable_redi_horizontal_term3
+ real (kind=RKIND), pointer :: config_Redi_kappa
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_hmix_redi_tend
+!
+!> \brief Computes Laplacian tendency term for horizontal tracer mixing
+!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
+!> \date September 2011
+!> \details
+!> This routine computes the horizontal mixing tendency for tracers
+!> based on current state using a Laplacian parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_hmix_redi_tend(meshPool, scratchPool, layerThicknessEdge, zMid, tracers, &
+ relativeSlopeTopOfEdge, relativeSlopeTapering, relativeSlopeTaperingCell, tend, err)!{{{
+
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mpas_pool_type), intent(in) :: meshPool !< Input: Mesh information
+ type (mpas_pool_type), intent(in) :: scratchPool !< Input: Scratch information
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ layerThicknessEdge, &!< Input: thickness at edge
+ zMid, &!< Input: Z coordinate at the center of a cell
+ relativeSlopeTopOfEdge, &!< Input: slope of coordinate relative to neutral surface at edges
+ relativeSlopeTapering, &!< Input: tapering of slope of coordinate relative to neutral surface at edges
+ relativeSlopeTaperingCell !< Input: tapering of slope of coordinate relative to neutral surface at cells
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracer quantities
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iCell, iEdge, cell1, cell2
+ integer :: i, k, iTracer, num_tracers
+ integer, pointer :: nCells, nVertLevels, nEdges
+
+ integer, dimension(:,:), allocatable :: boundaryMask
+
+ integer, dimension(:), pointer :: maxLevelEdgeTop, nEdgesOnCell, maxLevelCell
+ integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell, edgeSignOnCell
+
+ real (kind=RKIND) :: invAreaCell1, invAreaCell2, invAreaCell, areaEdge
+ real (kind=RKIND) :: tracer_turb_flux, flux, s_tmp, r_tmp, h1, h2, s_tmpU, s_tmpD
+
+ real (kind=RKIND), dimension(:), pointer :: areaCell, dvEdge, dcEdge
+
+ real (kind=RKIND), dimension(:,:), pointer :: gradTracerEdge, gradTracerTopOfEdge, gradHTracerSlopedTopOfCell, &
+ dTracerdZTopOfCell, dTracerdZTopOfEdge, areaCellSum
+
+ type (field2DReal), pointer :: gradTracerEdgeField, gradTracerTopOfEdgeField, gradHTracerSlopedTopOfCellField, &
+ dTracerdZTopOfCellField, dTracerdZTopOfEdgeField, areaCellSumField
+
+ err = 0
+
+ if (.not.rediOn) return
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+ num_tracers = size(tracers, dim=1)
+
+ call mpas_pool_get_array(meshPool, 'maxLevelEdgeTop', maxLevelEdgeTop)
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
+ call mpas_pool_get_array(meshPool, 'areaCell', areaCell)
+ call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge)
+ call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
+
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell)
+ call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell)
+ call mpas_pool_get_array(meshPool, 'edgeSignOnCell', edgeSignOnCell)
+
+ call mpas_pool_get_config(ocnConfigs, 'config_Redi_kappa',config_Redi_kappa)
+ call mpas_pool_get_config(ocnConfigs, 'config_disable_redi_horizontal_term1',config_disable_redi_horizontal_term1)
+ call mpas_pool_get_config(ocnConfigs, 'config_disable_redi_horizontal_term2',config_disable_redi_horizontal_term2)
+ call mpas_pool_get_config(ocnConfigs, 'config_disable_redi_horizontal_term3',config_disable_redi_horizontal_term3)
+
+ !
+ ! COMPUTE the extra terms arising due to mismatch between the constant coordinate surfaces and the
+ ! isopycnal surfaces.
+ !
+ ! mrp note: Redi diffusion should be put in a separate subroutine
+
+ call mpas_pool_get_field(scratchPool, 'gradTracerEdge', gradTracerEdgeField)
+ call mpas_pool_get_field(scratchPool, 'gradTracerTopOfEdge', gradTracerTopOfEdgeField)
+ call mpas_pool_get_field(scratchPool, 'gradHTracerSlopedTopOfCell', gradHTracerSlopedTopOfCellField)
+ call mpas_pool_get_field(scratchPool, 'dTracerdZTopOfCell', dTracerdZTopOfCellField)
+ call mpas_pool_get_field(scratchPool, 'dTracerdZTopOfEdge', dTracerdZTopOfEdgeField)
+ call mpas_pool_get_field(scratchPool, 'areaCellSum', areaCellSumField)
+
+ call mpas_allocate_scratch_field(gradTracerEdgeField, .true.)
+ call mpas_allocate_scratch_field(gradTracerTopOfEdgeField, .true.)
+ call mpas_allocate_scratch_field(gradHTracerSlopedTopOfCellField, .true.)
+ call mpas_allocate_scratch_field(dTracerdZTopOfCellField, .true.)
+ call mpas_allocate_scratch_field(dTracerdZTopOfEdgeField, .true.)
+ call mpas_allocate_scratch_field(areaCellSumField, .True.)
+ call mpas_threading_barrier()
+
+ gradTracerEdge => gradTracerEdgeField % array
+ gradTracerTopOfEdge => gradTracerTopOfEdgeField % array
+ gradHTracerSlopedTopOfCell => gradHTracerSlopedTopOfCellField % array
+ dTracerdZTopOfCell => dTracerdZTopOfCellField % array
+ dTracerdZTopOfEdge => dTracerdZTopOfEdgeField % array
+ areaCellSum => areaCellSumField % array
+
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ gradHTracerSlopedTopOfCell(:, iCell) = 0.0_RKIND
+ dTracerdZTopOfCell(:, iCell) = 0.0_RKIND
+ end do
+ !$omp end do
+
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ gradTracerEdge(:, iEdge) = 0.0_RKIND
+ gradTracerTopOfEdge(:, iEdge) = 0.0_RKIND
+ dTracerdZTopOfEdge(:, iEdge) = 0.0_RKIND
+ end do
+ !$omp end do
+
+ ! this is the "standard" del2 term, but forced to use config_redi_kappa
+ if(.not.config_disable_redi_horizontal_term1) then
+
+ !$omp do schedule(runtime) private(invAreaCell, i, iEdge, cell1, cell2, r_tmp, k, s_tmp, iTracer, tracer_turb_flux, flux)
+ do iCell = 1, nCells
+ invAreaCell = 1.0_RKIND / areaCell(iCell)
+ do i = 1, nEdgesOnCell(iCell)
+ iEdge = edgesOnCell(i, iCell)
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+
+ r_tmp = config_redi_kappa * dvEdge(iEdge) / dcEdge(iEdge)
+
+ do k = 1, maxLevelEdgeTop(iEdge)
+
+ ! this is the tapering of config_redi_kappa where abs(slope) > config_max_relative_slope
+ s_tmp = relativeSlopeTapering(k,iEdge)
+
+ do iTracer = 1, num_tracers
+ ! \kappa_2 \nabla \phi on edge
+ tracer_turb_flux = tracers(iTracer, k, cell2) - tracers(iTracer, k, cell1)
+
+ ! div(h \kappa_2 \nabla \phi) at cell center
+ flux = layerThicknessEdge(k, iEdge) * tracer_turb_flux * r_tmp * s_tmp
+
+ tend(iTracer, k, iCell) = tend(iTracer, k, iCell) - edgeSignOnCell(i, iCell) * flux * invAreaCell
+ end do
+ end do
+
+ end do
+ end do
+ !$omp end do
+
+ endif
+
+ ! Compute vertical derivative of tracers at cell center and top of layer
+ do iTracer = 1, num_tracers
+ ! Sync threads before starting on tracers
+ call mpas_threading_barrier()
+
+ !$omp do schedule(runtime) private(k)
+ do iCell = 1, nCells
+ do k = 2, maxLevelCell(iCell)
+ dTracerdZTopOfCell(k,iCell) = (tracers(iTracer,k-1,iCell) - tracers(iTracer,k,iCell)) &
+ / (zMid(k-1,iCell) - zMid(k,iCell))
+ end do
+
+ ! Approximation of dTracerdZTopOfCell on the top and bottom interfaces through the idea of having
+ ! ghost cells above the top and below the bottom layers of the same depths and tracer density.
+ ! Essentially, this enforces the boundary condition (d tracer)/dz = 0 at the top and bottom.
+ dTracerdZTopOfCell(1,iCell) = 0.0_RKIND
+ dTracerdZTopOfCell(maxLevelCell(iCell)+1,iCell) = 0.0_RKIND
+ end do
+ !$omp end do
+
+ ! Compute tracer gradient (gradTracerEdge) along the constant coordinate surface.
+ ! The computed variables lives at edge and mid-layer depth
+ !$omp do schedule(runtime) private(cell1, cell2, k)
+ do iEdge = 1, nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+
+ do k=1,maxLevelEdgeTop(iEdge)
+ gradTracerEdge(k,iEdge) = (tracers(iTracer,k,cell2) - tracers(iTracer,k,cell1)) / dcEdge(iEdge)
+ end do
+ end do
+ !$omp end do
+
+ ! Interpolate dTracerdZTopOfCell to edge and top of layer
+ !$omp do schedule(runtime) private(cell1, cell2, k)
+ do iEdge = 1, nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ do k = 1, maxLevelEdgeTop(iEdge)
+ dTracerdZTopOfEdge(k,iEdge) = 0.5_RKIND * (dTracerdZTopOfCell(k,cell1) + dTracerdZTopOfCell(k,cell2))
+ end do
+ dTracerdZTopOfEdge(maxLevelEdgeTop(iEdge)+1,iEdge) = 0.0_RKIND
+ end do
+ !$omp end do
+
+ ! Interpolate gradTracerEdge to edge and top of layer
+ !$omp do schedule(runtime) private(k, h1, h2)
+ do iEdge = 1, nEdges
+ do k = 2, maxLevelEdgeTop(iEdge)
+ h1 = layerThicknessEdge(k-1,iEdge)
+ h2 = layerThicknessEdge(k,iEdge)
+
+ ! Using second-order interpolation below
+ gradTracerTopOfEdge(k,iEdge) = (h2 * gradTracerEdge(k-1,iEdge) + h1 * gradTracerEdge(k,iEdge)) / (h1 + h2)
+ end do
+
+ ! Approximation of values on the top and bottom interfaces through the idea of having ghost cells above
+ ! the top and below the bottom layers of the same depths and tracer concentration.
+ gradTracerTopOfEdge(1,iEdge) = gradTracerEdge(1,iEdge)
+ gradTracerTopOfEdge(maxLevelEdgeTop(iEdge)+1,iEdge) = gradTracerEdge(max(maxLevelEdgeTop(iEdge),1),iEdge)
+ end do
+ !$omp end do
+
+ ! Compute \nabla\cdot(relativeSlope d\phi/dz)
+ if(.not.config_disable_redi_horizontal_term2) then
+ !$omp do schedule(runtime) private(invAreaCell, i, iEdge, k, s_tmpU, s_tmpD, flux)
+ do iCell = 1, nCells
+ invAreaCell = 1.0_RKIND / areaCell(iCell)
+ do i = 1, nEdgesOnCell(iCell)
+ iEdge = edgesOnCell(i, iCell)
+ do k = 1, maxLevelEdgeTop(iEdge)
+ s_tmpU = relativeSlopeTapering(k, iEdge) * relativeSlopeTopOfEdge(k, iEdge) * dTracerdZTopOfEdge(k, iEdge)
+ s_tmpD = relativeSlopeTapering(k+1, iEdge) * relativeSlopeTopOfEdge(k+1, iEdge) &
+ * dTracerdZTopOfEdge(k+1, iEdge)
+
+ flux = 0.5 * dvEdge(iEdge) * ( s_tmpU + s_tmpD )
+ flux = flux * layerThicknessEdge(k, iEdge)
+ tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + edgeSignOnCell(i, iCell) * config_Redi_kappa * flux &
+ * invAreaCell
+ end do
+ end do
+ end do
+ !$omp end do
+ endif
+
+ ! Compute dz * d(relativeSlope\cdot\nabla\phi)/dz (so the dz cancel out)
+
+ ! Compute relativeSlope\cdot\nabla\phi (variable gradHTracerSlopedTopOfCell) at non-boundary edges
+ areaCellSum = 1.0e-34_RKIND
+
+ !$omp do schedule(runtime) private(i, iedge, areaEdge, k, r_tmp)
+ do iCell = 1, nCells
+ gradHTracerSlopedTopOfCell(:, iCell) = 0.0_RKIND
+ do i = 1, nEdgesOnCell(iCell)
+ iEdge = edgesOnCell(i, iCell)
+ areaEdge = 0.5_RKIND * dcEdge(iEdge) * dvEdge(iEdge)
+ do k = 1, maxLevelEdgeTop(iEdge)
+ r_tmp = areaEdge * relativeSlopeTopOfEdge(k,iEdge) * gradTracerTopOfEdge(k,iEdge)
+ gradHTracerSlopedTopOfCell(k, iCell) = gradHTracerSlopedTopOfCell(k, iCell) + r_tmp
+ areaCellSum(k, iCell) = areaCellSum(k, iCell) + areaEdge
+ end do
+ end do
+ end do
+ !$omp end do
+
+ !$omp do schedule(runtime) private(k)
+ do iCell=1,nCells
+ do k = 1, maxLevelCell(iCell)
+ gradHTracerSlopedTopOfCell(k,iCell) = gradHTracerSlopedTopOfCell(k,iCell)/areaCellSum(k,iCell)
+ end do
+ end do
+ !$omp end do
+
+ if(.not.config_disable_redi_horizontal_term3) then
+ !$omp do schedule(runtime) private(k, s_tmp)
+ do iCell = 1, nCells
+ ! impose no-flux boundary conditions at top and bottom of column
+ gradHTracerSlopedTopOfCell(1,iCell) = 0.0_RKIND
+ gradHTracerSlopedTopOfCell(maxLevelCell(iCell)+1,iCell) = 0.0_RKIND
+ do k = 1, maxLevelCell(iCell)
+ s_tmp = relativeSlopeTaperingCell(k,iCell)
+ tend(iTracer,k,iCell) = tend(iTracer,k,iCell) + s_tmp * config_Redi_kappa * &
+ (gradHTracerSlopedTopOfCell(k,iCell) - gradHTracerSlopedTopOfCell(k+1,iCell))
+ end do
+ end do
+ !$omp end do
+ endif
+
+ end do ! iTracer
+
+ call mpas_threading_barrier()
+ call mpas_deallocate_scratch_field(gradTracerEdgeField, .true.)
+ call mpas_deallocate_scratch_field(gradTracerTopOfEdgeField, .true.)
+ call mpas_deallocate_scratch_field(gradHTracerSlopedTopOfCellField, .true.)
+ call mpas_deallocate_scratch_field(dTracerdZTopOfCellField, .true.)
+ call mpas_deallocate_scratch_field(dTracerdZTopOfEdgeField, .true.)
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_hmix_redi_tend!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_hmix_redi_init
+!
+!> \brief Initializes ocean tracer horizontal mixing quantities
+!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
+!> \date September 2011
+!> \details
+!> This routine initializes a variety of quantities related to
+!> Laplacian horizontal velocity mixing in the ocean.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_hmix_redi_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ logical, pointer :: config_use_standardGM
+
+ err = 0
+
+ call mpas_pool_get_config(ocnConfigs, 'config_use_standardGM', config_use_standardGM)
+
+ rediOn = .false.
+
+ if ( config_use_standardGM ) then
+ rediOn = .true.
+ endif
+
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_hmix_redi_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_hmix_redi
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_ideal_age.F b/src/core_ocean/shared/mpas_ocn_tracer_ideal_age.F
new file mode 100644
index 0000000000..fbcd0ae231
--- /dev/null
+++ b/src/core_ocean/shared/mpas_ocn_tracer_ideal_age.F
@@ -0,0 +1,168 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_ideal_age
+!
+!> \brief MPAS ocean restoring
+!> \author Todd Ringler
+!> \date 06/08/2015
+!> \details
+!> This module contains routines for computing the tracer tendency due to restoring
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_ideal_age
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+ use ocn_constants
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_tracer_ideal_age_compute, &
+ ocn_tracer_ideal_age_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_ideal_age_compute
+!
+!> \brief computes a tracer tendency to approximate ideal age
+!> \author Todd Ringler
+!> \date 06/09/2015
+!> \details
+!> This routine computes a tracer tendency to approximate ideal age
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_ideal_age_compute(nTracers, nCellsSolve, maxLevelCell, layerThickness, &
+ idealAgeMask, tracers, tracer_tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ ! one dimensional arrays
+ integer, dimension(:), intent(in) :: &
+ maxLevelCell
+
+ ! two dimensional arrays
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ layerThickness, &
+ idealAgeMask
+
+ integer, intent(in) :: nTracers, nCellsSolve
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ ! three dimensional arrays
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tracers, &
+ tracer_tend
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iCell, iLevel, iTracer
+
+ !move to ocean constants
+ real (kind=RKIND), parameter :: c0 = 0.0_RKIND
+ real (kind=RKIND), parameter :: c1 = 1.0_RKIND
+
+ err = 0
+
+ !$omp do schedule(runtime) private(iLevel, iTracer)
+ do iCell=1,nCellsSolve
+ do iLevel=1,maxLevelCell(iCell)
+ do iTracer=1,nTracers
+ ! zero tracers at surface to zero where idealAgeMask == zero
+ ! idealAgeMask should be equal to 1.0 elsewhere
+ tracers(iTracer, iLevel, iCell) = idealAgeMask(iTracer, iCell) * tracers(iTracer, iLevel, iCell)
+
+ ! add a tendency increment equivalent to "dt" to entire domain
+ tracer_tend(iTracer, iLevel, iCell) = tracer_tend(iTracer, iLevel, iCell) + &
+ layerThickness(iLevel,iCell) * c1
+ enddo
+ enddo
+ enddo
+ !$omp end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_ideal_age_compute!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_ideal_age_init
+!
+!> \brief Initializes ocean ideal age
+!> \author Todd Ringler
+!> \date 06/09/2015
+!> \details
+!> This routine initializes fields required for tracer ideal age
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_ideal_age_init(err)!{{{
+
+ integer, intent(out) :: err !< Output: error flag
+
+ err = 0
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_ideal_age_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_ideal_age
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_interior_restoring.F b/src/core_ocean/shared/mpas_ocn_tracer_interior_restoring.F
new file mode 100644
index 0000000000..6ec9612057
--- /dev/null
+++ b/src/core_ocean/shared/mpas_ocn_tracer_interior_restoring.F
@@ -0,0 +1,165 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_interior_restoring
+!
+!> \brief MPAS ocean restoring
+!> \author Todd Ringler
+!> \date 06/08/2015
+!> \details
+!> This module contains routines for computing the tracer tendency due to restoring
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_interior_restoring
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+ use ocn_constants
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_tracer_interior_restoring_compute, &
+ ocn_tracer_interior_restoring_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_interior_restoring_compute
+!
+!> \brief computes a tracer tendency due to interior restoring
+!> \author Todd Ringler
+!> \date 06/09/2015
+!> \details
+!> This routine computes a tracer tendency due to interior restoring
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_interior_restoring_compute(nTracers, nCellsSolve, maxLevelCell, layerThickness, &
+ tracers, tracersInteriorRestoringRate, tracersInteriorRestoringValue, tracer_tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ ! one dimensional arrays
+ integer, dimension(:), intent(in) :: &
+ maxLevelCell
+
+ ! two dimensional arrays
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ layerThickness
+
+ ! three dimensional arrays
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers, &
+ tracersInteriorRestoringRate, &
+ tracersInteriorRestoringValue
+
+ ! scalars
+ integer, intent(in) :: nTracers, nCellsSolve
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tracer_tend
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iCell, iLevel, iTracer
+
+ err = 0
+
+ !$omp do schedule(runtime) private(iLevel, iTracer)
+ do iCell=1,nCellsSolve
+ do iLevel=1,maxLevelCell(iCell)
+ do iTracer=1,nTracers
+ tracer_tend(iTracer, iLevel, iCell) = tracer_tend(iTracer, iLevel, iCell) - layerThickness(iLevel,iCell) &
+ * ( tracers(iTracer, iLevel, iCell) &
+ - tracersInteriorRestoringValue(iTracer, iLevel, iCell) ) &
+ * tracersInteriorRestoringRate(iTracer, iLevel, iCell)
+ enddo
+ enddo
+ enddo
+ !$omp end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_interior_restoring_compute!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_interior_restoring_init
+!
+!> \brief Initializes ocean interior restoring
+!> \author Todd Ringler
+!> \date 06/09/2015
+!> \details
+!> This routine initializes fields required for tracer interior restoring
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_interior_restoring_init(err)!{{{
+
+ integer, intent(out) :: err !< Output: error flag
+
+ err = 0
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_interior_restoring_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_interior_restoring
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_nonlocalflux.F b/src/core_ocean/shared/mpas_ocn_tracer_nonlocalflux.F
index e44d7512f6..ba18610b94 100644
--- a/src/core_ocean/shared/mpas_ocn_tracer_nonlocalflux.F
+++ b/src/core_ocean/shared/mpas_ocn_tracer_nonlocalflux.F
@@ -14,7 +14,7 @@
!> \date 11/25/13
!> \version SVN:$Id:$
!> \details
-!> This module contains the routine for computing
+!> This module contains the routine for computing
!> tracer tendencies due to non-local vertical fluxes computed in CVMix KPP
!
!-----------------------------------------------------------------------
@@ -63,7 +63,7 @@ module ocn_tracer_nonlocalflux
!> \brief Computes tendency term due to non-local flux transport
!> \author Todd Ringler
!> \date 11/25/13
-!> \details
+!> \details
!> This routine computes the tendency for tracers based the vertical divergence of non-local fluxes.
!
!-----------------------------------------------------------------------
@@ -110,7 +110,6 @@ subroutine ocn_tracer_nonlocalflux_tend(meshPool, vertNonLocalFlux, surfaceTrace
integer :: iCell, k, iTracer, nTracers
integer, pointer :: nCells, nVertLevels
integer, dimension(:), pointer :: maxLevelCell
- integer, dimension(:,:), pointer :: cellMask
real (kind=RKIND) :: fluxTopOfCell, fluxBottomOfCell
err = 0
@@ -122,8 +121,8 @@ subroutine ocn_tracer_nonlocalflux_tend(meshPool, vertNonLocalFlux, surfaceTrace
nTracers = size(tend, dim=1)
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
- call mpas_pool_get_array(meshPool, 'cellMask', cellMask)
+ !$omp do schedule(runtime) private(k, iTracer, fluxTopOfCell, fluxBottomOfCell)
do iCell = 1, nCells
do k = 2, maxLevelCell(iCell)-1
@@ -131,7 +130,7 @@ subroutine ocn_tracer_nonlocalflux_tend(meshPool, vertNonLocalFlux, surfaceTrace
do iTracer = 1, nTracers
fluxTopOfCell = surfaceTracerFlux(iTracer, iCell) * vertNonLocalFlux(1, k, iCell)
fluxBottomOfCell = surfaceTracerFlux(iTracer, iCell) * vertNonLocalFlux(1, k+1, iCell)
- tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + cellMask(k, icell) * (fluxTopOfCell-fluxBottomOfCell)
+ tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + (fluxTopOfCell-fluxBottomOfCell)
end do
end do
@@ -139,19 +138,20 @@ subroutine ocn_tracer_nonlocalflux_tend(meshPool, vertNonLocalFlux, surfaceTrace
k = maxLevelCell(iCell)
do iTracer = 1, nTracers
fluxTopOfCell = surfaceTracerFlux(iTracer, iCell) * vertNonLocalFlux(1, k, iCell)
- fluxBottomOfCell = 0.0
- tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + cellMask(k, icell) * (fluxTopOfCell-fluxBottomOfCell)
+ fluxBottomOfCell = 0.0_RKIND
+ tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + (fluxTopOfCell-fluxBottomOfCell)
end do
! enforce boundary conditions at top of column
k = 1
do iTracer = 1, nTracers
- fluxTopOfCell = 0.0
+ fluxTopOfCell = 0.0_RKIND
fluxBottomOfCell = surfaceTracerFlux(iTracer, iCell) * vertNonLocalFlux(1, k+1, iCell)
- tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + cellMask(k, icell) * (fluxTopOfCell-fluxBottomOfCell)
+ tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + (fluxTopOfCell-fluxBottomOfCell)
end do
end do
+ !$omp end do
!--------------------------------------------------------------------
@@ -165,7 +165,7 @@ end subroutine ocn_tracer_nonlocalflux_tend!}}}
!> \author Todd Ringler
!> \date 11/25/13
!> \version SVN:$Id$
-!> \details
+!> \details
!> This routine initializes quantities related to nonlocal flux computation
!
!-----------------------------------------------------------------------
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_short_wave_absorption.F b/src/core_ocean/shared/mpas_ocn_tracer_short_wave_absorption.F
index bbb7a1a5cd..aabc21b79d 100644
--- a/src/core_ocean/shared/mpas_ocn_tracer_short_wave_absorption.F
+++ b/src/core_ocean/shared/mpas_ocn_tracer_short_wave_absorption.F
@@ -6,7 +6,7 @@
!> \author Doug Jacobsen
!> \date 12/17/12
!> \details
-!> This module contains the routine for computing
+!> This module contains the routine for computing
!> short wave tendencies
!
!-----------------------------------------------------------------------
@@ -17,6 +17,7 @@ module ocn_tracer_short_wave_absorption
use mpas_pool_routines
use ocn_constants
use ocn_tracer_short_wave_absorption_jerlov
+ use ocn_tracer_short_wave_absorption_variable
implicit none
private
@@ -56,12 +57,13 @@ module ocn_tracer_short_wave_absorption
!> \brief Computes tendency term for surface fluxes
!> \author Doug Jacobsen
!> \date 12/17/12
-!> \details
+!> \details
!> This routine computes the tendency for tracers based on surface fluxes.
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_short_wave_absorption_tend(meshPool, index_temperature, layerThickness, penetrativeTemperatureFlux, tend, err)!{{{
+ subroutine ocn_tracer_short_wave_absorption_tend(meshPool, swForcingPool, forcingPool, index_temperature, & !{{{
+ layerThickness, penetrativeTemperatureFlux, penetrativeTemperatureFluxOBL, tend, err)
!-----------------------------------------------------------------
!
@@ -70,11 +72,14 @@ subroutine ocn_tracer_short_wave_absorption_tend(meshPool, index_temperature, la
!-----------------------------------------------------------------
type (mpas_pool_type), intent(in) :: &
- meshPool !< Input: mesh information
+ meshPool, swForcingPool, forcingPool !< Input: mesh information
real (kind=RKIND), dimension(:), intent(in) :: &
penetrativeTemperatureFlux !< Input: short wave heat flux
+ real (kind=RKIND), dimension(:), intent(inout) :: &
+ penetrativeTemperatureFluxOBL
+
real (kind=RKIND), dimension(:,:), intent(in) :: layerThickness !< Input: Layer thicknesses
integer, intent(in) :: index_temperature
@@ -102,12 +107,20 @@ subroutine ocn_tracer_short_wave_absorption_tend(meshPool, index_temperature, la
!
!-----------------------------------------------------------------
- err = 0
+ character(len=strKIND), pointer :: config_sw_absorption_type
- if ( useJerlov ) then
- call ocn_tracer_short_wave_absorption_jerlov_tend(meshPool, index_temperature, layerThickness, penetrativeTemperatureFlux, tend, err)
- end if
+ call MPAS_pool_get_config(ocnConfigs, 'config_sw_absorption_type', config_sw_absorption_type)
+
+ if (trim(config_sw_absorption_type)=='none') return
+ err = 0
+ if(useJerlov) then
+ call ocn_tracer_short_wave_absorption_jerlov_tend(meshPool, forcingPool, index_temperature, layerThickness, &
+ penetrativeTemperatureFlux, penetrativeTemperatureFluxOBL, tend, err)
+ else
+ call ocn_tracer_short_wave_absorption_variable_tend(meshPool,swForcingPool, forcingPool, index_temperature, &
+ layerThickness, penetrativeTemperatureFlux, penetrativeTemperatureFluxOBL,tend,err)
+ endif
!--------------------------------------------------------------------
end subroutine ocn_tracer_short_wave_absorption_tend!}}}
@@ -119,32 +132,48 @@ end subroutine ocn_tracer_short_wave_absorption_tend!}}}
!> \brief Initializes ocean tracer surface flux quantities
!> \author Doug Jacobsen
!> \date 12/17/12
-!> \details
+!> \details
!> This routine initializes quantities related to surface fluxes in the ocean.
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_short_wave_absorption_init(err)!{{{
+ subroutine ocn_tracer_short_wave_absorption_init(domain,err)!{{{
!--------------------------------------------------------------------
+ type (domain_type) :: domain
+
integer, intent(out) :: err !< Output: error flag
+ logical, pointer :: config_use_activeTracers_surface_bulk_forcing
character (len=StrKind), pointer :: config_sw_absorption_type
err = 0
call mpas_pool_get_config(ocnConfigs, 'config_sw_absorption_type', config_sw_absorption_type)
-
- useJerlov = .false.
-
- if ( trim( config_sw_absorption_type ) .ne. 'jerlov') then
- write(0,*) 'Incorrect option for config_sw_absorption_type. Options are: jerlov'
- err = 1
- return
- else if ( trim( config_sw_absorption_type ) == 'jerlov') then
- useJerlov = .true.
- call ocn_tracer_short_wave_absorption_jerlov_init(err)
+ call MPAS_pool_get_config(ocnConfigs, 'config_use_activeTracers_surface_bulk_forcing', &
+ config_use_activeTracers_surface_bulk_forcing)
+
+ useJerlov=.false.
+
+ if(.not. config_use_activeTracers_surface_bulk_forcing) then
+ if(trim(config_sw_absorption_type) .ne. 'none') then
+ write(stderrUnit,*) 'ERROR: you have specified bulk_forcing off with shortwave absorption on'
+ write(stderrUnit,*) 'either set config_sw_absorption_type to none or enable activeTracers_surface_bulk_forcing'
+ err = 1
+ endif
+ return
+ endif
+
+ if ( trim( config_sw_absorption_type ) == 'jerlov') then
+ useJerlov=.true.
+! call ocn_tracer_short_wave_absorption_jerlov_init(err)
+ else if ( trim( config_sw_absorption_type ) == 'ohlmann00' ) then
+ call ocn_tracer_short_wave_absorption_variable_init(domain, err)
+ else
+ write(stderrUnit,*) 'Incorrect option for config_sw_absorption_type. Options are: jerlov or ohlmann00 or none'
+ err = 1
+ return
end if
@@ -152,6 +181,7 @@ end subroutine ocn_tracer_short_wave_absorption_init!}}}
!***********************************************************************
+
end module ocn_tracer_short_wave_absorption
!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_short_wave_absorption_jerlov.F b/src/core_ocean/shared/mpas_ocn_tracer_short_wave_absorption_jerlov.F
index 4496f78126..d4a766a311 100644
--- a/src/core_ocean/shared/mpas_ocn_tracer_short_wave_absorption_jerlov.F
+++ b/src/core_ocean/shared/mpas_ocn_tracer_short_wave_absorption_jerlov.F
@@ -6,7 +6,7 @@
!> \author Doug Jacobsen
!> \date 12/17/12
!> \details
-!> This module contains the routine for computing
+!> This module contains the routine for computing
!> short wave tendencies using Jerlov
!
!-----------------------------------------------------------------------
@@ -34,7 +34,6 @@ module ocn_tracer_short_wave_absorption_jerlov
!--------------------------------------------------------------------
public :: ocn_tracer_short_wave_absorption_jerlov_tend, &
- ocn_tracer_short_wave_absorption_jerlov_init, &
ocn_get_jerlov_fraction
!--------------------------------------------------------------------
@@ -70,12 +69,13 @@ module ocn_tracer_short_wave_absorption_jerlov
!> \brief Computes tendency term for surface fluxes
!> \author Doug Jacobsen
!> \date 12/17/12
-!> \details
+!> \details
!> This routine computes the tendency for tracers based on surface fluxes.
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_short_wave_absorption_jerlov_tend(meshPool, index_temperature, layerThickness, penetrativeTemperatureFlux, tend, err)!{{{
+ subroutine ocn_tracer_short_wave_absorption_jerlov_tend(meshPool, forcingPool, index_temperature, layerThickness, &
+ penetrativeTemperatureFlux, penetrativeTemperatureFluxOBL, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -84,11 +84,14 @@ subroutine ocn_tracer_short_wave_absorption_jerlov_tend(meshPool, index_temperat
!-----------------------------------------------------------------
type (mpas_pool_type), intent(in) :: &
- meshPool !< Input: mesh information
+ meshPool, forcingPool !< Input: mesh information
real (kind=RKIND), dimension(:), intent(in) :: &
penetrativeTemperatureFlux !< Input: penetrative temperature flux through the surface
+ real (kind=RKIND), dimension(:), intent(out) :: &
+ penetrativeTemperatureFluxOBL
+
real (kind=RKIND), dimension(:,:), intent(in) :: layerThickness !< Input: Layer thicknesses
integer, intent(in) :: index_temperature
@@ -116,92 +119,61 @@ subroutine ocn_tracer_short_wave_absorption_jerlov_tend(meshPool, index_temperat
!
!-----------------------------------------------------------------
- integer :: iCell, k
+ integer :: iCell, k, depLev
integer, pointer :: nCells, nVertLevels
integer, dimension(:), pointer :: maxLevelCell
real (kind=RKIND) :: depth
+ real (kind=RKIND), pointer :: config_surface_buoyancy_depth
real (kind=RKIND), dimension(:), pointer :: refBottomDepth
real (kind=RKIND), dimension(:), allocatable :: weights
- logical, pointer :: config_fixed_jerlov_weights
-
err = 0
- call mpas_pool_get_config(ocnConfigs, 'config_fixed_jerlov_weights', config_fixed_jerlov_weights)
-
call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_config(ocnConfigs, 'config_surface_buoyancy_depth', config_surface_buoyancy_depth)
allocate(weights(nVertLevels+1))
weights = 0.0_RKIND
weights(1) = 1.0_RKIND
- if ( config_fixed_jerlov_weights ) then
- do iCell = 1, nCells
- depth = 0.0_RKIND
- do k = 1, maxLevelCell(iCell)
- depth = depth + refBottomDepth(k)
+ !$omp do schedule(runtime) private(depth, k, depLev)
+ do iCell = 1, nCells
+ depth = 0.0_RKIND
+ do k = 1, maxLevelCell(iCell)
+ depth = depth + layerThickness(k, iCell)
- call ocn_get_jerlov_fraction(depth, weights(k+1))
- tend(index_temperature, k, iCell) = tend(index_temperature, k, iCell) + penetrativeTemperatureFlux(iCell)*(weights(k) - weights(k+1))
- end do
+ call ocn_get_jerlov_fraction(depth, weights(k+1))
+ tend(index_temperature, k, iCell) = tend(index_temperature, k, iCell) + penetrativeTemperatureFlux(iCell) &
+ * (weights(k) - weights(k+1))
end do
- else
- do iCell = 1, nCells
- depth = 0.0_RKIND
- do k = 1, maxLevelCell(iCell)
- depth = depth + layerThickness(k, iCell)
-
- call ocn_get_jerlov_fraction(depth, weights(k+1))
- tend(index_temperature, k, iCell) = tend(index_temperature, k, iCell) + penetrativeTemperatureFlux(iCell)*(weights(k) - weights(k+1))
- end do
- end do
- end if
- deallocate(weights)
+ depth = 0.0_RKIND
+ do k=1,maxLevelCell(iCell)
+ depth = depth + layerThickness(k,iCell)
+ if(depth > abs(config_surface_buoyancy_depth)) exit
+ enddo
- !--------------------------------------------------------------------
+ if(k == maxLevelCell(iCell) .or. k == 1) then
+ depLev=2
+ else
+ depLev=k
+ endif
+ penetrativeTemperatureFluxOBL(iCell)=penetrativeTemperatureFlux(iCell)*weights(depLev)
- end subroutine ocn_tracer_short_wave_absorption_jerlov_tend!}}}
-
-!***********************************************************************
-!
-! routine ocn_tracer_short_wave_absorption_jerlov_init
-!
-!> \brief Initializes ocean tracer surface flux quantities
-!> \author Doug Jacobsen
-!> \date 12/17/12
-!> \details
-!> This routine initializes quantities related to surface fluxes in the ocean.
-!
-!-----------------------------------------------------------------------
+ end do
+ !$omp end do
- subroutine ocn_tracer_short_wave_absorption_jerlov_init(err)!{{{
+ deallocate(weights)
!--------------------------------------------------------------------
- integer, intent(out) :: err !< Output: error flag
-
- character (len=StrKIND), pointer :: config_sw_absorption_type
-
- err = 0
-
- call mpas_pool_get_config(ocnConfigs, 'config_sw_absorption_type', config_sw_absorption_type)
-
- if ( trim( config_sw_absorption_type ) .ne. 'jerlov') then
- write(0,*) 'Incorrect option for config_sw_absorption_type. Options are: jerlov'
- err = 1
- return
- end if
-
- end subroutine ocn_tracer_short_wave_absorption_jerlov_init!}}}
-
-!***********************************************************************
+ end subroutine ocn_tracer_short_wave_absorption_jerlov_tend!}}}
!***********************************************************************
!
@@ -210,7 +182,7 @@ end subroutine ocn_tracer_short_wave_absorption_jerlov_init!}}}
!> \brief Initializes short wave absorption fractions
!> \author Doug Jacobsen
!> \date 12/17/12
-!> \details
+!> \details
!> Computes fraction of solar short-wave flux penetrating to
!> specified depth due to exponential decay in Jerlov water type.
!> Reference : two band solar absorption model of Simpson and
@@ -219,7 +191,7 @@ end subroutine ocn_tracer_short_wave_absorption_jerlov_init!}}}
!-----------------------------------------------------------------------
subroutine ocn_get_jerlov_fraction(depth, weight)!{{{
! Note: below 200m the solar penetration gets set to zero,
-! otherwise the limit for the exponent ($+/- 5678$) needs to be
+! otherwise the limit for the exponent ($+/- 5678$) needs to be
! taken care of.
real (kind=RKIND), intent(in) :: depth !< Input: Depth of bottom of cell
@@ -231,13 +203,16 @@ subroutine ocn_get_jerlov_fraction(depth, weight)!{{{
!
!-----------------------------------------------------------------------
+!
integer :: k, nVertLevels
integer, parameter :: num_water_types = 5 ! max number of different water types
-
+
+ ! I don't understand what the previous two lines are for. They appear unnecessary
+
real (kind=RKIND), parameter :: depth_cutoff = -200.0_RKIND
integer, pointer :: config_jerlov_water_type
-
+
!-----------------------------------------------------------------------
!
! compute absorption fraction
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_short_wave_absorption_variable.F b/src/core_ocean/shared/mpas_ocn_tracer_short_wave_absorption_variable.F
new file mode 100644
index 0000000000..c322e50db2
--- /dev/null
+++ b/src/core_ocean/shared/mpas_ocn_tracer_short_wave_absorption_variable.F
@@ -0,0 +1,508 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_short_wave_absorption_jerlov
+!
+!> \brief MPAS ocean tracer short wave
+!> \author Doug Jacobsen
+!> \date 12/17/12
+!> \details
+!> This module contains the routine for computing
+!> short wave tendencies using Jerlov
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_short_wave_absorption_variable
+
+ use mpas_derived_types
+ use mpas_pool_routines
+ use mpas_timekeeping
+ use mpas_forcing
+ use mpas_stream_manager
+ use ocn_constants
+
+ implicit none
+ type(MPAS_forcing_group_type),pointer :: shortwaveForcingGroup
+
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_tracer_short_wave_absorption_variable_tend, &
+ ocn_tracer_short_wave_absorption_variable_init, &
+ ocn_get_variable_sw_fraction, &
+ ocn_get_os00_coeffs, &
+ ocn_init_shortwave_forcing_ohlmann, &
+ ocn_get_shortWaveData, &
+ ocn_shortwave_forcing_write_restart
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_short_wave_absorption_jerlov_tend
+!
+!> \brief Computes tendency term for surface fluxes
+!> \author Luke Van Roekel
+!> \date 11/10/2015
+!> \details
+!> This routine computes the tendency for tracers based on surface fluxes.
+!> This computation is now based on spatially variable chlorophyll, cloud fraction, and zenith angle
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_short_wave_absorption_variable_tend(meshPool, swForcingPool, forcingPool, index_temperature, & !{{{
+ layerThickness, penetrativeTemperatureFlux, penetrativeTemperatureFluxOBL, tend, err)
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+
+ type (mpas_pool_type), intent(in) :: &
+ meshPool, & !< Input: mesh information
+ swForcingPool, & !< Input: chlorophyll, cloud, zenith data
+ forcingPool
+
+ real (kind=RKIND), dimension(:), intent(in) :: &
+ penetrativeTemperatureFlux !< Input: penetrative temperature flux through the surface
+
+ real (kind=RKIND), dimension(:), intent(out) :: &
+ penetrativeTemperatureFluxOBL
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: layerThickness !< Input: Layer thicknesses
+
+ integer, intent(in) :: index_temperature
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iCell, k, depLev
+ integer, pointer :: nCells, nVertLevels
+
+ integer, dimension(:), pointer :: maxLevelCell
+
+ real (kind=RKIND), pointer :: config_surface_buoyancy_depth
+ real (kind=RKIND) :: depth
+ real (kind=RKIND), dimension(:), pointer :: refBottomDepth
+ real (kind=RKIND), dimension(:), allocatable :: weights
+ real (kind=RKIND), dimension(:), pointer :: chlorophyllA, zenithAngle, clearSkyRadiation
+ character (len=StrKIND), pointer :: config_sw_absorption_type
+ real (kind=RKIND), dimension(4) :: Avals, Kvals
+ real (kind=RKIND) :: cloudRatio ! cloud Ratio = 1 - incident_sfc_sw_radiation/clearSkyRadiation
+
+ err = 0
+
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+
+ call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
+ call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
+ call mpas_pool_get_config(ocnConfigs, 'config_surface_buoyancy_depth', config_surface_buoyancy_depth)
+
+ allocate(weights(nVertLevels+1))
+ weights = 0.0_RKIND
+ weights(1) = 1.0_RKIND
+ Avals(:)=0.0_RKIND
+ Kvals(:)=0.0_RKIND
+
+ call mpas_pool_get_config(ocnConfigs, 'config_sw_absorption_type', config_sw_absorption_type)
+ call mpas_pool_get_array(swForcingPool,'chlorophyllData',chlorophyllA)
+
+ call mpas_pool_get_array(swForcingPool,'zenithAngle',zenithAngle)
+ call mpas_pool_get_array(swForcingPool,'clearSkyRadiation',clearSkyRadiation)
+
+ !$omp do schedule(runtime) private(depth, k, cloudRatio, depLev)
+ do iCell = 1, nCells
+ depth = 0.0_RKIND
+ cloudRatio = min(1.0_RKIND, 1.0_RKIND - penetrativeTemperatureFlux(iCell)/(hflux_factor*(1.0E-15_RKIND + &
+ clearSkyRadiation(iCell))))
+ cloudRatio = max(0.0_RKIND, cloudRatio)
+
+ call ocn_get_os00_coeffs(chlorophyllA(iCell),zenithAngle(iCell),cloudRatio,Avals, Kvals)
+
+ do k = 1, maxLevelCell(iCell)
+ depth = depth + layerThickness(k, iCell)
+
+ call ocn_get_variable_sw_fraction(depth, weights(k+1), Avals, Kvals)
+ tend(index_temperature, k, iCell) = tend(index_temperature, k, iCell) + penetrativeTemperatureFlux(iCell) &
+ * (weights(k) - weights(k+1) )
+ end do
+
+ depth = 0.0_RKIND
+ do k=1,maxLevelCell(iCell)
+ depth = depth + layerThickness(k,iCell)
+ if(depth > abs(config_surface_buoyancy_depth)) exit
+ enddo
+
+ if(k == maxLevelCell(iCell) .or. k == 1) then
+ depLev=2
+ else
+ depLev=k
+ endif
+ penetrativeTemperatureFluxOBL(iCell)=penetrativeTemperatureFlux(iCell)*weights(depLev)
+
+ end do
+ !$omp end do
+
+ deallocate(weights)
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_short_wave_absorption_variable_tend!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_short_wave_absorption_variable_init
+!
+!> \brief Initializes ocean tracer surface flux quantities
+!> \author Luke Van Roekel
+!> \date 11/10/15
+!> \details
+!> This routine initializes quantities related to surface fluxes in the ocean.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_short_wave_absorption_variable_init(domain,err)!{{{
+
+ !--------------------------------------------------------------------
+
+ type(domain_type) :: domain
+
+ integer, intent(out) :: err !< Output: error flag
+
+ character (len=StrKIND), pointer :: config_sw_absorption_type
+
+ err = 0
+
+ call mpas_pool_get_config(ocnConfigs, 'config_sw_absorption_type', config_sw_absorption_type)
+
+ select case ( trim(config_sw_absorption_type) )
+ case ('ohlmann00')
+ call ocn_init_shortwave_forcing_ohlmann(domain)
+ case default
+ write(stderrUnit,*) "Shortwave parameterization type unknown: ", trim(config_sw_absorption_type)
+ call MPAS_dmpar_global_abort('MPAS-ocean: Unknown config_sw_absortion_type')
+ end select
+
+
+ end subroutine ocn_tracer_short_wave_absorption_variable_init!}}}
+
+!***********************************************************************
+
+!***********************************************************************
+!
+! routine ocn_init_shortwave_forcing_ohlmann
+!
+!> \brief Initializes forcing group if parameterization of Ohlmann and Siegel (2000) or Ohlmann(2003)
+!> This parameterization only requires chlorophyll-a concentrations, so only add that
+!> \author Luke Van Roekel
+!> \date 11/10/15
+!> \details
+!> This routine initializes forcing stream for Ohlmann and Siegel (2000) or Ohlman (2003) parameterization
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_init_shortwave_forcing_ohlmann(domain)!{{{
+
+ type(domain_type) :: domain
+
+ character(len=strKind), pointer :: &
+ config_forcing_restart_file
+
+ logical, pointer :: &
+ config_do_restart
+
+ character(len=strKIND) :: &
+ forcingIntervalMonthly, &
+ forcingReferenceTimeMonthly
+
+ call MPAS_pool_get_config(domain % configs, 'config_do_restart', config_do_restart)
+ call MPAS_pool_get_config(domain % configs, 'config_forcing_restart_file', config_forcing_restart_file)
+
+ forcingIntervalMonthly = "0000-01-00_00:00:00"
+ forcingReferenceTimeMonthly = "0000-01-01_00:00:00"
+
+ call MPAS_forcing_init_group( shortwaveForcingGroup, &
+ "shortwave_monthly_observations", &
+ domain, &
+ '0000-01-01_00:00:00', &
+ '0000-01-01_00:00:00', &
+ '0001-00-00_00:00:00', &
+ config_do_restart, &
+ config_forcing_restart_file)
+
+ call MPAS_forcing_init_field( domain % streamManager, &
+ shortwaveForcingGroup, &
+ 'shortwave_monthly_observations', &
+ 'chlorophyllData', &
+ 'shortwave_forcing_data', &
+ 'shortwave', &
+ 'chlorophyllData', &
+ 'constant', &
+ forcingReferenceTimeMonthly, &
+ forcingIntervalMonthly)
+
+ call MPAS_forcing_init_field( domain % streamManager, &
+ shortwaveForcingGroup, &
+ 'shortwave_monthly_observations', &
+ 'clearSkyRadiation', &
+ 'shortwave_forcing_data', &
+ 'shortwave', &
+ 'clearSkyRadiation', &
+ 'constant', &
+ forcingReferenceTimeMonthly, &
+ forcingIntervalMonthly)
+
+ call MPAS_forcing_init_field( domain % streamManager, &
+ shortwaveForcingGroup, &
+ 'shortwave_monthly_observations', &
+ 'zenithAngle', &
+ 'shortwave_forcing_data', &
+ 'shortwave', &
+ 'zenithAngle', &
+ 'constant', &
+ forcingReferenceTimeMonthly, &
+ forcingIntervalMonthly)
+
+ call MPAS_forcing_init_field_data( shortwaveForcingGroup, &
+ 'shortwave_monthly_observations', &
+ domain % streamManager)
+
+ end subroutine ocn_init_shortwave_forcing_ohlmann!}}}
+
+!***********************************************************************
+
+!***********************************************************************
+!
+! routine get_shortWaveData
+!
+!> \brief retrieve data needed to compute penetration of shortwave radiation
+!> \author Luke Van Roekel
+!> \date 11/10/15
+!> \details
+!> This routine calls mpas_forcing routines to acquire needed shortwave data and interpolates
+!> between time levels
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_get_shortWaveData( streamManager, &
+ domain, &
+ simulationClock, &
+ firstTimeStep) !{{{
+
+ type (MPAS_streamManager_type), intent(inout) :: streamManager
+
+ type (domain_type) :: domain
+ type (MPAS_timeInterval_type) :: timeStepSW
+ type (MPAS_clock_type) :: simulationClock
+
+ logical,pointer :: config_use_activeTracers_surface_bulk_forcing
+ logical, intent(in) :: firstTimeStep
+ character(len=strKind), pointer :: config_sw_absorption_type
+ character(len=strKind), pointer :: config_dt
+ real(kind=RKIND) :: dt
+
+
+ call MPAS_pool_get_config(domain%configs, 'config_use_activeTracers_surface_bulk_forcing', &
+ config_use_activeTracers_surface_bulk_forcing)
+ call MPAS_pool_get_config(domain%configs, 'config_sw_absorption_type', config_sw_absorption_type)
+ call MPAS_pool_get_config(domain%configs, 'config_dt', config_dt)
+
+ call mpas_set_timeInterval(timeStepSW,timeString=config_dt)
+ call mpas_get_timeInterval(timeStepSW,dt=dt)
+
+ if(trim(config_sw_absorption_type) == 'ohlmann00' .and. config_use_activeTracers_surface_bulk_forcing) then
+ call MPAS_forcing_get_forcing(shortwaveForcingGroup, &
+ 'shortwave_monthly_observations', streamManager, dt)
+ endif
+
+ end subroutine ocn_get_shortWaveData!}}}
+
+
+!***********************************************************************
+
+
+!***********************************************************************
+!
+! routine ocn_get_variable_fractions
+!
+!> \brief Computes short wave absorption fractions
+!> \author Luke Van Roekel
+!> \date 11/10/2015
+!> \details
+!> Computes fraction of solar short-wave flux penetrating to
+!> specified depth due to time and space varying chlorophyll, cloud fraction, and zenith angle
+!> based on:
+!> Ohlmann and Siegel (2000), Ohlmann (2003), Manizza et al. (2005)
+
+!
+!-----------------------------------------------------------------------
+ subroutine ocn_get_variable_sw_fraction(depth, weight, Avals, Kvals)!{{{
+! Note: below 200m the solar penetration gets set to zero,
+! otherwise the limit for the exponent ($+/- 5678$) needs to be
+! taken care of.
+
+ real (kind=RKIND), intent(in) :: depth !< Input: Depth of bottom of cell
+ real (kind=RKIND), intent(in),dimension(4) :: Avals !< Input: spectral partitioning of radiation
+ real (kind=RKIND), intent(in),dimension(4) :: Kvals !< Input: extinction coefficients for different radiation bands
+ real (kind=RKIND), intent(out) :: weight !< Output: Weight for Jerlov absorption
+
+!-----------------------------------------------------------------------
+!
+! local variables
+!
+!-----------------------------------------------------------------------
+
+!
+ integer :: k
+
+ real (kind=RKIND), parameter :: depth_cutoff = -200.0_RKIND
+
+!-----------------------------------------------------------------------
+!
+! compute absorption fraction
+!
+!-----------------------------------------------------------------------
+
+ if (-depth < depth_cutoff) then
+ weight = 0.0_RKIND
+ else
+ weight=0.0_RKIND
+ do k=1,4
+ weight = weight + Avals(k)*exp(-depth*Kvals(k))
+ enddo
+ endif
+ end subroutine ocn_get_variable_sw_fraction!}}}
+
+!***********************************************************************
+
+
+
+!***********************************************************************
+!
+! routine ocn_get_os00_coeffs
+!
+!> \brief Computes coefficients for spatially varying penetrating shortwave via Ohlmann and Siegel 2000
+!> \author Luke Van Roekel
+!> \date 11/10/2015
+!> \details
+!> This will fill in coefficients for the penetrating shortwave parameterization
+!> A1*exp(-K1*depth) + A2*exp(-K2*depth) + A3*exp(-K3*depth) + A4*exp(-K4*depth)
+!> For Ohlmann and Siegel (2000) A4 no approximations are made
+!> Here the IR portion of the spectrum is also decomposed. Four exponential terms are used
+!> NOTE: other schemes can be easily recovered. For example, Ohlmann (2003) requires a
+!> coefficient changes only Use equations 6a - 6d and 7
+! Ohlmann, JC, 2003: Ocean Radiant Heating in Climate Models, J.Clim, v16, 1337-1351
+! To recover the Morel (1988) scheme used in Manizza et al. (2005), use equations 1-4 of
+! Manizza, M, C LeQuere, AJ Watson, ET Buitenhuis, 2005: Bio-optical feedbacks among phytoplankton
+! upper ocean physics and sea-ice in a global model, Geophys, Res. Lett
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_get_os00_coeffs(chlorophyllA,zenithAngle,cloudFraction,Avals,Kvals)!{{{
+
+ real(kind=RKIND), intent(in) :: chlorophyllA, zenithAngle, cloudFraction
+ real(kind=RKIND), intent(out), dimension(4) :: Avals, Kvals
+
+ if(cloudFraction > 0.1_RKIND) then ! cloudy skies
+ Avals(1) = 0.026_RKIND*chlorophyllA + 0.112_RKIND*cloudFraction + 0.366_RKIND
+ Avals(2) = -0.009_RKIND*chlorophyllA + 0.034_RKIND*cloudFraction + 0.207_RKIND
+ Avals(3) = -0.015_RKIND*chlorophyllA -0.006_RKIND*cloudFraction + 0.188_RKIND
+ Avals(4) = -0.003_RKIND*chlorophyllA -0.131_RKIND*cloudFraction + 0.169_RKIND
+ Kvals(1) = 0.063_RKIND*chlorophyllA -0.015_RKIND*cloudFraction + 0.082_RKIND
+ Kvals(2) = 0.278_RKIND*chlorophyllA -0.562_RKIND*cloudFraction + 1.02_RKIND
+ Kvals(3) = 3.91_RKIND*chlorophyllA -12.91_RKIND*cloudFraction + 16.62_RKIND
+ Kvals(4) = 16.64_RKIND*chlorophyllA -478.28_RKIND*cloudFraction + 736.56_RKIND
+ else ! clear skies
+ Avals(1) = 0.033_RKIND*chlorophyllA -0.025_RKIND*zenithAngle + 0.419_RKIND
+ Avals(2) = -0.010_RKIND*chlorophyllA -0.007_RKIND*zenithAngle + 0.231_RKIND
+ Avals(3) = -0.019_RKIND*chlorophyllA -0.003_RKIND*zenithAngle + 0.195_RKIND
+ Avals(4) = -0.006_RKIND*chlorophyllA -0.004_RKIND*zenithAngle + 0.154_RKIND
+ Kvals(1) = 0.066_RKIND*chlorophyllA + 0.006_RKIND*zenithAngle + 0.066_RKIND
+ Kvals(2) = 0.396_RKIND*chlorophyllA -0.027_RKIND*zenithAngle + 0.866_RKIND
+ Kvals(3) = 7.68_RKIND*chlorophyllA -2.49_RKIND*zenithAngle + 17.81_RKIND
+ Kvals(4) = 51.27_RKIND*chlorophyllA + 13.14_RKIND*zenithAngle + 665.19_RKIND
+ endif
+
+ end subroutine ocn_get_os00_coeffs!}}}
+
+!***********************************************************************
+
+
+!***********************************************************************
+!
+! routine ocn_shortwave_forcing_write_restart
+!
+!> \brief writes restart timestamp for SW data to be read in on future restart
+!> \author Luke Van Roekel
+!> \date 11/16/2015
+
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_shortwave_forcing_write_restart(domain)!{{{
+
+ type(domain_type) :: domain
+
+ character(len=strKind), pointer :: config_forcing_restart_file, &
+ config_sw_absorption_type
+
+
+ call MPAS_pool_get_config(domain % configs, "config_sw_absorption_type", config_sw_absorption_type)
+
+ if( trim(config_sw_absorption_type) == 'ohlmann00' ) then
+ call MPAS_pool_get_config(domain % configs, "config_forcing_restart_file", config_forcing_restart_file)
+
+ call MPAS_forcing_write_restart_times(shortwaveForcingGroup, config_forcing_restart_file)
+ endif
+
+ end subroutine ocn_shortwave_forcing_write_restart!}}}
+
+
+end module ocn_tracer_short_wave_absorption_variable
+
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_surface_flux.F b/src/core_ocean/shared/mpas_ocn_tracer_surface_flux_to_tend.F
similarity index 74%
rename from src/core_ocean/shared/mpas_ocn_tracer_surface_flux.F
rename to src/core_ocean/shared/mpas_ocn_tracer_surface_flux_to_tend.F
index f80dc624fd..2ac2a0b32e 100644
--- a/src/core_ocean/shared/mpas_ocn_tracer_surface_flux.F
+++ b/src/core_ocean/shared/mpas_ocn_tracer_surface_flux_to_tend.F
@@ -7,18 +7,18 @@
!
!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
!
-! ocn_tracer_surface_flux
+! ocn_tracer_surface_flux_to_tend
!
!> \brief MPAS ocean tracer surface flux
!> \author Doug Jacobsen
!> \date 12/17/12
!> \details
-!> This module contains the routine for computing
-!> surface flux tendencies.
+!> This module contains the routine for computing
+!> surface flux tendencies.
!
!-----------------------------------------------------------------------
-module ocn_tracer_surface_flux
+module ocn_tracer_surface_flux_to_tend
use mpas_derived_types
use mpas_pool_routines
@@ -64,12 +64,13 @@ module ocn_tracer_surface_flux
!> \brief Computes tendency term for surface fluxes
!> \author Doug Jacobsen
!> \date 12/17/12
-!> \details
+!> \details
!> This routine computes the tendency for tracers based on surface fluxes.
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_surface_flux_tend(meshPool, fractionAbsorbed, layerThickness, surfaceTracerFlux, tend, err)!{{{
+ subroutine ocn_tracer_surface_flux_tend(meshPool, fractionAbsorbed, fractionAbsorbedRunoff, layerThickness, &
+ surfaceTracerFlux, surfaceTracerFluxRunoff, tend, err)!{{{
!-----------------------------------------------------------------
!
! input variables
@@ -88,6 +89,12 @@ subroutine ocn_tracer_surface_flux_tend(meshPool, fractionAbsorbed, layerThickne
real (kind=RKIND), dimension(:,:), intent(in) :: &
fractionAbsorbed !< Input: Coefficients for the application of surface fluxes
+ real (kind=RKIND), dimension(:,:), intent(in), pointer :: &
+ surfaceTracerFluxRunoff !< Input: surface tracer fluxes from river runoff
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ fractionAbsorbedRunoff !< Input: Coefficients for the application of surface fluxes due to river runoff
+
!-----------------------------------------------------------------
!
! input/output variables
@@ -114,7 +121,6 @@ subroutine ocn_tracer_surface_flux_tend(meshPool, fractionAbsorbed, layerThickne
integer :: iCell, k, iTracer, nTracers
integer, pointer :: nCells, nVertLevels
integer, dimension(:), pointer :: maxLevelCell
- integer, dimension(:,:), pointer :: cellMask
real (kind=RKIND) :: remainingFlux
@@ -127,24 +133,51 @@ subroutine ocn_tracer_surface_flux_tend(meshPool, fractionAbsorbed, layerThickne
nTracers = size(tend, dim=1)
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
- call mpas_pool_get_array(meshPool, 'cellMask', cellMask)
+ !$omp do schedule(runtime) private(remainingFlux, k, iTracer)
do iCell = 1, nCells
remainingFlux = 1.0_RKIND
do k = 1, maxLevelCell(iCell)
remainingFlux = remainingFlux - fractionAbsorbed(k, iCell)
do iTracer = 1, nTracers
- tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + cellMask(k, icell) * surfaceTracerFlux(iTracer, iCell) * fractionAbsorbed(k, iCell)
+ tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + surfaceTracerFlux(iTracer, iCell) * fractionAbsorbed(k, iCell)
end do
end do
if(maxLevelCell(iCell) > 0 .and. remainingFlux > 0.0_RKIND) then
do iTracer = 1, nTracers
- tend(iTracer, maxLevelCell(iCell), iCell) = tend(iTracer, maxLevelCell(iCell), iCell) + cellMask(k, iCell) * surfaceTracerFlux(iTracer, iCell) * remainingFlux
+ tend(iTracer, maxLevelCell(iCell), iCell) = tend(iTracer, maxLevelCell(iCell), iCell) &
+ + surfaceTracerFlux(iTracer, iCell) * remainingFlux
end do
end if
end do
+ !$omp end do
+
+ ! now do runoff component
+
+ if (associated(surfaceTracerFluxRunoff)) then
+ !$omp do schedule(runtime) private(remainingFlux, k, iTracer)
+ do iCell = 1, nCells
+ remainingFlux = 1.0_RKIND
+ do k = 1, maxLevelCell(iCell)
+ remainingFlux = remainingFlux - fractionAbsorbedRunoff(k, iCell)
+
+ do iTracer = 1, nTracers
+ tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + &
+ surfaceTracerFluxRunoff(iTracer, iCell) * fractionAbsorbedRunoff(k, iCell)
+ end do
+ end do
+
+ if(maxLevelCell(iCell) > 0 .and. remainingFlux > 0.0_RKIND) then
+ do iTracer = 1, nTracers
+ tend(iTracer, maxLevelCell(iCell), iCell) = tend(iTracer, maxLevelCell(iCell), iCell) &
+ + surfaceTracerFluxRunoff(iTracer, iCell) * remainingFlux
+ end do
+ end if
+ end do
+ !$omp end do
+ endif
!--------------------------------------------------------------------
@@ -157,7 +190,7 @@ end subroutine ocn_tracer_surface_flux_tend!}}}
!> \brief Initializes ocean tracer surface flux quantities
!> \author Doug Jacobsen
!> \date 12/17/12
-!> \details
+!> \details
!> This routine initializes quantities related to surface fluxes in the ocean.
!
!-----------------------------------------------------------------------
@@ -169,12 +202,10 @@ subroutine ocn_tracer_surface_flux_init(err)!{{{
integer, intent(out) :: err !< Output: error flag
logical, pointer :: config_disable_tr_sflux
- character (len=StrKIND), pointer :: config_forcing_type
err = 0
call mpas_pool_get_config(ocnConfigs, 'config_disable_tr_sflux', config_disable_tr_sflux)
- call mpas_pool_get_config(ocnConfigs, 'config_forcing_type', config_forcing_type)
surfaceTracerFluxOn = .true.
@@ -182,15 +213,11 @@ subroutine ocn_tracer_surface_flux_init(err)!{{{
surfaceTracerFluxOn = .false.
end if
- if (config_forcing_type == trim('off')) then
- surfaceTracerFluxOn = .false.
- end if
-
end subroutine ocn_tracer_surface_flux_init!}}}
!***********************************************************************
-end module ocn_tracer_surface_flux
+end module ocn_tracer_surface_flux_to_tend
!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_tracer_surface_restoring.F b/src/core_ocean/shared/mpas_ocn_tracer_surface_restoring.F
new file mode 100644
index 0000000000..04d766b05f
--- /dev/null
+++ b/src/core_ocean/shared/mpas_ocn_tracer_surface_restoring.F
@@ -0,0 +1,161 @@
+! 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
+!
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_surface_restoring
+!
+!> \brief MPAS ocean restoring
+!> \author Todd Ringler
+!> \date 06/08/2015
+!> \details
+!> This module contains routines for computing the surface tracer flux due to restoring
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_surface_restoring
+
+ use mpas_kind_types
+ use mpas_derived_types
+ use mpas_pool_routines
+ use ocn_constants
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_tracer_surface_restoring_compute, &
+ ocn_tracer_surface_restoring_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_surface_restoring_compute
+!
+!> \brief computes a surface tracer flux due to surface restoring
+!> \author Todd Ringler
+!> \date 06/09/2015
+!> \details
+!> This routine computes a surface tracer flux due to surface restoring
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_surface_restoring_compute(nTracers, nCellsSolve, tracers, pistonVelocity, &
+ tracersSurfaceRestoringValue, tracersSurfaceFlux, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ ! scalars
+ integer, intent(in) :: &
+ nTracers, &
+ nCellsSolve
+
+ ! three dimensional arrays
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers
+
+ ! two dimensional ararys
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ pistonVelocity, &
+ tracersSurfaceRestoringValue
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ tracersSurfaceFlux
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iCell, iLevel, iTracer
+
+ err = 0
+
+ iLevel = 1 ! base surface flux restoring on tracer fields in the top layer
+
+ !$omp do schedule(runtime) private(iTracer)
+ do iCell=1,nCellsSolve
+ do iTracer=1,nTracers
+ tracersSurfaceFlux(iTracer, iCell) = tracersSurfaceFlux(iTracer, iCell) - &
+ pistonVelocity(iTracer,iCell) * &
+ (tracers(iTracer, iLevel, iCell) - tracersSurfaceRestoringValue(iTracer,iCell))
+ enddo
+ enddo
+ !$omp end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_surface_restoring_compute!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_surface_restoring_init
+!
+!> \brief Initializes ocean surface restoring
+!> \author Todd Ringler
+!> \date 06/09/2015
+!> \details
+!> This routine initializes fields required for tracer surface flux restoring
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_surface_restoring_init(err)!{{{
+
+ integer, intent(out) :: err !< Output: error flag
+
+ err = 0
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_surface_restoring_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_surface_restoring
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_vel_coriolis.F b/src/core_ocean/shared/mpas_ocn_vel_coriolis.F
index a181b9720f..73503edcc7 100644
--- a/src/core_ocean/shared/mpas_ocn_vel_coriolis.F
+++ b/src/core_ocean/shared/mpas_ocn_vel_coriolis.F
@@ -13,8 +13,8 @@
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date September 2011
!> \details
-!> This module contains the routine for computing
-!> tendencies from the coriolis force.
+!> This module contains the routine for computing
+!> tendencies from the coriolis force.
!>
!
!-----------------------------------------------------------------------
@@ -64,13 +64,14 @@ module ocn_vel_coriolis
!> \brief Computes tendency term for coriolis force
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the coriolis tendency for momentum
!> based on current state.
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_coriolis_tend(meshPool, normalizedRelativeVorticityEdge, normalizedPlanetaryVorticityEdge, layerThicknessEdge, normalVelocity, kineticEnergyCell, tend, err)!{{{
+ subroutine ocn_vel_coriolis_tend(meshPool, normalizedRelativeVorticityEdge, normalizedPlanetaryVorticityEdge, &
+ layerThicknessEdge, normalVelocity, kineticEnergyCell, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -118,8 +119,9 @@ subroutine ocn_vel_coriolis_tend(meshPool, normalizedRelativeVorticityEdge, norm
integer :: j, k
integer :: cell1, cell2, iEdge, eoe
- integer, pointer :: nEdgesSolve
- real (kind=RKIND) :: workVorticity, q, invLength
+ integer, pointer :: nEdgesSolve, nVertLevels
+ real (kind=RKIND) :: workVorticity, invLength, edgeWeight, r_tmp
+ real (kind=RKIND), dimension(:), allocatable :: qArr
err = 0
@@ -134,28 +136,43 @@ subroutine ocn_vel_coriolis_tend(meshPool, normalizedRelativeVorticityEdge, norm
call mpas_pool_get_array(meshPool, 'edgeMask', edgeMask)
call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
+ call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
+
+ allocate( qArr(nVertLevels) )
+ !$omp do schedule(runtime) private(cell1, cell2, invLength, k, j, eoe, workVorticity)
do iEdge = 1, nEdgesSolve
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
- invLength = 1.0 / dcEdge(iEdge)
+ invLength = 1.0_RKIND / dcEdge(iEdge)
do k = 1, maxLevelEdgeTop(iEdge)
+ qArr(k) = 0.0_RKIND
+ end do
- q = 0.0
- do j = 1,nEdgesOnEdge(iEdge)
- eoe = edgesOnEdge(j,iEdge)
- workVorticity = 0.5 &
- * ( normalizedRelativeVorticityEdge(k,iEdge) + RK4On * normalizedPlanetaryVorticityEdge(k,iEdge) &
- + normalizedRelativeVorticityEdge(k,eoe) + RK4On * normalizedPlanetaryVorticityEdge(k,eoe))
- q = q + weightsOnEdge(j,iEdge) * normalVelocity(k,eoe) * workVorticity * layerThicknessEdge(k,eoe)
+ do j = 1, nEdgesOnEdge(iEdge)
+ eoe = edgesOnEdge(j, iEdge)
+ edgeWeight = weightsOnEdge(j, iEdge)
+
+ do k = 1, maxLevelEdgeTop(iEdge)
+ workVorticity = 0.5_RKIND &
+ * ( normalizedRelativeVorticityEdge(k, iEdge) + RK4On * normalizedPlanetaryVorticityEdge(k, iEdge) &
+ + normalizedRelativeVorticityEdge(k, eoe) + RK4On * normalizedPlanetaryVorticityEdge(k, eoe))
+ qArr(k) = qArr(k) + edgeWeight * normalVelocity(k, eoe) * workVorticity * layerThicknessEdge(k, eoe)
end do
- tend(k,iEdge) = tend(k,iEdge) + edgeMask(k, iEdge) * (q - ( kineticEnergyCell(k,cell2) - kineticEnergyCell(k,cell1) ) * invLength )
+ end do
+ do k = 1, maxLevelEdgeTop(iEdge)
+ tend(k, iEdge) = tend(k, iEdge) + edgeMask(k, iEdge) * ( qArr(k) - ( kineticEnergyCell(k, cell2) &
+ - kineticEnergyCell(k, cell1) ) * invLength )
end do
+
end do
+ !$omp end do
+
+ deallocate( qArr )
!--------------------------------------------------------------------
@@ -168,11 +185,11 @@ end subroutine ocn_vel_coriolis_tend!}}}
!> \brief Initializes ocean momentum horizontal mixing quantities
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date September 2011
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity mixing in the ocean. Since a variety of
+!> \details
+!> This routine initializes a variety of quantities related to
+!> horizontal velocity mixing in the ocean. Since a variety of
!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
+!> individual init routines for each parameterization.
!
!-----------------------------------------------------------------------
@@ -205,7 +222,7 @@ subroutine ocn_vel_coriolis_init(err)!{{{
RK4On = 1
elseif ( trim( config_time_integrator ) == 'split_explicit' &
.or. trim( config_time_integrator ) == 'unsplit_explicit') then
- ! For split explicit, Coriolis tendency uses eta/h because the Coriolis term
+ ! For split explicit, Coriolis tendency uses eta/h because the Coriolis term
! is added separately to the momentum tendencies.
RK4On = 0
end if
diff --git a/src/core_ocean/shared/mpas_ocn_vel_forcing.F b/src/core_ocean/shared/mpas_ocn_vel_forcing.F
index fced50b619..0f0612c4d5 100644
--- a/src/core_ocean/shared/mpas_ocn_vel_forcing.F
+++ b/src/core_ocean/shared/mpas_ocn_vel_forcing.F
@@ -13,8 +13,8 @@
!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
!> \date September 2011
!> \details
-!> This module contains the main driver routine for computing
-!> tendencies from forcings.
+!> This module contains the main driver routine for computing
+!> tendencies from forcings.
!
!-----------------------------------------------------------------------
@@ -25,7 +25,7 @@ module ocn_vel_forcing
use ocn_constants
use ocn_forcing
- use ocn_vel_forcing_windstress
+ use ocn_vel_forcing_surface_stress
use ocn_vel_forcing_rayleigh
implicit none
@@ -65,7 +65,7 @@ module ocn_vel_forcing
!> \brief Computes tendency term from forcings
!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
!> \date 15 September 2011
-!> \details
+!> \details
!> This routine computes the forcing tendency for momentum
!> based on current state and user choices of forcings.
!> Multiple forcings may be chosen and added together. These
@@ -75,7 +75,8 @@ module ocn_vel_forcing
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_forcing_tend(meshPool, normalVelocity, surfaceWindStress, layerThicknessEdge, tend, err)!{{{
+ subroutine ocn_vel_forcing_tend(meshPool, normalVelocity, surfaceFluxAttenuationCoefficient, &
+ surfaceStress, layerThicknessEdge, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -87,7 +88,8 @@ subroutine ocn_vel_forcing_tend(meshPool, normalVelocity, surfaceWindStress, lay
normalVelocity !< Input: Normal velocity at edges
real (kind=RKIND), dimension(:), intent(in) :: &
- surfaceWindStress !< Input: Wind stress at surface of normal velocity at edges
+ surfaceFluxAttenuationCoefficient, & !< Input: attenuation coefficient for surface fluxes at cell centers
+ surfaceStress !< Input: surface stress at edges
real (kind=RKIND), dimension(:,:), intent(in) :: &
layerThicknessEdge !< Input: thickness at edge
@@ -123,12 +125,13 @@ subroutine ocn_vel_forcing_tend(meshPool, normalVelocity, surfaceWindStress, lay
!-----------------------------------------------------------------
!
! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
+ ! note that the user can choose multiple options and the
! tendencies will be added together
!
!-----------------------------------------------------------------
- call ocn_vel_forcing_windstress_tend(meshPool, surfaceWindStress, layerThicknessEdge, tend, err1)
+ call ocn_vel_forcing_surface_stress_tend(meshPool, surfaceFluxAttenuationCoefficient, &
+ surfaceStress, layerThicknessEdge, tend, err1)
call ocn_vel_forcing_rayleigh_tend(meshPool, normalVelocity, tend, err2)
err = ior(err1, err2)
@@ -144,11 +147,11 @@ end subroutine ocn_vel_forcing_tend!}}}
!> \brief Initializes ocean forcings
!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
!> \date September 2011
-!> \details
-!> This routine initializes quantities related to forcings
-!> in the ocean. Since a multiple forcings are available,
+!> \details
+!> This routine initializes quantities related to forcings
+!> in the ocean. Since a multiple forcings are available,
!> this routine primarily calls the
-!> individual init routines for each forcing.
+!> individual init routines for each forcing.
!
!-----------------------------------------------------------------------
@@ -166,7 +169,7 @@ subroutine ocn_vel_forcing_init(err)!{{{
integer :: err1, err2
- call ocn_vel_forcing_windstress_init(err1)
+ call ocn_vel_forcing_surface_stress_init(err1)
call ocn_vel_forcing_rayleigh_init(err2)
err = ior(err1, err2)
diff --git a/src/core_ocean/shared/mpas_ocn_vel_forcing_rayleigh.F b/src/core_ocean/shared/mpas_ocn_vel_forcing_rayleigh.F
index 529a6e5f5a..7d173c43bf 100644
--- a/src/core_ocean/shared/mpas_ocn_vel_forcing_rayleigh.F
+++ b/src/core_ocean/shared/mpas_ocn_vel_forcing_rayleigh.F
@@ -13,7 +13,7 @@
!> \author Todd Ringler
!> \date 5 January 2012
!> \details
-!> This module contains the routine for computing
+!> This module contains the routine for computing
!> tendencies based on linear Rayleigh friction.
!
!-----------------------------------------------------------------------
@@ -64,7 +64,7 @@ module ocn_vel_forcing_rayleigh
!> \brief Computes tendency term from Rayleigh friction
!> \author Todd Ringler
!> \date 5 January 2012
-!> \details
+!> \details
!> This routine computes the Rayleigh friction tendency for momentum
!> based on current state.
!
@@ -79,7 +79,7 @@ subroutine ocn_vel_forcing_rayleigh_tend(meshPool, normalVelocity, tend, err)!{{
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
- normalVelocity !< Input: velocity
+ normalVelocity !< Input: velocity
type (mpas_pool_type), intent(in) :: &
meshPool !< Input: mesh information
@@ -114,7 +114,7 @@ subroutine ocn_vel_forcing_rayleigh_tend(meshPool, normalVelocity, tend, err)!{{
!-----------------------------------------------------------------
!
! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
+ ! note that the user can choose multiple options and the
! tendencies will be added together
!
!-----------------------------------------------------------------
@@ -126,6 +126,7 @@ subroutine ocn_vel_forcing_rayleigh_tend(meshPool, normalVelocity, tend, err)!{{
call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
call mpas_pool_get_array(meshPool, 'maxLevelEdgeTop', maxLevelEdgeTop)
+ !$omp do schedule(runtime) private(k)
do iEdge = 1, nEdgesSolve
do k = 1, maxLevelEdgeTop(iEdge)
@@ -133,7 +134,7 @@ subroutine ocn_vel_forcing_rayleigh_tend(meshPool, normalVelocity, tend, err)!{{
enddo
enddo
-
+ !$omp end do
!--------------------------------------------------------------------
@@ -146,9 +147,9 @@ end subroutine ocn_vel_forcing_rayleigh_tend!}}}
!> \brief Initializes ocean Rayleigh friction
!> \author Todd Ringler
!> \date 5 January 2012
-!> \details
-!> This routine initializes quantities related to
-!> in the ocean.
+!> \details
+!> This routine initializes quantities related to
+!> in the ocean.
!
!-----------------------------------------------------------------------
@@ -172,7 +173,7 @@ subroutine ocn_vel_forcing_rayleigh_init(err)!{{{
call mpas_pool_get_config(ocnConfigs, 'config_Rayleigh_friction', config_Rayleigh_friction)
call mpas_pool_get_config(ocnConfigs, 'config_Rayleigh_damping_coeff', config_Rayleigh_damping_coeff)
- rayleighDampingCoef = 0.0
+ rayleighDampingCoef = 0.0_RKIND
if (config_Rayleigh_friction) then
rayleighFrictionOn = .true.
diff --git a/src/core_ocean/shared/mpas_ocn_vel_forcing_windstress.F b/src/core_ocean/shared/mpas_ocn_vel_forcing_surface_stress.F
similarity index 66%
rename from src/core_ocean/shared/mpas_ocn_vel_forcing_windstress.F
rename to src/core_ocean/shared/mpas_ocn_vel_forcing_surface_stress.F
index 1043e9c9f5..e6eec4b9f3 100644
--- a/src/core_ocean/shared/mpas_ocn_vel_forcing_windstress.F
+++ b/src/core_ocean/shared/mpas_ocn_vel_forcing_surface_stress.F
@@ -7,18 +7,18 @@
!
!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
!
-! ocn_vel_forcing_windstress
+! ocn_vel_forcing_surface_stress
!
-!> \brief MPAS ocean wind stress
+!> \brief MPAS ocean surface stress
!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
!> \date September 2011
!> \details
-!> This module contains the routine for computing
-!> tendencies from wind stress.
+!> This module contains the routine for computing
+!> tendencies from surface stress.
!
!-----------------------------------------------------------------------
-module ocn_vel_forcing_windstress
+module ocn_vel_forcing_surface_stress
use mpas_derived_types
use mpas_pool_routines
@@ -42,8 +42,8 @@ module ocn_vel_forcing_windstress
!
!--------------------------------------------------------------------
- public :: ocn_vel_forcing_windstress_tend, &
- ocn_vel_forcing_windstress_init
+ public :: ocn_vel_forcing_surface_stress_tend, &
+ ocn_vel_forcing_surface_stress_init
!--------------------------------------------------------------------
!
@@ -51,7 +51,7 @@ module ocn_vel_forcing_windstress
!
!--------------------------------------------------------------------
- logical :: windStressOn
+ logical :: surfaceStressOn
!***********************************************************************
@@ -59,18 +59,19 @@ module ocn_vel_forcing_windstress
!***********************************************************************
!
-! routine ocn_vel_forcing_windstress_tend
+! routine ocn_vel_forcing_surface_stress_tend
!
-!> \brief Computes tendency term from wind stress
+!> \brief Computes tendency term from surface stress
!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
!> \date 15 September 2011
-!> \details
-!> This routine computes the wind stress tendency for momentum
+!> \details
+!> This routine computes the surface stress tendency for momentum
!> based on current state.
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_forcing_windstress_tend(meshPool, surfaceWindStress, layerThicknessEdge, tend, err)!{{{
+ subroutine ocn_vel_forcing_surface_stress_tend(meshPool, surfaceFluxAttenuationCoefficient, surfaceStress, & !{{{
+ layerThicknessEdge, tend, err)
!-----------------------------------------------------------------
!
@@ -79,7 +80,8 @@ subroutine ocn_vel_forcing_windstress_tend(meshPool, surfaceWindStress, layerThi
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:), intent(in) :: &
- surfaceWindStress !< Input: Wind stress at surface
+ surfaceStress, & !< Input: Wind stress at surface
+ surfaceFluxAttenuationCoefficient !< Input: attenuation coefficient for surface fluxes
real (kind=RKIND), dimension(:,:), intent(in) :: &
layerThicknessEdge !< Input: thickness at edge
@@ -110,47 +112,51 @@ subroutine ocn_vel_forcing_windstress_tend(meshPool, surfaceWindStress, layerThi
!
!-----------------------------------------------------------------
- integer :: iEdge, k
+ integer :: iEdge, k, cell1, cell2
integer, pointer :: nEdgesSolve
integer, dimension(:), pointer :: maxLevelEdgeTop
- integer, dimension(:,:), pointer :: edgeMask
-
- real (kind=RKIND) :: transmissionCoeffTop, transmissionCoeffBot, zTop, zBot, remainingStress
+ integer, dimension(:,:), pointer :: edgeMask, cellsOnEdge
- real (kind=RKIND), pointer :: config_density0
+ real (kind=RKIND) :: transmissionCoeffTop, transmissionCoeffBot, zTop, zBot, remainingStress, &
+ attenuationCoeff
!-----------------------------------------------------------------
!
! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
+ ! note that the user can choose multiple options and the
! tendencies will be added together
!
!-----------------------------------------------------------------
err = 0
- if ( .not. windStressOn ) return
-
- call mpas_pool_get_config(ocnConfigs, 'config_density0', config_density0)
+ if ( .not. surfaceStressOn ) return
call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve)
call mpas_pool_get_array(meshPool, 'maxLevelEdgeTop', maxLevelEdgeTop)
call mpas_pool_get_array(meshPool, 'edgeMask', edgeMask)
+ call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
+ !$omp do schedule(runtime) private(zTop, transmissionCoeffBot, remainingStress, k, transmissionCoeffTop, &
+ !$omp cell1, cell2, attenuationCoeff, zBot)
do iEdge = 1, nEdgesSolve
zTop = 0.0_RKIND
- transmissionCoeffTop = ocn_forcing_transmission(zTop)
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ attenuationCoeff = 0.5_RKIND * (surfaceFluxAttenuationCoefficient(cell1) &
+ + surfaceFluxAttenuationCoefficient(cell2))
+ transmissionCoeffTop = ocn_forcing_transmission(zTop, attenuationCoeff)
remainingStress = 1.0_RKIND
do k = 1, maxLevelEdgeTop(iEdge)
zBot = zTop - layerThicknessEdge(k, iEdge)
- transmissionCoeffBot = ocn_forcing_transmission(zBot)
+ transmissionCoeffBot = ocn_forcing_transmission(zBot, attenuationCoeff)
remainingStress = remainingStress - (transmissionCoeffTop - transmissionCoeffBot)
- tend(k,iEdge) = tend(k,iEdge) + edgeMask(k, iEdge) * surfaceWindStress(iEdge) &
- * (transmissionCoeffTop - transmissionCoeffBot) / config_density0 / layerThicknessEdge(k,iEdge)
+ tend(k,iEdge) = tend(k,iEdge) + edgeMask(k, iEdge) * surfaceStress(iEdge) &
+ * (transmissionCoeffTop - transmissionCoeffBot) / rho_sw / layerThicknessEdge(k,iEdge)
zTop = zBot
transmissionCoeffTop = transmissionCoeffBot
@@ -158,30 +164,30 @@ subroutine ocn_vel_forcing_windstress_tend(meshPool, surfaceWindStress, layerThi
if ( maxLevelEdgeTop(iEdge) > 0 .and. remainingStress > 0.0_RKIND) then
tend(maxLevelEdgeTop(iEdge), iEdge) = tend(maxLevelEdgeTop(iEdge), iEdge) &
- + edgeMask(maxLevelEdgeTop(iEdge), iEdge) * surfaceWindStress(iEdge) * remainingStress &
- / config_density0 / layerThicknessEdge(maxLevelEdgeTop(iEdge), iEdge)
+ + edgeMask(maxLevelEdgeTop(iEdge), iEdge) * surfaceStress(iEdge) * remainingStress &
+ / rho_sw / layerThicknessEdge(maxLevelEdgeTop(iEdge), iEdge)
end if
enddo
-
+ !$omp end do
!--------------------------------------------------------------------
- end subroutine ocn_vel_forcing_windstress_tend!}}}
+ end subroutine ocn_vel_forcing_surface_stress_tend!}}}
!***********************************************************************
!
-! routine ocn_vel_forcing_windstress_init
+! routine ocn_vel_forcing_surface_stress_init
!
-!> \brief Initializes ocean wind stress forcing
+!> \brief Initializes ocean surface stress forcing
!> \author Doug Jacobsen, Mark Petersen, Todd Ringler
!> \date September 2011
-!> \details
-!> This routine initializes quantities related to wind stress
-!> in the ocean.
+!> \details
+!> This routine initializes quantities related to surface stress
+!> in the ocean.
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_forcing_windstress_init(err)!{{{
+ subroutine ocn_vel_forcing_surface_stress_init(err)!{{{
!--------------------------------------------------------------------
@@ -193,30 +199,23 @@ subroutine ocn_vel_forcing_windstress_init(err)!{{{
integer, intent(out) :: err !< Output: error flag
- logical, pointer :: config_disable_vel_windstress
- character (len=StrKIND), pointer :: config_forcing_type
-
- call mpas_pool_get_config(ocnConfigs, 'config_disable_vel_windstress', config_disable_vel_windstress)
- call mpas_pool_get_config(ocnConfigs, 'config_forcing_type', config_forcing_type)
-
- windStressOn = .true.
+ logical, pointer :: config_disable_vel_surface_stress
- if(config_disable_vel_windstress) windStressOn = .false.
+ call mpas_pool_get_config(ocnConfigs, 'config_disable_vel_surface_stress', config_disable_vel_surface_stress)
- if (config_forcing_type == trim('off')) then
- windStressOn = .false.
- end if
+ surfaceStressOn = .true.
+ if(config_disable_vel_surface_stress) surfaceStressOn = .false.
err = 0
!--------------------------------------------------------------------
- end subroutine ocn_vel_forcing_windstress_init!}}}
+ end subroutine ocn_vel_forcing_surface_stress_init!}}}
!***********************************************************************
-end module ocn_vel_forcing_windstress
+end module ocn_vel_forcing_surface_stress
!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
! vim: foldmethod=marker
diff --git a/src/core_ocean/shared/mpas_ocn_vel_hmix.F b/src/core_ocean/shared/mpas_ocn_vel_hmix.F
index 86d2e6e258..ee8a06b14f 100644
--- a/src/core_ocean/shared/mpas_ocn_vel_hmix.F
+++ b/src/core_ocean/shared/mpas_ocn_vel_hmix.F
@@ -13,8 +13,8 @@
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date September 2011
!> \details
-!> This module contains the main driver routine for computing
-!> horizontal mixing tendencies.
+!> This module contains the main driver routine for computing
+!> horizontal mixing tendencies.
!>
!> It provides an init and a tend function. Each are described below.
!
@@ -25,6 +25,7 @@ module ocn_vel_hmix
use mpas_derived_types
use mpas_pool_routines
use mpas_timer
+ use mpas_threading
use ocn_vel_hmix_del2
use ocn_vel_hmix_leith
use ocn_vel_hmix_del4
@@ -68,7 +69,7 @@ module ocn_vel_hmix
!> \brief Computes tendency term for horizontal momentum mixing
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the horizontal mixing tendency for momentum
!> based on current state and user choices of mixing parameterization.
!> Multiple parameterizations may be chosen and added together. These
@@ -78,8 +79,8 @@ module ocn_vel_hmix
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_hmix_tend(meshPool, divergence, relativeVorticity, normalVelocity, tangentialVelocity, viscosity, &
- tend, scratchPool, err)!{{{
+ subroutine ocn_vel_hmix_tend(meshPool, scratchPool, divergence, relativeVorticity, normalVelocity, tangentialVelocity, &
+ viscosity, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -90,6 +91,8 @@ subroutine ocn_vel_hmix_tend(meshPool, divergence, relativeVorticity, normalVelo
type (mpas_pool_type), intent(in) :: &
meshPool !< Input: mesh information
+ type (mpas_pool_type), intent(inout) :: scratchPool !< Input: scratch variables
+
real (kind=RKIND), dimension(:,:), intent(in) :: &
divergence !< Input: velocity divergence
@@ -114,9 +117,6 @@ subroutine ocn_vel_hmix_tend(meshPool, divergence, relativeVorticity, normalVelo
real (kind=RKIND), dimension(:,:), intent(inout) :: &
tend !< Input/Output: velocity tendency
- type (mpas_pool_type), intent(inout) :: &
- scratchPool !< Input: Scratch structure
-
!-----------------------------------------------------------------
!
! output variables
@@ -136,14 +136,14 @@ subroutine ocn_vel_hmix_tend(meshPool, divergence, relativeVorticity, normalVelo
!-----------------------------------------------------------------
!
! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
+ ! note that the user can choose multiple options and the
! tendencies will be added together
!
!-----------------------------------------------------------------
if(.not.hmixOn) return
- viscosity = 0.0
+ viscosity = 0.0_RKIND
err = 0
call mpas_timer_start("del2")
@@ -162,7 +162,7 @@ subroutine ocn_vel_hmix_tend(meshPool, divergence, relativeVorticity, normalVelo
err = ior(err1, err)
call mpas_timer_start("del4")
- call ocn_vel_hmix_del4_tend(meshPool, divergence, relativeVorticity, tend, err1)
+ call ocn_vel_hmix_del4_tend(meshPool, scratchPool, divergence, relativeVorticity, tend, err1)
call mpas_timer_stop("del4")
err = ior(err1, err)
@@ -182,11 +182,11 @@ end subroutine ocn_vel_hmix_tend!}}}
!> \brief Initializes ocean momentum horizontal mixing quantities
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date September 2011
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity mixing in the ocean. Since a variety of
+!> \details
+!> This routine initializes a variety of quantities related to
+!> horizontal velocity mixing in the ocean. Since a variety of
!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
+!> individual init routines for each parameterization.
!
!-----------------------------------------------------------------------
diff --git a/src/core_ocean/shared/mpas_ocn_vel_hmix_del2.F b/src/core_ocean/shared/mpas_ocn_vel_hmix_del2.F
index 38b9fe317b..4e74f41d1c 100644
--- a/src/core_ocean/shared/mpas_ocn_vel_hmix_del2.F
+++ b/src/core_ocean/shared/mpas_ocn_vel_hmix_del2.F
@@ -9,11 +9,11 @@
!
! ocn_vel_hmix_del2
!
-!> \brief Ocean horizontal mixing - Laplacian parameterization
+!> \brief Ocean horizontal mixing - Laplacian parameterization
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date September 2011
!> \details
-!> This module contains routines for computing horizontal mixing
+!> This module contains routines for computing horizontal mixing
!> tendencies using a Laplacian formulation.
!
!-----------------------------------------------------------------------
@@ -22,6 +22,7 @@ module ocn_vel_hmix_del2
use mpas_derived_types
use mpas_pool_routines
+ use mpas_threading
use mpas_vector_operations
use mpas_matrix_operations
use mpas_tensor_operations
@@ -66,7 +67,7 @@ module ocn_vel_hmix_del2
!> \brief Computes tendency term for Laplacian horizontal momentum mixing
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date 22 August 2011
-!> \details
+!> \details
!> This routine computes the horizontal mixing tendency for momentum
!> based on a Laplacian form for the mixing, \f$\nu_2 \nabla^2 u\f$
!> This tendency takes the
@@ -92,9 +93,9 @@ subroutine ocn_vel_hmix_del2_tend(meshPool, divergence, relativeVorticity, visco
type (mpas_pool_type), intent(in) :: &
meshPool !< Input: mesh information
-
+
!------ -----------------------------------------------------------
- !
+ !
! input /output variables
!
!-----------------------------------------------------------------
@@ -152,19 +153,20 @@ subroutine ocn_vel_hmix_del2_tend(meshPool, divergence, relativeVorticity, visco
call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge)
+ !$omp do schedule(runtime) private(cell1, cell2, vertex1, vertex2, invLength1, invLength2, k, u_diffusion, visc2)
do iEdge = 1, nEdgesSolve
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
vertex1 = verticesOnEdge(1,iEdge)
vertex2 = verticesOnEdge(2,iEdge)
- invLength1 = 1.0 / dcEdge(iEdge)
- invLength2 = 1.0 / dvEdge(iEdge)
+ invLength1 = 1.0_RKIND / dcEdge(iEdge)
+ invLength2 = 1.0_RKIND / dvEdge(iEdge)
do k = 1, maxLevelEdgeTop(iEdge)
! Here -( relativeVorticity(k,vertex2) - relativeVorticity(k,vertex1) ) / dvEdge(iEdge)
- ! is - \nabla relativeVorticity pointing from vertex 2 to vertex 1, or equivalently
+ ! is - \nabla relativeVorticity pointing from vertex 2 to vertex 1, or equivalently
! + k \times \nabla relativeVorticity pointing from cell1 to cell2.
u_diffusion = ( divergence(k,cell2) - divergence(k,cell1) ) * invLength1 &
@@ -178,6 +180,7 @@ subroutine ocn_vel_hmix_del2_tend(meshPool, divergence, relativeVorticity, visco
end do
end do
+ !$omp end do
!--------------------------------------------------------------------
@@ -190,9 +193,9 @@ end subroutine ocn_vel_hmix_del2_tend!}}}
!> \brief Computes tendency term for Laplacian horizontal momentum mixing
!> \author Mark Petersen
!> \date July 2013
-!> \details
+!> \details
!> This routine computes the horizontal mixing tendency for momentum
-!> using tensor operations,
+!> using tensor operations,
!> based on a Laplacian form for the mixing, \f$\nabla\cdot( \nu_2 \nabla(u))\f$
!> where \f$\nu_2\f$ is a viscosity.
!
@@ -259,7 +262,7 @@ subroutine ocn_vel_hmix_del2_tensor_tend(meshPool, normalVelocity, tangentialVel
type (field3DReal), pointer :: strainRateR3CellField, strainRateR3EdgeField, divTensorR3CellField, outerProductEdgeField
logical, pointer :: config_use_mom_del2_tensor
- real (kind=RKIND), pointer :: config_mom_del2_tensor
+ real (kind=RKIND), pointer :: config_mom_del2_tensor
!-----------------------------------------------------------------
!
@@ -295,6 +298,7 @@ subroutine ocn_vel_hmix_del2_tensor_tend(meshPool, normalVelocity, tangentialVel
call mpas_allocate_scratch_field(divTensorR3CellField, .true.)
call mpas_allocate_scratch_field(outerProductEdgeField, .true.)
call mpas_allocate_scratch_field(normalVectorEdgeField, .true.)
+ call mpas_threading_barrier()
strainRateR3Cell => strainRateR3CellField % array
strainRateR3Edge => strainRateR3EdgeField % array
@@ -309,17 +313,19 @@ subroutine ocn_vel_hmix_del2_tensor_tend(meshPool, normalVelocity, tangentialVel
call mpas_matrix_cell_to_edge(strainRateR3Cell, meshPool, .true., strainRateR3Edge)
! The following loop could possibly be reduced to nEdgesSolve
- do iEdge = 1, nEdges
+ !$omp do schedule(runtime) private(visc2, k)
+ do iEdge = 1, nEdges
visc2 = config_mom_del2_tensor * meshScalingDel2(iEdge)
do k = 1, maxLevelEdgeTop(iEdge)
- strainRateR3Edge(:,k,iEdge) = visc2 * strainRateR3Edge(:,k,iEdge)
+ strainRateR3Edge(:,k,iEdge) = visc2 * strainRateR3Edge(:,k,iEdge)
viscosity(k,iEdge) = viscosity(k,iEdge) + visc2
end do
! Impose zero strain rate at land boundaries
do k = maxLevelEdgeTop(iEdge)+1, nVertLevels
- strainRateR3Edge(:,k,iEdge) = 0.0
+ strainRateR3Edge(:,k,iEdge) = 0.0_RKIND
end do
end do
+ !$omp end do
! may change boundaries to false later
call mpas_divergence_of_tensor_R3Cell(strainRateR3Edge, meshPool, edgeSignOnCell, .true., divTensorR3Cell)
@@ -327,12 +333,15 @@ subroutine ocn_vel_hmix_del2_tensor_tend(meshPool, normalVelocity, tangentialVel
call mpas_vector_R3Cell_to_normalVectorEdge(divTensorR3Cell, meshPool, .true., normalVectorEdge)
! The following loop could possibly be reduced to nEdgesSolve
- do iEdge = 1, nEdges
+ !$omp do schedule(runtime) private(k)
+ do iEdge = 1, nEdges
do k = 1, maxLevelEdgeTop(iEdge)
tend(k,iEdge) = tend(k,iEdge) + edgeMask(k, iEdge) * normalVectorEdge(k,iEdge)
end do
end do
+ !$omp end do
+ call mpas_threading_barrier()
call mpas_deallocate_scratch_field(strainRateR3CellField, .true.)
call mpas_deallocate_scratch_field(strainRateR3EdgeField, .true.)
call mpas_deallocate_scratch_field(divTensorR3CellField, .true.)
@@ -350,9 +359,9 @@ end subroutine ocn_vel_hmix_del2_tensor_tend!}}}
!> \brief Initializes ocean momentum Laplacian horizontal mixing
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date September 2011
-!> \details
-!> This routine initializes a variety of quantities related to
-!> Laplacian horizontal momentum mixing in the ocean.
+!> \details
+!> This routine initializes a variety of quantities related to
+!> Laplacian horizontal momentum mixing in the ocean.
!
!-----------------------------------------------------------------------
@@ -377,7 +386,7 @@ subroutine ocn_vel_hmix_del2_init(err)!{{{
hmixDel2On = .false.
- if ( config_mom_del2 > 0.0 ) then
+ if ( config_mom_del2 > 0.0_RKIND ) then
hmixDel2On = .true.
endif
diff --git a/src/core_ocean/shared/mpas_ocn_vel_hmix_del4.F b/src/core_ocean/shared/mpas_ocn_vel_hmix_del4.F
index 88ddb80cef..94fe792280 100644
--- a/src/core_ocean/shared/mpas_ocn_vel_hmix_del4.F
+++ b/src/core_ocean/shared/mpas_ocn_vel_hmix_del4.F
@@ -13,8 +13,8 @@
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date September 2011
!> \details
-!> This module contains routines and variables for computing
-!> horizontal mixing tendencies using a biharmonic formulation.
+!> This module contains routines and variables for computing
+!> horizontal mixing tendencies using a biharmonic formulation.
!
!-----------------------------------------------------------------------
@@ -22,6 +22,7 @@ module ocn_vel_hmix_del4
use mpas_derived_types
use mpas_pool_routines
+ use mpas_threading
use mpas_vector_operations
use mpas_matrix_operations
use mpas_tensor_operations
@@ -66,18 +67,18 @@ module ocn_vel_hmix_del4
!> \brief Computes tendency term for biharmonic horizontal momentum mixing
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the horizontal mixing tendency for momentum
!> based on a biharmonic form for the mixing. This mixing tendency
!> takes the form \f$-\nu_4 \nabla^4 u\f$
-!> but is computed as
+!> but is computed as
!> \f$\nabla^2 u = \nabla divergence + k \times \nabla relativeVorticity\f$
!> applied recursively.
!> This formulation is only valid for constant \f$\nu_4\f$ .
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_hmix_del4_tend(meshPool, divergence, relativeVorticity, tend, err)!{{{
+ subroutine ocn_vel_hmix_del4_tend(meshPool, scratchPool, divergence, relativeVorticity, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -88,6 +89,8 @@ subroutine ocn_vel_hmix_del4_tend(meshPool, divergence, relativeVorticity, tend,
real (kind=RKIND), dimension(:,:), intent(in) :: &
divergence !< Input: velocity divergence
+ type (mpas_pool_type), intent(in) :: scratchPool !< Input: scratch variables
+
real (kind=RKIND), dimension(:,:), intent(in) :: &
relativeVorticity !< Input: relative vorticity
@@ -108,7 +111,7 @@ subroutine ocn_vel_hmix_del4_tend(meshPool, divergence, relativeVorticity, tend,
! output variables
!
!-----------------------------------------------------------------
-
+
integer, intent(out) :: err !< Output: error flag
!-----------------------------------------------------------------
@@ -123,7 +126,8 @@ subroutine ocn_vel_hmix_del4_tend(meshPool, divergence, relativeVorticity, tend,
integer, dimension(:), pointer :: maxLevelEdgeTop, maxLevelVertexTop, &
maxLevelCell, nEdgesOnCell
- integer, dimension(:,:), pointer :: cellsOnEdge, verticesOnEdge, edgeMask, edgesOnVertex, edgesOnCell, edgeSignOnVertex, edgeSignOnCell
+ integer, dimension(:,:), pointer :: cellsOnEdge, verticesOnEdge, edgeMask, edgesOnVertex, edgesOnCell, edgeSignOnVertex, &
+ edgeSignOnCell
real (kind=RKIND) :: u_diffusion, invAreaCell1, invAreaCell2, invAreaTri1, &
@@ -131,16 +135,17 @@ subroutine ocn_vel_hmix_del4_tend(meshPool, divergence, relativeVorticity, tend,
real (kind=RKIND), dimension(:), pointer :: dcEdge, dvEdge, areaTriangle, &
meshScalingDel4, areaCell
- real (kind=RKIND), dimension(:,:), allocatable :: delsq_divergence, &
- delsq_circulation, delsq_relativeVorticity, delsq_u
+ real (kind=RKIND), dimension(:,:), pointer :: delsq_divergence, delsq_relativeVorticity, delsq_u
+ type (field2DReal), pointer :: delsq_uField, delsq_divergenceField, delsq_relativeVorticityField
- real (kind=RKIND), pointer :: config_mom_del4
+ real (kind=RKIND), pointer :: config_mom_del4, config_mom_del4_div_factor
err = 0
if(.not.hmixDel4On) return
call mpas_pool_get_config(ocnConfigs, 'config_mom_del4', config_mom_del4)
+ call mpas_pool_get_config(ocnConfigs, 'config_mom_del4_div_factor', config_mom_del4_div_factor)
call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
@@ -166,77 +171,95 @@ subroutine ocn_vel_hmix_del4_tend(meshPool, divergence, relativeVorticity, tend,
call mpas_pool_get_array(meshPool, 'edgeSignOnVertex', edgeSignOnVertex)
call mpas_pool_get_array(meshPool, 'edgeSignOnCell', edgeSignOnCell)
- allocate(delsq_u(nVertLEvels, nEdges+1))
- allocate(delsq_divergence(nVertLevels, nCells+1))
- allocate(delsq_relativeVorticity(nVertLevels, nVertices+1))
+ call mpas_pool_get_field(scratchPool, 'delsq_u', delsq_uField)
+ call mpas_pool_get_field(scratchPool, 'delsq_divergence', delsq_divergenceField)
+ call mpas_pool_get_field(scratchPool, 'delsq_relativeVorticity', delsq_relativeVorticityField)
+ call mpas_allocate_scratch_field(delsq_uField, .true.)
+ call mpas_allocate_scratch_field(delsq_divergenceField, .true.)
+ call mpas_allocate_scratch_field(delsq_relativeVorticityField, .true.)
+ call mpas_threading_barrier()
- delsq_u(:,:) = 0.0
- delsq_relativeVorticity(:,:) = 0.0
- delsq_divergence(:,:) = 0.0
+ delsq_u => delsq_uField % array
+ delsq_divergence => delsq_divergenceField % array
+ delsq_relativeVorticity => delsq_relativeVorticityField % array
!Compute delsq_u
+ !$omp do schedule(runtime) private(cell1, cell2, vertex1, vertex2, invDcEdge, invDvEdge)
do iEdge = 1, nEdges
+ delsq_u(:, iEdge) = 0.0_RKIND
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
vertex1 = verticesOnEdge(1,iEdge)
vertex2 = verticesOnEdge(2,iEdge)
- invDcEdge = 1.0 / dcEdge(iEdge)
- invDvEdge = 1.0 / dvEdge(iEdge)
+ invDcEdge = 1.0_RKIND / dcEdge(iEdge)
+ invDvEdge = 1.0_RKIND / max(dvEdge(iEdge), 0.25_RKIND*dcEdge(iEdge))
do k=1,maxLevelEdgeTop(iEdge)
! Compute \nabla^2 u = \nabla divergence + k \times \nabla relativeVorticity
delsq_u(k, iEdge) = ( divergence(k,cell2) - divergence(k,cell1) ) * invDcEdge &
- -( relativeVorticity(k,vertex2) - relativeVorticity(k,vertex1)) * invDcEdge * sqrt(3.0)
+ -( relativeVorticity(k,vertex2) - relativeVorticity(k,vertex1)) * invDvEdge
end do
end do
+ !$omp end do
! Compute delsq_relativeVorticity
+ !$omp do schedule(runtime) private(invAreaTri1, i, iEdge, k)
do iVertex = 1, nVertices
- invAreaTri1 = 1.0 / areaTriangle(iVertex)
+ delsq_relativeVorticity(:, iVertex) = 0.0_RKIND
+ invAreaTri1 = 1.0_RKIND / areaTriangle(iVertex)
do i = 1, vertexDegree
iEdge = edgesOnVertex(i, iVertex)
do k = 1, maxLevelVertexTop(iVertex)
- delsq_relativeVorticity(k, iVertex) = delsq_relativeVorticity(k, iVertex) + edgeSignOnVertex(i, iVertex) * dcEdge(iEdge) * delsq_u(k, iEdge) * invAreaTri1
+ delsq_relativeVorticity(k, iVertex) = delsq_relativeVorticity(k, iVertex) + edgeSignOnVertex(i, iVertex) &
+ * dcEdge(iEdge) * delsq_u(k, iEdge) * invAreaTri1
end do
end do
end do
+ !$omp end do
! Compute delsq_divergence
+ !$omp do schedule(runtime) private(invAreaCell1, i, iEdge, k)
do iCell = 1, nCells
- invAreaCell1 = 1.0 / areaCell(iCell)
+ delsq_divergence(:, iCell) = 0.0_RKIND
+ invAreaCell1 = 1.0_RKIND / areaCell(iCell)
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
do k = 1, maxLevelCell(iCell)
- delsq_divergence(k, iCell) = delsq_divergence(k, iCell) - edgeSignOnCell(i, iCell) * dvEdge(iEdge) * delsq_u(k, iEdge) * invAreaCell1
+ delsq_divergence(k, iCell) = delsq_divergence(k, iCell) - edgeSignOnCell(i, iCell) * dvEdge(iEdge) &
+ * delsq_u(k, iEdge) * invAreaCell1
end do
end do
end do
+ !$omp end do
- ! Compute - \kappa \nabla^4 u
+ ! Compute - \kappa \nabla^4 u
! as \nabla div(\nabla^2 u) + k \times \nabla ( k \cross curl(\nabla^2 u) )
+ !$omp do schedule(runtime) private(cell1, cell2, vertex1, vertex2, invDcEdge, invDvEdge, r_tmp, u_diffusion, k)
do iEdge=1,nEdgesSolve
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
vertex1 = verticesOnEdge(1,iEdge)
vertex2 = verticesOnEdge(2,iEdge)
- invDcEdge = 1.0 / dcEdge(iEdge)
- invDvEdge = 1.0 / dvEdge(iEdge)
+ invDcEdge = 1.0_RKIND / dcEdge(iEdge)
+ invDvEdge = 1.0_RKIND / dvEdge(iEdge)
r_tmp = config_mom_del4 * meshScalingDel4(iEdge)
do k=1,maxLevelEdgeTop(iEdge)
- u_diffusion = (delsq_divergence(k,cell2) - delsq_divergence(k,cell1)) * invDcEdge &
- - (delsq_relativeVorticity(k,vertex2) - delsq_relativeVorticity(k,vertex1) ) * invDcEdge * sqrt(3.0)
+ u_diffusion = config_mom_del4_div_factor*(delsq_divergence(k,cell2) - delsq_divergence(k,cell1)) * invDcEdge &
+ - (delsq_relativeVorticity(k,vertex2) - delsq_relativeVorticity(k,vertex1) ) * invDvEdge
tend(k,iEdge) = tend(k,iEdge) - edgeMask(k, iEdge) * u_diffusion * r_tmp
end do
end do
+ !$omp end do
- deallocate(delsq_u)
- deallocate(delsq_divergence)
- deallocate(delsq_relativeVorticity)
+ call mpas_threading_barrier()
+ call mpas_deallocate_scratch_field(delsq_uField, .true.)
+ call mpas_deallocate_scratch_field(delsq_divergenceField, .true.)
+ call mpas_deallocate_scratch_field(delsq_relativeVorticityField, .true.)
!--------------------------------------------------------------------
@@ -249,10 +272,10 @@ end subroutine ocn_vel_hmix_del4_tend!}}}
!> \brief Computes tendency term for Laplacian horizontal momentum mixing
!> \author Mark Petersen
!> \date July 2013
-!> \details
+!> \details
!> This routine computes the horizontal mixing tendency for momentum
-!> using tensor operations,
-!> based on a Laplacian form for the mixing,
+!> using tensor operations,
+!> based on a Laplacian form for the mixing,
!> \f$-\nabla\cdot( \sqrt{\nu_4} \nabla(\nabla\cdot( \sqrt{\nu_4} \nabla(u))))\f$
!> where \f$\nu_4\f$ is the del4 viscosity.
!
@@ -358,6 +381,7 @@ subroutine ocn_vel_hmix_del4_tensor_tend(meshPool, normalVelocity, tangentialVel
call mpas_allocate_scratch_field(outerProductEdgeField, .true.)
call mpas_allocate_scratch_field(normalVectorEdgeField, .true.)
call mpas_allocate_scratch_field(tangentialVectorEdgeField, .true.)
+ call mpas_threading_barrier()
strainRateR3Cell => strainRateR3CellField % array
strainRateR3Edge => strainRateR3EdgeField % array
@@ -375,21 +399,24 @@ subroutine ocn_vel_hmix_del4_tensor_tend(meshPool, normalVelocity, tangentialVel
call mpas_matrix_cell_to_edge(strainRateR3Cell, meshPool, .true., strainRateR3Edge)
! The following loop could possibly be reduced to nEdgesSolve
- do iEdge = 1, nEdges
+ !$omp do schedule(runtime) private(visc4_sqrt, k)
+ do iEdge = 1, nEdges
visc4_sqrt = sqrt(config_mom_del4_tensor * meshScalingDel4(iEdge))
do k = 1, maxLevelEdgeTop(iEdge)
- strainRateR3Edge(:,k,iEdge) = visc4_sqrt * strainRateR3Edge(:,k,iEdge)
+ strainRateR3Edge(:,k,iEdge) = visc4_sqrt * strainRateR3Edge(:,k,iEdge)
end do
! Impose zero strain rate at land boundaries
do k = maxLevelEdgeTop(iEdge)+1, nVertLevels
- strainRateR3Edge(:,k,iEdge) = 0.0
+ strainRateR3Edge(:,k,iEdge) = 0.0_RKIND
end do
end do
+ !$omp end do
! may change boundaries to false later
call mpas_divergence_of_tensor_R3Cell(strainRateR3Edge, meshPool, edgeSignOnCell, .true., divTensorR3Cell)
- call mpas_vector_R3Cell_to_2DEdge(divTensorR3Cell, meshPool, edgeTangentVectors, .true., normalVectorEdge, tangentialVectorEdge)
+ call mpas_vector_R3Cell_to_2DEdge(divTensorR3Cell, meshPool, edgeTangentVectors, .true., normalVectorEdge, &
+ tangentialVectorEdge)
!!!!!!! second div(grad())
@@ -400,17 +427,19 @@ subroutine ocn_vel_hmix_del4_tensor_tend(meshPool, normalVelocity, tangentialVel
call mpas_matrix_cell_to_edge(strainRateR3Cell, meshPool, .true., strainRateR3Edge)
! The following loop could possibly be reduced to nEdgesSolve
- do iEdge = 1, nEdges
+ !$omp do schedule(runtime) private(visc4_sqrt, k)
+ do iEdge = 1, nEdges
visc4_sqrt = sqrt(config_mom_del4_tensor * meshScalingDel4(iEdge))
viscosity(:,iEdge) = viscosity(:,iEdge) + config_mom_del4_tensor * meshScalingDel4(iEdge)
do k = 1, maxLevelEdgeTop(iEdge)
- strainRateR3Edge(:,k,iEdge) = visc4_sqrt * strainRateR3Edge(:,k,iEdge)
+ strainRateR3Edge(:,k,iEdge) = visc4_sqrt * strainRateR3Edge(:,k,iEdge)
end do
! Impose zero strain rate at land boundaries
do k = maxLevelEdgeTop(iEdge)+1, nVertLevels
- strainRateR3Edge(:,k,iEdge) = 0.0
+ strainRateR3Edge(:,k,iEdge) = 0.0_RKIND
end do
end do
+ !$omp end do
! may change boundaries to false later
call mpas_divergence_of_tensor_R3Cell(strainRateR3Edge, meshPool, edgeSignOnCell, .true., divTensorR3Cell)
@@ -418,12 +447,15 @@ subroutine ocn_vel_hmix_del4_tensor_tend(meshPool, normalVelocity, tangentialVel
call mpas_vector_R3Cell_to_normalVectorEdge(divTensorR3Cell, meshPool, .true., normalVectorEdge)
! The following loop could possibly be reduced to nEdgesSolve
+ !$omp do schedule(runtime) private(k)
do iEdge = 1,nEdges
do k = 1,maxLevelEdgeTop(iEdge)
tend(k,iEdge) = tend(k,iEdge) - edgeMask(k, iEdge) * normalVectorEdge(k,iEdge)
end do
end do
+ !$omp end do
+ call mpas_threading_barrier()
call mpas_deallocate_scratch_field(strainRateR3CellField, .true.)
call mpas_deallocate_scratch_field(strainRateR3EdgeField, .true.)
call mpas_deallocate_scratch_field(divTensorR3CellField, .true.)
@@ -442,9 +474,9 @@ end subroutine ocn_vel_hmix_del4_tensor_tend!}}}
!> \brief Initializes ocean momentum biharmonic horizontal mixing
!> \author Mark Petersen, Doug Jacobsen, Todd Ringler
!> \date September 2011
-!> \details
-!> This routine initializes a variety of quantities related to
-!> biharmonic horizontal tracer mixing in the ocean.
+!> \details
+!> This routine initializes a variety of quantities related to
+!> biharmonic horizontal tracer mixing in the ocean.
!
!-----------------------------------------------------------------------
@@ -468,7 +500,7 @@ subroutine ocn_vel_hmix_del4_init(err)!{{{
hmixDel4On = .false.
- if ( config_mom_del4 > 0.0 ) then
+ if ( config_mom_del4 > 0.0_RKIND ) then
hmixDel4On = .true.
endif
diff --git a/src/core_ocean/shared/mpas_ocn_vel_hmix_leith.F b/src/core_ocean/shared/mpas_ocn_vel_hmix_leith.F
index 3ff4ff3af4..a1096dead7 100644
--- a/src/core_ocean/shared/mpas_ocn_vel_hmix_leith.F
+++ b/src/core_ocean/shared/mpas_ocn_vel_hmix_leith.F
@@ -9,11 +9,11 @@
!
! ocn_vel_hmix_leith
!
-!> \brief Ocean horizontal mixing - Leith parameterization
+!> \brief Ocean horizontal mixing - Leith parameterization
!> \author Mark Petersen
!> \date 22 October 2012
!> \details
-!> This module contains routines for computing horizontal mixing
+!> This module contains routines for computing horizontal mixing
!> tendencies using the Leith parameterization.
!
!-----------------------------------------------------------------------
@@ -22,6 +22,7 @@ module ocn_vel_hmix_leith
use mpas_derived_types
use mpas_pool_routines
+ use mpas_constants
use ocn_constants
implicit none
@@ -62,7 +63,7 @@ module ocn_vel_hmix_leith
!> \brief Computes tendency term for horizontal momentum mixing with Leith parameterization
!> \author Mark Petersen, Todd Ringler
!> \date 22 October 2012
-!> \details
+!> \details
!> This routine computes the horizontal mixing tendency for momentum
!> based on the Leith closure. The Leith closure is the
!> enstrophy-cascade analogy to the Smagorinsky (1963) energy-cascade
@@ -70,10 +71,10 @@ module ocn_vel_hmix_leith
!> moving toward the mesh scale. The assumption of an enstrophy cascade
!> and dimensional analysis produces right-hand-side dissipation,
!> $\bf{D}$, of velocity of the form
-!> $ {\bf D} = \nabla \cdot \left( \nu_\ast \nabla {\bf u} \right)
-!> = \nabla \cdot \left( \gamma \left| \nabla \omega \right|
+!> $ {\bf D} = \nabla \cdot \left( \nu_\ast \nabla {\bf u} \right)
+!> = \nabla \cdot \left( \gamma \left| \nabla \omega \right|
!> \left( \Delta x \right)^3 \nabla \bf{u} \right)
-!> where $\omega$ is the relative vorticity and $\gamma$ is a non-dimensional,
+!> where $\omega$ is the relative vorticity and $\gamma$ is a non-dimensional,
!> $O(1)$ parameter. We set $\gamma=1$.
!
@@ -127,7 +128,7 @@ subroutine ocn_vel_hmix_leith_tend(meshPool, divergence, relativeVorticity, visc
integer, dimension(:), pointer :: maxLevelEdgeTop
integer, dimension(:,:), pointer :: cellsOnEdge, verticesOnEdge, edgeMask
- real (kind=RKIND) :: u_diffusion, invLength1, invLength2, visc2
+ real (kind=RKIND) :: u_diffusion, invLength_dc, invLength_dv, visc2
real (kind=RKIND), dimension(:), pointer :: meshScaling, &
dcEdge, dvEdge
@@ -157,29 +158,30 @@ subroutine ocn_vel_hmix_leith_tend(meshPool, divergence, relativeVorticity, visc
call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge)
+ !$omp do schedule(runtime) private(cell1, cell2, vertex1, vertex2, invLength_dc, invLength_dv, k, u_diffusion, visc2)
do iEdge = 1, nEdgesSolve
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
vertex1 = verticesOnEdge(1,iEdge)
vertex2 = verticesOnEdge(2,iEdge)
- invLength1 = 1.0 / dcEdge(iEdge)
- invLength2 = 1.0 / dvEdge(iEdge)
+ invLength_dc = 1.0_RKIND / dcEdge(iEdge)
+ invLength_dv = 1.0_RKIND / dvEdge(iEdge)
do k = 1, maxLevelEdgeTop(iEdge)
! Here -( relativeVorticity(k,vertex2) - relativeVorticity(k,vertex1) ) / dvEdge(iEdge)
- ! is - \nabla relativeVorticity pointing from vertex 2 to vertex 1, or equivalently
+ ! is - \nabla relativeVorticity pointing from vertex 2 to vertex 1, or equivalently
! + k \times \nabla relativeVorticity pointing from cell1 to cell2.
- u_diffusion = ( divergence(k,cell2) - divergence(k,cell1) ) * invLength1 &
- -( relativeVorticity(k,vertex2) - relativeVorticity(k,vertex1) ) * invLength2
+ u_diffusion = ( divergence(k,cell2) - divergence(k,cell1) ) * invLength_dc &
+ -( relativeVorticity(k,vertex2) - relativeVorticity(k,vertex1) ) * invLength_dv
! Here the first line is (\delta x)^3
! the second line is |\nabla \omega|
! and u_diffusion is \nabla^2 u (see formula for $\bf{D}$ above).
- visc2 = ( config_leith_parameter * config_leith_dx * meshScaling(iEdge) / 3.14)**3 &
- * abs( relativeVorticity(k,vertex2) - relativeVorticity(k,vertex1) ) * invLength1 * sqrt(3.0)
+ visc2 = ( config_leith_parameter * config_leith_dx * meshScaling(iEdge) / pii)**3 &
+ * abs( relativeVorticity(k,vertex2) - relativeVorticity(k,vertex1) ) * invLength_dc * sqrt(3.0_RKIND)
visc2 = min(visc2, config_leith_visc2_max)
tend(k,iEdge) = tend(k,iEdge) + edgeMask(k, iEdge) * visc2 * u_diffusion
@@ -188,6 +190,7 @@ subroutine ocn_vel_hmix_leith_tend(meshPool, divergence, relativeVorticity, visc
end do
end do
+ !$omp end do
!--------------------------------------------------------------------
@@ -200,9 +203,9 @@ end subroutine ocn_vel_hmix_leith_tend!}}}
!> \brief Initializes ocean momentum horizontal mixing with Leith parameterization
!> \author Mark Petersen
!> \date 22 October 2012
-!> \details
-!> This routine initializes a variety of quantities related to
-!> Leith parameterization for horizontal momentum mixing in the ocean.
+!> \details
+!> This routine initializes a variety of quantities related to
+!> Leith parameterization for horizontal momentum mixing in the ocean.
!
!-----------------------------------------------------------------------
diff --git a/src/core_ocean/shared/mpas_ocn_vel_pressure_grad.F b/src/core_ocean/shared/mpas_ocn_vel_pressure_grad.F
index bf3fa1c19d..43fc43763c 100644
--- a/src/core_ocean/shared/mpas_ocn_vel_pressure_grad.F
+++ b/src/core_ocean/shared/mpas_ocn_vel_pressure_grad.F
@@ -13,7 +13,7 @@
!> \author Mark Petersen
!> \date September 2011
!> \details
-!> This module contains the routine for computing
+!> This module contains the routine for computing
!> tendencie from the horizontal pressure gradient.
!>
!
@@ -70,7 +70,7 @@ module ocn_vel_pressure_grad
!> \brief Computes tendency term for horizontal pressure gradient
!> \author Mark Petersen
!> \date February 2014
-!> \details
+!> \details
!> This routine computes the pressure gradient tendency for momentum
!> based on current state.
!
@@ -95,7 +95,7 @@ subroutine ocn_vel_pressure_grad_tend(meshPool, pressure, montgomeryPotential, z
potentialDensity !< Input: potentialDensity
real (kind=RKIND), dimension(:,:), intent(in), optional :: &
- inSituThermalExpansionCoeff, &
+ inSituThermalExpansionCoeff, &
inSituSalineContractionCoeff
real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers
@@ -154,33 +154,37 @@ subroutine ocn_vel_pressure_grad_tend(meshPool, pressure, montgomeryPotential, z
! pressure for generalized coordinates
! -1/density_0 (grad p_k + density g grad z_k^{mid})
+ !$omp do schedule(runtime) private(cell1, cell2, invdcEdge, k)
do iEdge=1,nEdgesSolve
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
- invdcEdge = 1.0 / dcEdge(iEdge)
+ invdcEdge = 1.0_RKIND / dcEdge(iEdge)
do k=1,maxLevelEdgeTop(iEdge)
tend(k,iEdge) = tend(k,iEdge) + edgeMask(k,iEdge) * invdcEdge * ( &
- density0Inv * ( pressure(k,cell2) - pressure(k,cell1) ) &
- - gdensity0Inv * 0.5*(density(k,cell1)+density(k,cell2)) * ( zMid(k,cell2) - zMid(k,cell1) ) )
+ - gdensity0Inv * 0.5_RKIND*(density(k,cell1)+density(k,cell2)) * ( zMid(k,cell2) - zMid(k,cell1) ) )
end do
end do
+ !$omp end do
elseif (config_pressure_gradient_type.eq.'MontgomeryPotential') then
- ! For pure isopycnal coordinates, this is just grad(M),
+ ! For pure isopycnal coordinates, this is just grad(M),
! the gradient of Montgomery Potential
+ !$omp do schedule(runtime) private(cell1, cell2, invdcEdge, k)
do iEdge=1,nEdgesSolve
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
- invdcEdge = 1.0 / dcEdge(iEdge)
+ invdcEdge = 1.0_RKIND / dcEdge(iEdge)
do k=1,maxLevelEdgeTop(iEdge)
tend(k,iEdge) = tend(k,iEdge) + edgeMask(k,iEdge) * invdcEdge * ( &
- ( montgomeryPotential(k,cell2) - montgomeryPotential(k,cell1) ) )
end do
end do
+ !$omp end do
elseif (config_pressure_gradient_type.eq.'MontgomeryPotential_and_density') then
@@ -190,26 +194,30 @@ subroutine ocn_vel_pressure_grad_tend(meshPool, pressure, montgomeryPotential, z
! Where rho is the potential density.
! See Bleck (2002) equation 1, and last equation in Appendix A.
+ !$omp do schedule(runtime) private(cell1, cell2, invdcEdge, k)
do iEdge=1,nEdgesSolve
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
- invdcEdge = 1.0 / dcEdge(iEdge)
+ invdcEdge = 1.0_RKIND / dcEdge(iEdge)
do k=1,maxLevelEdgeTop(iEdge)
tend(k,iEdge) = tend(k,iEdge) + edgeMask(k,iEdge) * invdcEdge * ( &
- ( montgomeryPotential(k,cell2) - montgomeryPotential(k,cell1) ) &
- + 0.5*(pressure(k,cell1)+pressure(k,cell2)) * ( 1.0/potentialDensity(k,cell2) - 1.0/potentialDensity(k,cell1) ) )
+ + 0.5_RKIND*(pressure(k,cell1)+pressure(k,cell2)) * ( 1.0_RKIND/potentialDensity(k,cell2) &
+ - 1.0_RKIND/potentialDensity(k,cell1) ) )
end do
end do
+ !$omp end do
elseif (config_pressure_gradient_type.eq.'Jacobian_from_density') then
allocate(JacobianDxDs(nVertLevels))
+ !$omp do schedule(runtime) private(cell1, cell2, invdcEdge, k, pGrad)
do iEdge=1,nEdgesSolve
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
- invdcEdge = 1.0 / dcEdge(iEdge)
+ invdcEdge = 1.0_RKIND / dcEdge(iEdge)
call pGrad_Jacobian_common_level(density(:,cell1),density(:,cell2),zMid(:,cell1),zMid(:,cell2), &
maxLevelEdgeTop(iEdge), config_common_level_weight, JacobianDxDs)
@@ -219,7 +227,7 @@ subroutine ocn_vel_pressure_grad_tend(meshPool, pressure, montgomeryPotential, z
k = 1
pGrad = edgeMask(k,iEdge) * invdcEdge * ( &
- density0Inv * ( pressure(k,cell2) - pressure(k,cell1) ) &
- - gdensity0Inv * 0.5*(density(k,cell1)+density(k,cell2)) * ( zMid(k,cell2) - zMid(k,cell1) ) )
+ - gdensity0Inv * 0.5_RKIND*(density(k,cell1)+density(k,cell2)) * ( zMid(k,cell2) - zMid(k,cell1) ) )
tend(k,iEdge) = tend(k,iEdge) + pGrad
@@ -234,17 +242,20 @@ subroutine ocn_vel_pressure_grad_tend(meshPool, pressure, montgomeryPotential, z
end do
end do
+ !$omp end do
deallocate(JacobianDxDs)
elseif (config_pressure_gradient_type.eq.'Jacobian_from_TS') then
- allocate(JacobianDxDs(nVertLevels),JacobianTz(nVertLevels),JacobianSz(nVertLevels), T1(nVertLevels), T2(nVertLevels), S1(nVertLevels), S2(nVertLevels))
+ allocate(JacobianDxDs(nVertLevels),JacobianTz(nVertLevels),JacobianSz(nVertLevels), T1(nVertLevels))
+ allocate(T2(nVertLevels), S1(nVertLevels), S2(nVertLevels))
+ !$omp do schedule(runtime) private(cell1, cell2, invdcEdge, kMax, k, pGrad, alpha, beta)
do iEdge=1,nEdgesSolve
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
- invdcEdge = 1.0 / dcEdge(iEdge)
+ invdcEdge = 1.0_RKIND / dcEdge(iEdge)
kMax = maxLevelEdgeTop(iEdge)
! copy T and S to local column arrays
@@ -262,7 +273,7 @@ subroutine ocn_vel_pressure_grad_tend(meshPool, pressure, montgomeryPotential, z
k = 1
pGrad = edgeMask(k,iEdge) * invdcEdge * ( &
- density0Inv * ( pressure(k,cell2) - pressure(k,cell1) ) &
- - gdensity0Inv * 0.5*(density(k,cell1)+density(k,cell2)) * ( zMid(k,cell2) - zMid(k,cell1) ) )
+ - gdensity0Inv * 0.5_RKIND*(density(k,cell1)+density(k,cell2)) * ( zMid(k,cell2) - zMid(k,cell1) ) )
tend(k,iEdge) = tend(k,iEdge) + pGrad
@@ -271,10 +282,14 @@ subroutine ocn_vel_pressure_grad_tend(meshPool, pressure, montgomeryPotential, z
! Average alpha and beta over four data points of the Jacobian cell.
! Note that inSituThermalExpansionCoeff and inSituSalineContractionCoeff include a 1/density factor,
! so must multiply by density here.
- alpha = 0.25*( density(k,cell1)*inSituThermalExpansionCoeff (k,cell1) + density(k-1,cell1)*inSituThermalExpansionCoeff (k-1,cell1) &
- + density(k,cell2)*inSituThermalExpansionCoeff (k,cell2) + density(k-1,cell2)*inSituThermalExpansionCoeff (k-1,cell2) )
- beta = 0.25*( density(k,cell1)*inSituSalineContractionCoeff(k,cell1) + density(k-1,cell1)*inSituSalineContractionCoeff(k-1,cell1) &
- + density(k,cell2)*inSituSalineContractionCoeff(k,cell2) + density(k-1,cell2)*inSituSalineContractionCoeff(k-1,cell2) )
+ alpha = 0.25_RKIND*( density(k,cell1)*inSituThermalExpansionCoeff (k,cell1) &
+ + density(k-1,cell1)*inSituThermalExpansionCoeff (k-1,cell1) &
+ + density(k,cell2)*inSituThermalExpansionCoeff (k,cell2) &
+ + density(k-1,cell2)*inSituThermalExpansionCoeff (k-1,cell2) )
+ beta = 0.25_RKIND*( density(k,cell1)*inSituSalineContractionCoeff(k,cell1) &
+ + density(k-1,cell1)*inSituSalineContractionCoeff(k-1,cell1) &
+ + density(k,cell2)*inSituSalineContractionCoeff(k,cell2) &
+ + density(k-1,cell2)*inSituSalineContractionCoeff(k-1,cell2) )
! Shchepetkin and McWilliams (2003) (7.16)
JacobianDxDs(k) = -alpha*JacobianTz(k) + beta*JacobianSz(k)
@@ -288,6 +303,7 @@ subroutine ocn_vel_pressure_grad_tend(meshPool, pressure, montgomeryPotential, z
end do
end do
+ !$omp end do
deallocate(JacobianDxDs,JacobianTz,JacobianSz, T1, T2, S1, S2)
@@ -310,7 +326,7 @@ end subroutine ocn_vel_pressure_grad_tend!}}}
!> \brief Computes density-Jacobian
!> \author Mark Petersen
!> \date February 2014
-!> \details
+!> \details
!> This routine computes the density-Jacobian in common_level form.
!> See Shchepetkin and McWilliams (2003) Ocean Modeling, sections 2-4
!
@@ -325,10 +341,10 @@ subroutine pGrad_Jacobian_common_level(rho1,rho2,z1,z2,kMax,gamma,JacobianDxDs)
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:), intent(in) :: &
- rho1, & ! density of column 1
+ rho1, & ! density of column 1
rho2, & ! density of column 2
- z1, & ! z-coordinate at middle of cell, column 1
- z2 ! z-coordinate at middle of cell, column 2
+ z1, & ! z-coordinate at middle of cell, column 1
+ z2 ! z-coordinate at middle of cell, column 2
real (kind=RKIND), intent(in) :: &
gamma ! weight between zStar (original Jacobian) and z_C (weighted Jacobian)
@@ -360,23 +376,23 @@ subroutine pGrad_Jacobian_common_level(rho1,rho2,z1,z2,kMax,gamma,JacobianDxDs)
integer :: k
real (kind=RKIND) :: Area, zStar, rhoL, rhoR, zC, zGamma
- JacobianDxDs = 0.0
+ JacobianDxDs = 0.0_RKIND
do k=2,kMax
! eqn 2.7 in Shchepetkin and McWilliams (2003)
! Note delta x was removed. It must be an error in the paper,
! as it makes the units incorrect.
- Area = 0.5*(z1(k-1) - z1(k) + z2(k-1) - z2(k) )
+ Area = 0.5_RKIND*(z1(k-1) - z1(k) + z2(k-1) - z2(k) )
! eqn 2.8
zStar = ( z2(k-1)*z1(k-1) - z2(k)*z1(k) )/(z2(k-1)-z2(k) + z1(k-1)-z1(k))
! eqn 3.2
- zC = 0.25*( z1(k) + z1(k-1) + z2(k) + z2(k-1) )
+ zC = 0.25_RKIND*( z1(k) + z1(k-1) + z2(k) + z2(k-1) )
! eqn 4.1
- zGamma = (1.0 - gamma)*zStar + gamma*zC
+ zGamma = (1.0_RKIND - gamma)*zStar + gamma*zC
rhoL = (rho1(k)*(z1(k-1)-zGamma) + rho1(k-1)*(zGamma-z1(k)))/(z1(k-1) - z1(k))
rhoR = (rho2(k)*(z2(k-1)-zGamma) + rho2(k-1)*(zGamma-z2(k)))/(z2(k-1) - z2(k))
@@ -394,7 +410,7 @@ end subroutine pGrad_Jacobian_common_level
!> \brief Computes density-Jacobian
!> \author Mark Petersen
!> \date February 2014
-!> \details
+!> \details
!> This routine computes the density-Jacobian in POM/SCRUM form.
!> See Shchepetkin and McWilliams (2003) Ocean Modeling, section 2.
!
@@ -409,10 +425,10 @@ subroutine pGrad_Jacobian_POM_SCRUM(rho1,rho2,z1,z2,kMax,JacobianDxDs)
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:), intent(in) :: &
- rho1, & ! density of column 1
+ rho1, & ! density of column 1
rho2, & ! density of column 2
- z1, & ! z-coordinate at middle of cell, column 1
- z2 ! z-coordinate at middle of cell, column 2
+ z1, & ! z-coordinate at middle of cell, column 1
+ z2 ! z-coordinate at middle of cell, column 2
integer, intent(in) :: &
kMax ! maximum level
@@ -440,13 +456,13 @@ subroutine pGrad_Jacobian_POM_SCRUM(rho1,rho2,z1,z2,kMax,JacobianDxDs)
integer :: k
- JacobianDxDs = 0.0
+ JacobianDxDs = 0.0_RKIND
do k=2,kMax
! eqn 2.3 in Shchepetkin and McWilliams (2003)
- JacobianDxDs(k) = 0.25*(&
- (rho1(k) + rho1(k-1) - rho2(k) - rho2(k-1) )*(z1(k-1) - z1(k) + z2(k-1) - z2(k) ) &
+ JacobianDxDs(k) = 0.25_RKIND*(&
+ (rho1(k) + rho1(k-1) - rho2(k) - rho2(k-1) )*(z1(k-1) - z1(k) + z2(k-1) - z2(k) ) &
- (rho1(k-1) - rho1(k) + rho2(k-1) - rho2(k) )*(z1(k) + z1(k-1) - z2(k) - z2(k-1) ) )
end do
@@ -459,7 +475,7 @@ end subroutine pGrad_Jacobian_POM_SCRUM
!> \brief Computes density-Jacobian
!> \author Mark Petersen
!> \date February 2014
-!> \details
+!> \details
!> This routine computes the density-Jacobian in diagonal form.
!> See Shchepetkin and McWilliams (2003) Ocean Modeling, section 2.
!
@@ -474,10 +490,10 @@ subroutine pGrad_Jacobian_diagonal(rho1,rho2,z1,z2,kMax,JacobianDxDs)
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:), intent(in) :: &
- rho1, & ! density of column 1
+ rho1, & ! density of column 1
rho2, & ! density of column 2
- z1, & ! z-coordinate at middle of cell, column 1
- z2 ! z-coordinate at middle of cell, column 2
+ z1, & ! z-coordinate at middle of cell, column 1
+ z2 ! z-coordinate at middle of cell, column 2
integer, intent(in) :: &
kMax
@@ -505,13 +521,13 @@ subroutine pGrad_Jacobian_diagonal(rho1,rho2,z1,z2,kMax,JacobianDxDs)
integer :: k
- JacobianDxDs = 0.0
+ JacobianDxDs = 0.0_RKIND
do k=2,kMax
! eqn 2.5 in Shchepetkin and McWilliams (2003)
- JacobianDxDs(k) = 0.5*( &
- (rho1(k-1) - rho2(k))*(z2(k-1) - z1(k) ) &
+ JacobianDxDs(k) = 0.5_RKIND*( &
+ (rho1(k-1) - rho2(k))*(z2(k-1) - z1(k) ) &
+ (rho1(k) - rho2(k-1))*(z1(k-1) - z2(k)) )
end do
@@ -524,7 +540,7 @@ end subroutine pGrad_Jacobian_diagonal
!> \brief Computes density-Jacobian
!> \author Mark Petersen
!> \date February 2014
-!> \details
+!> \details
!> This routine computes the density-Jacobian in pseudo_flux form.
!> See Shchepetkin and McWilliams (2003) Ocean Modeling, section 2.
!
@@ -539,10 +555,10 @@ subroutine pGrad_Jacobian_pseudo_flux(rho1,rho2,z1,z2,kMax,JacobianDxDs)
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:), intent(in) :: &
- rho1, & ! density of column 1
+ rho1, & ! density of column 1
rho2, & ! density of column 2
- z1, & ! z-coordinate at middle of cell, column 1
- z2 ! z-coordinate at middle of cell, column 2
+ z1, & ! z-coordinate at middle of cell, column 1
+ z2 ! z-coordinate at middle of cell, column 2
integer, intent(in) :: &
kMax
@@ -569,19 +585,19 @@ subroutine pGrad_Jacobian_pseudo_flux(rho1,rho2,z1,z2,kMax,JacobianDxDs)
!-----------------------------------------------------------------
integer :: k
- real (kind=RKIND) :: FLeft, FTop, FRight, FBottom
+ real (kind=RKIND) :: FLeft, FTop, FRight, FBottom
- JacobianDxDs = 0.0
+ JacobianDxDs = 0.0_RKIND
do k=2,kMax
- FLeft = 0.5*( rho1(k) + rho1(k-1) ) * (z1(k-1) - z1(k))
- FTop = 0.5*( rho1(k-1) + rho2(k-1) ) * (z2(k-1) - z1(k-1))
- FRight = 0.5*( rho2(k) + rho2(k-1) ) * (z2(k-1) - z2(k))
- FBottom = 0.5*( rho1(k) + rho2(k) ) * (z2(k) - z1(k))
+ FLeft = 0.5_RKIND*( rho1(k) + rho1(k-1) ) * (z1(k-1) - z1(k))
+ FTop = 0.5_RKIND*( rho1(k-1) + rho2(k-1) ) * (z2(k-1) - z1(k-1))
+ FRight = 0.5_RKIND*( rho2(k) + rho2(k-1) ) * (z2(k-1) - z2(k))
+ FBottom = 0.5_RKIND*( rho1(k) + rho2(k) ) * (z2(k) - z1(k))
! eqn 2.11 in Shchepetkin and McWilliams (2003)
- JacobianDxDs(k) = FLeft + FTop - FRight - FBottom
+ JacobianDxDs(k) = FLeft + FTop - FRight - FBottom
end do
end subroutine pGrad_Jacobian_pseudo_flux
@@ -593,7 +609,7 @@ end subroutine pGrad_Jacobian_pseudo_flux
!> \brief Initializes ocean momentum horizontal pressure gradient
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> This routine initializes parameters required for the computation of the
!> horizontal pressure gradient.
!
@@ -618,21 +634,19 @@ subroutine ocn_vel_pressure_grad_init(err)!{{{
! call individual init routines for each parameterization
!
!-----------------------------------------------------------------
- real (kind=RKIND), pointer :: config_density0
logical, pointer :: config_disable_vel_pgrad
err = 0
call mpas_pool_get_config(ocnConfigs, 'config_pressure_gradient_type', config_pressure_gradient_type)
call mpas_pool_get_config(ocnConfigs, 'config_common_level_weight', config_common_level_weight)
- call mpas_pool_get_config(ocnConfigs, 'config_density0', config_density0)
call mpas_pool_get_config(ocnConfigs, 'config_disable_vel_pgrad', config_disable_vel_pgrad)
pgradOn = .true.
- density0Inv = 1.0/config_density0
- gdensity0Inv = gravity/config_density0
- inv12 = 1.0/12.0
+ density0Inv = 1.0_RKIND / rho_sw
+ gdensity0Inv = gravity / rho_sw
+ inv12 = 1.0_RKIND / 12.0_RKIND
if (config_disable_vel_pgrad) pgradOn = .false.
diff --git a/src/core_ocean/shared/mpas_ocn_vel_vadv.F b/src/core_ocean/shared/mpas_ocn_vel_vadv.F
index b39ead11b0..2bf063cd04 100644
--- a/src/core_ocean/shared/mpas_ocn_vel_vadv.F
+++ b/src/core_ocean/shared/mpas_ocn_vel_vadv.F
@@ -9,11 +9,11 @@
!
! ocn_vel_vadv
!
-!> \brief MPAS ocean vertical advection
+!> \brief MPAS ocean vertical advection
!> \author Mark Petersen
!> \date September 2011
!> \details
-!> This module contains the routine for computing
+!> This module contains the routine for computing
!> tendencies for vertical advection.
!>
!
@@ -64,7 +64,7 @@ module ocn_vel_vadv
!> \brief Computes tendency term for vertical advection
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the vertical advection tendency for momentum
!> based on current state.
!
@@ -129,26 +129,30 @@ subroutine ocn_vel_vadv_tend(meshPool, normalVelocity, layerThicknessEdge, vertA
call mpas_pool_get_array(meshPool, 'edgeMask', edgeMask)
allocate(w_dudzTopEdge(nVertLevels+1))
- w_dudzTopEdge = 0.0
+ w_dudzTopEdge = 0.0_RKIND
+
+ !$omp do schedule(runtime) private(cell1, cell2, k, vertAleTransportTopEdge)
do iEdge = 1, nEdgesSolve
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
do k = 2, maxLevelEdgeTop(iEdge)
! Average w from cell center to edge
- vertAleTransportTopEdge = 0.5*(vertAleTransportTop(k,cell1) + vertAleTransportTop(k,cell2))
+ vertAleTransportTopEdge = 0.5_RKIND*(vertAleTransportTop(k,cell1) + vertAleTransportTop(k,cell2))
! compute dudz at vertical interface with first order derivative.
w_dudzTopEdge(k) = vertAleTransportTopEdge * (normalVelocity(k-1,iEdge)-normalVelocity(k,iEdge)) &
- / (0.5*(layerThicknessEdge(k-1,iEdge) + layerThicknessEdge(k,iEdge)))
+ / (0.5_RKIND*(layerThicknessEdge(k-1,iEdge) + layerThicknessEdge(k,iEdge)))
end do
- w_dudzTopEdge(maxLevelEdgeTop(iEdge)+1) = 0.0
+ w_dudzTopEdge(maxLevelEdgeTop(iEdge)+1) = 0.0_RKIND
! Average w*du/dz from vertical interface to vertical middle of cell
do k = 1, maxLevelEdgeTop(iEdge)
tend(k,iEdge) = tend(k,iEdge) - edgeMask(k, iEdge) * 0.5 * (w_dudzTopEdge(k) + w_dudzTopEdge(k+1))
enddo
enddo
+ !$omp end do
+
deallocate(w_dudzTopEdge)
!--------------------------------------------------------------------
@@ -162,9 +166,9 @@ end subroutine ocn_vel_vadv_tend!}}}
!> \brief Initializes ocean momentum vertical advection
!> \author Mark Petersen
!> \date September 2011
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical velocity advection in the ocean.
+!> \details
+!> This routine initializes a variety of quantities related to
+!> vertical velocity advection in the ocean.
!
!-----------------------------------------------------------------------
diff --git a/src/core_ocean/shared/mpas_ocn_vmix.F b/src/core_ocean/shared/mpas_ocn_vmix.F
index 710ed6fc1e..5b01b6b82d 100644
--- a/src/core_ocean/shared/mpas_ocn_vmix.F
+++ b/src/core_ocean/shared/mpas_ocn_vmix.F
@@ -13,8 +13,8 @@
!> \author Mark Petersen
!> \date September 2011
!> \details
-!> This module is the main driver for
-!> vertical mixing in the ocean.
+!> This module is the main driver for
+!> vertical mixing in the ocean.
!>
!
!-----------------------------------------------------------------------
@@ -56,7 +56,7 @@ module ocn_vmix
ocn_vel_vmix_tend_implicit, &
ocn_tracer_vmix_tend_implicit, &
ocn_vmix_init, &
- ocn_vmix_implicit
+ ocn_vmix_implicit
!--------------------------------------------------------------------
!
@@ -77,13 +77,13 @@ module ocn_vmix
!> \brief Computes coefficients for vertical mixing
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the vertical mixing coefficients for momentum
!> and tracers based user choices of mixing parameterization.
!
!-----------------------------------------------------------------------
- subroutine ocn_vmix_coefs(meshPool, statePool, diagnosticsPool, err, timeLevelIn)!{{{
+ subroutine ocn_vmix_coefs(meshPool, statePool, forcingPool, diagnosticsPool, scratchPool, err, timeLevelIn)!{{{
!-----------------------------------------------------------------
!
@@ -93,7 +93,9 @@ subroutine ocn_vmix_coefs(meshPool, statePool, diagnosticsPool, err, timeLevelIn
type (mpas_pool_type), intent(in) :: &
meshPool !< Input: mesh information
-
+
+ type (mpas_pool_type), intent(in) :: scratchPool !< Input/Output: Scratch structure
+
integer, intent(in), optional :: timeLevelIn !< Input: Time level for state pool
!-----------------------------------------------------------------
@@ -105,6 +107,9 @@ subroutine ocn_vmix_coefs(meshPool, statePool, diagnosticsPool, err, timeLevelIn
type (mpas_pool_type), intent(inout) :: &
statePool !< Input/Output: state information
+ type (mpas_pool_type), intent(inout) :: &
+ forcingPool !< Input/Output: forcing information
+
type (mpas_pool_type), intent(inout) :: &
diagnosticsPool !< Input/Output: diagnostic information
@@ -125,6 +130,9 @@ subroutine ocn_vmix_coefs(meshPool, statePool, diagnosticsPool, err, timeLevelIn
integer :: err1, err2, err3, err4, err5
integer :: timeLevel
+ integer :: iEdge, iCell
+ integer, pointer :: nEdges, nCells
+
real (kind=RKIND), dimension(:,:), pointer :: vertViscTopOfEdge, vertDiffTopOfCell
!-----------------------------------------------------------------
@@ -141,16 +149,43 @@ subroutine ocn_vmix_coefs(meshPool, statePool, diagnosticsPool, err, timeLevelIn
timeLevel = 1
end if
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+
call mpas_pool_get_array(diagnosticsPool, 'vertViscTopOfEdge', vertViscTopOfEdge)
call mpas_pool_get_array(diagnosticsPool, 'vertDiffTopOfCell', vertDiffTopOfCell)
- vertViscTopOfEdge = 0.0_RKIND
- vertDiffTopOfCell = 0.0_RKIND
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ vertViscTopOfEdge(:, iEdge) = 0.0_RKIND
+ end do
+ !$omp end do
+
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ vertDiffTopOfCell(:, iCell) = 0.0_RKIND
+ end do
+ !$omp end do
+
+ call mpas_timer_start('coef const build', .false.)
call ocn_vmix_coefs_const_build(meshPool, statePool, diagnosticsPool, err1, timeLevel)
+ call mpas_timer_stop('coef const build')
+
+ call mpas_timer_start('coef tanh build', .false.)
call ocn_vmix_coefs_tanh_build(meshPool, statePool, diagnosticsPool, err2, timeLevel)
- call ocn_vmix_coefs_rich_build(meshPool, statePool, diagnosticsPool, err3, timeLevel)
- call ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err4, timeLevel)
+ call mpas_timer_stop('coef tanh build')
+
+ call mpas_timer_start('coef rich build', .false.)
+ call ocn_vmix_coefs_rich_build(meshPool, statePool, diagnosticsPool, scratchPool, err3, timeLevel)
+ call mpas_timer_stop('coef rich build')
+
+ call mpas_timer_start('coef cvmix build', .false.)
+ call ocn_vmix_coefs_cvmix_build(meshPool, statePool, forcingPool, diagnosticsPool, err4, timeLevel)
+ call mpas_timer_stop('coef cvmix build')
+
+ call mpas_timer_start('coef redi build', .false.)
call ocn_vmix_coefs_redi_build(meshPool, statePool, diagnosticsPool, err5, timeLevel)
+ call mpas_timer_stop('coef redi build')
err = ior(ior(ior(err1, ior(err2, err3)), err4), err5)
@@ -165,13 +200,14 @@ end subroutine ocn_vmix_coefs!}}}
!> \brief Computes tendencies for implicit momentum vertical mixing
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the tendencies for implicit vertical mixing for momentum
!> using computed coefficients.
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_vmix_tend_implicit(meshPool, dt, kineticEnergyCell, vertViscTopOfEdge, layerThickness, layerThicknessEdge, normalVelocity, err)!{{{
+ subroutine ocn_vel_vmix_tend_implicit(meshPool, dt, kineticEnergyCell, vertViscTopOfEdge, layerThickness, & !{{{
+ layerThicknessEdge, normalVelocity, err)
!-----------------------------------------------------------------
!
@@ -243,9 +279,10 @@ subroutine ocn_vel_vmix_tend_implicit(meshPool, dt, kineticEnergyCell, vertViscT
call mpas_pool_get_array(meshPool, 'maxLevelEdgeTop', maxLevelEdgeTop)
call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
- allocate(A(nVertLevels),B(nVertLevels),C(nVertLevels),velTemp(nVertLevels))
+ allocate(A(nVertLevels),B(nVertLevels),C(nVertLevels),velTemp(nVertLevels))
A(1)=0
+ !$omp do schedule(runtime) private(N, cell1, cell2, k)
do iEdge = 1, nEdges
N = maxLevelEdgeTop(iEdge)
if (N .gt. 0) then
@@ -256,19 +293,19 @@ subroutine ocn_vel_vmix_tend_implicit(meshPool, dt, kineticEnergyCell, vertViscT
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
do k = 1, N
- layerThicknessEdge(k,iEdge) = 0.5 * (layerThickness(k,cell1) + layerThickness(k,cell2))
+ layerThicknessEdge(k,iEdge) = 0.5_RKIND * (layerThickness(k,cell1) + layerThickness(k,cell2))
end do
! A is lower diagonal term
do k = 2, N
- A(k) = -2.0*dt*vertViscTopOfEdge(k,iEdge) &
+ A(k) = -2.0_RKIND*dt*vertViscTopOfEdge(k,iEdge) &
/ (layerThicknessEdge(k-1,iEdge) + layerThicknessEdge(k,iEdge)) &
/ layerThicknessEdge(k,iEdge)
enddo
! C is upper diagonal term
do k = 1, N-1
- C(k) = -2.0*dt*vertViscTopOfEdge(k+1,iEdge) &
+ C(k) = -2.0_RKIND*dt*vertViscTopOfEdge(k+1,iEdge) &
/ (layerThicknessEdge(k,iEdge) + layerThicknessEdge(k+1,iEdge)) &
/ layerThicknessEdge(k,iEdge)
enddo
@@ -287,10 +324,11 @@ subroutine ocn_vel_vmix_tend_implicit(meshPool, dt, kineticEnergyCell, vertViscT
call tridiagonal_solve(A(2:N),B,C(1:N-1),normalVelocity(:,iEdge),velTemp,N)
normalVelocity(1:N,iEdge) = velTemp(1:N)
- normalVelocity(N+1:nVertLevels,iEdge) = 0.0
+ normalVelocity(N+1:nVertLevels,iEdge) = 0.0_RKIND
end if
end do
+ !$omp end do
deallocate(A,B,C,velTemp)
@@ -305,7 +343,7 @@ end subroutine ocn_vel_vmix_tend_implicit!}}}
!> \brief Computes tendencies for implicit tracer vertical mixing
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the tendencies for implicit vertical mixing for
!> tracers using computed coefficients.
!
@@ -374,6 +412,8 @@ subroutine ocn_tracer_vmix_tend_implicit(meshPool, dt, vertDiffTopOfCell, layerT
allocate(A(nVertLevels),B(nVertLevels),C(nVertLevels),tracersTemp(num_tracers,nVertLevels))
+ call mpas_timer_start('vmix tracers tend imp loop', .false.)
+ !$omp do schedule(runtime) private(N, k)
do iCell = 1, nCells
! Compute A(k), B(k), C(k) for tracers
N = maxLevelCell(iCell)
@@ -381,30 +421,32 @@ subroutine ocn_tracer_vmix_tend_implicit(meshPool, dt, vertDiffTopOfCell, layerT
! A is lower diagonal term
A(1)=0
do k = 2, N
- A(k) = -2.0*dt*vertDiffTopOfCell(k,iCell) &
+ A(k) = -2.0_RKIND*dt*vertDiffTopOfCell(k,iCell) &
/ (layerThickness(k-1,iCell) + layerThickness(k,iCell)) / layerThickness(k,iCell)
enddo
! C is upper diagonal term
do k = 1, N-1
- C(k) = -2.0*dt*vertDiffTopOfCell(k+1,iCell) &
+ C(k) = -2.0_RKIND*dt*vertDiffTopOfCell(k+1,iCell) &
/ (layerThickness(k,iCell) + layerThickness(k+1,iCell)) / layerThickness(k,iCell)
enddo
- C(N) = 0.0
+ C(N) = 0.0_RKIND
! B is diagonal term
do k = 1, N
B(k) = 1 - A(k) - C(k)
enddo
- call tridiagonal_solve_mult(A(2:N),B,C(1:N-1),tracers(:,:,iCell), &
- tracersTemp, N, nVertLevels,num_tracers)
+ call tridiagonal_solve_mult(A(2:N), B, C(1:N-1), tracers(:,:,iCell), &
+ tracersTemp, N, nVertLevels, num_tracers)
tracers(:,1:N,iCell) = tracersTemp(:,1:N)
tracers(:,N+1:nVertLevels,iCell) = -1e34
end do
+ !$omp end do
+ call mpas_timer_stop('vmix tracers tend imp loop')
- deallocate(A,B,C,tracersTemp)
+ deallocate(A, B, C, tracersTemp)
!--------------------------------------------------------------------
@@ -417,32 +459,40 @@ end subroutine ocn_tracer_vmix_tend_implicit!}}}
!> \brief Driver for implicit vertical mixing
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> This routine is a driver for handling implicit vertical mixing
!> of both momentum and tracers for a block. It's intended to reduce
!> redundant code.
!
!-----------------------------------------------------------------------
- subroutine ocn_vmix_implicit(dt, meshPool, diagnosticsPool, statePool, err, timeLevelIn)!{{{
+ subroutine ocn_vmix_implicit(dt, meshPool, diagnosticsPool, statePool, forcingPool, scratchPool, err, timeLevelIn)!{{{
real (kind=RKIND), intent(in) :: dt
type (mpas_pool_type), intent(in) :: meshPool
type (mpas_pool_type), intent(inout) :: diagnosticsPool
type (mpas_pool_type), intent(inout) :: statePool
+ type (mpas_pool_type), intent(inout) :: forcingPool
+ type (mpas_pool_type), intent(in) :: scratchPool !< Input/Output: Scratch structure
integer, intent(out) :: err
integer, intent(in), optional :: timeLevelIn
+ type (mpas_pool_type), pointer :: tracersPool
+
integer :: timeLevel, k, cell1, cell2, iEdge
integer, pointer :: nCells, nEdges
- real (kind=RKIND), dimension(:,:), pointer :: normalVelocity, layerThickness, layerThicknessEdge, vertViscTopOfEdge, vertDiffTopOfCell, kineticEnergyCell
+ real (kind=RKIND), dimension(:,:), pointer :: normalVelocity, layerThickness, layerThicknessEdge, vertViscTopOfEdge, &
+ vertDiffTopOfCell, kineticEnergyCell
real (kind=RKIND), dimension(:,:), pointer :: vertViscTopOfCell
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+ real (kind=RKIND), dimension(:,:,:), pointer :: tracersGroup
integer, dimension(:), pointer :: maxLevelCell, maxLevelEdgeTop
integer, dimension(:,:), pointer :: cellsOnEdge
logical, pointer :: config_use_cvmix
+ type (mpas_pool_iterator_type) :: groupItr
err = 0
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
if (present(timeLevelIn)) then
timeLevel = timeLevelIn
else
@@ -452,7 +502,6 @@ subroutine ocn_vmix_implicit(dt, meshPool, diagnosticsPool, statePool, err, time
call mpas_pool_get_config(ocnConfigs, 'config_use_cvmix', config_use_cvmix)
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, timeLevel)
- call mpas_pool_get_array(statePool, 'tracers', tracers, timeLevel)
call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, timeLevel)
call mpas_pool_get_array(diagnosticsPool, 'kineticEnergyCell', kineticEnergyCell)
@@ -464,34 +513,57 @@ subroutine ocn_vmix_implicit(dt, meshPool, diagnosticsPool, statePool, err, time
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
call mpas_pool_get_array(meshPool, 'maxLevelEdgeTop', maxLevelEdgeTop)
call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge)
-
+
call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
- call ocn_vmix_coefs(meshPool, statePool, diagnosticsPool, err, timeLevel)
+ call mpas_timer_start('vmix coefs', .false.)
+ call ocn_vmix_coefs(meshPool, statePool, forcingPool, diagnosticsPool, scratchPool, err, timeLevel)
+ call mpas_timer_stop('vmix coefs')
! if using CVMix, then viscosity has to be averaged from cell centers to cell edges
if ( config_use_cvmix ) then
- vertViscTopOfEdge(:,:) = 0.0
+
+ call mpas_timer_start('CVMix avg', .false.)
+ !$omp do schedule(runtime) private(cell1, cell2, k)
do iEdge=1,nEdges
+ vertViscTopOfEdge(:, iedge) = 0.0_RKIND
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
do k=1,maxLevelEdgeTop(iEdge)
- vertViscTopOfEdge(k,iEdge) = 0.5*(vertViscTopOfCell(k,cell2)+vertViscTopOfCell(k,cell1))
+ vertViscTopOfEdge(k,iEdge) = 0.5_RKIND*(vertViscTopOfCell(k,cell2)+vertViscTopOfCell(k,cell1))
enddo
enddo
+ !$omp end do
+ call mpas_timer_stop('CVMix avg')
+
endif
!
! Implicit vertical solve for momentum
!
- call ocn_vel_vmix_tend_implicit(meshPool, dt, kineticEnergyCell, vertViscTopOfEdge, layerThickness, layerThicknessEdge, normalVelocity, err)
+ call mpas_timer_start('vmix solve momentum', .false.)
+ call ocn_vel_vmix_tend_implicit(meshPool, dt, kineticEnergyCell, vertViscTopOfEdge, layerThickness, layerThicknessEdge, &
+ normalVelocity, err)
+ call mpas_timer_stop('vmix solve momentum')
!
- ! Implicit vertical solve for tracers
+ ! Implicit vertical solve for all tracers
!
- call ocn_tracer_vmix_tend_implicit(meshPool, dt, vertDiffTopOfCell, layerThickness, tracers, err)
+ call mpas_timer_start('vmix solve tracers', .false.)
+ call mpas_pool_begin_iteration(tracersPool)
+ do while ( mpas_pool_get_next_member(tracersPool, groupItr) )
+
+ if ( groupItr % memberType == MPAS_POOL_FIELD ) then
+ call mpas_pool_get_array(tracersPool, groupItr % memberName, tracersGroup, timeLevel)
+ if ( associated(tracersGroup) ) then
+ call ocn_tracer_vmix_tend_implicit(meshPool, dt, vertDiffTopOfCell, layerThickness, tracersGroup, err)
+ end if
+ end if
+ end do
+ call mpas_timer_stop('vmix solve tracers')
+
end subroutine ocn_vmix_implicit!}}}
@@ -502,9 +574,9 @@ end subroutine ocn_vmix_implicit!}}}
!> \brief Initializes ocean vertical mixing quantities
!> \author Mark Petersen
!> \date September 2011
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical mixing in the ocean.
+!> \details
+!> This routine initializes a variety of quantities related to
+!> vertical mixing in the ocean.
!
!-----------------------------------------------------------------------
@@ -558,7 +630,7 @@ end subroutine ocn_vmix_init!}}}
!> \brief Solve the matrix equation Ax=r for x, where A is tridiagonal.
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> Solve the matrix equation Ax=r for x, where A is tridiagonal.
!> A is an nxn matrix, with:
!> a sub-diagonal, filled from 1:n-1 (a(1) appears on row 2)
@@ -567,7 +639,7 @@ end subroutine ocn_vmix_init!}}}
!
!-----------------------------------------------------------------------
subroutine tridiagonal_solve(a,b,c,r,x,n) !{{{
-
+
!-----------------------------------------------------------------
!
! input variables
@@ -598,14 +670,14 @@ subroutine tridiagonal_solve(a,b,c,r,x,n) !{{{
! Use work variables for b and r
bTemp(1) = b(1)
rTemp(1) = r(1)
-
+
! First pass: set the coefficients
do i = 2,n
m = a(i-1)/bTemp(i-1)
bTemp(i) = b(i) - m*c(i-1)
rTemp(i) = r(i) - m*rTemp(i-1)
- end do
-
+ end do
+
x(n) = rTemp(n)/bTemp(n)
! Second pass: back-substition
do i = n-1, 1, -1
@@ -621,7 +693,7 @@ end subroutine tridiagonal_solve !}}}
!> \brief Solve multiple matrix equations Ax=r for x, where A is tridiagonal.
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> Solve the matrix equation Ax=r for x, where A is tridiagonal.
!> A is an nxn matrix, with:
!> a sub-diagonal, filled from 1:n-1 (a(1) appears on row 2)
@@ -639,22 +711,22 @@ subroutine tridiagonal_solve_mult(a,b,c,r,x,n,nDim,nSystems)!{{{
real (KIND=RKIND), dimension(nSystems,n) :: rTemp
real (KIND=RKIND) :: m
integer i,j
-
+
! Use work variables for b and r
bTemp(1) = b(1)
do j = 1,nSystems
rTemp(j,1) = r(j,1)
end do
-
+
! First pass: set the coefficients
do i = 2,n
m = a(i-1)/bTemp(i-1)
bTemp(i) = b(i) - m*c(i-1)
do j = 1,nSystems
rTemp(j,i) = r(j,i) - m*rTemp(j,i-1)
- end do
- end do
-
+ end do
+ end do
+
do j = 1,nSystems
x(j,n) = rTemp(j,n)/bTemp(n)
end do
@@ -664,7 +736,7 @@ subroutine tridiagonal_solve_mult(a,b,c,r,x,n,nDim,nSystems)!{{{
x(j,i) = (rTemp(j,i) - c(i)*x(j,i+1))/bTemp(i)
end do
end do
-
+
end subroutine tridiagonal_solve_mult!}}}
!***********************************************************************
diff --git a/src/core_ocean/shared/mpas_ocn_vmix_coefs_const.F b/src/core_ocean/shared/mpas_ocn_vmix_coefs_const.F
index f11ba0e409..740b26148e 100644
--- a/src/core_ocean/shared/mpas_ocn_vmix_coefs_const.F
+++ b/src/core_ocean/shared/mpas_ocn_vmix_coefs_const.F
@@ -13,8 +13,8 @@
!> \author Mark Petersen
!> \date September 2011
!> \details
-!> This module contains the routines for computing
-!> constant vertical mixing coefficients.
+!> This module contains the routines for computing
+!> constant vertical mixing coefficients.
!>
!
!-----------------------------------------------------------------------
@@ -70,7 +70,7 @@ module ocn_vmix_coefs_const
!> \brief Computes coefficients for vertical mixing
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the vertical mixing coefficients for momentum
!> and tracers based user choices of mixing parameterization.
!
@@ -125,7 +125,7 @@ subroutine ocn_vmix_coefs_const_build(meshPool, statePool, diagnosticsPool, err,
!-----------------------------------------------------------------
!
! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
+ ! note that the user can choose multiple options and the
! tendencies will be added together
!
!-----------------------------------------------------------------
@@ -157,7 +157,7 @@ end subroutine ocn_vmix_coefs_const_build!}}}
!> \brief Computes coefficients for vertical momentum mixing
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the constant vertical mixing coefficients for momentum
!
!-----------------------------------------------------------------------
@@ -187,6 +187,9 @@ subroutine ocn_vel_vmix_coefs_const(meshPool, vertViscTopOfEdge, err)!{{{
real (kind=RKIND), dimension(:,:), intent(out) :: vertViscTopOfEdge !< Output: vertical viscosity
+ integer :: iEdge
+ integer, pointer :: nEdges
+
integer, intent(out) :: err !< Output: error flag
!-----------------------------------------------------------------
@@ -199,7 +202,13 @@ subroutine ocn_vel_vmix_coefs_const(meshPool, vertViscTopOfEdge, err)!{{{
if ( .not. constViscOn ) return
- vertViscTopOfEdge = vertViscTopOfEdge + constVisc
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
+
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ vertViscTopOfEdge(:, iEdge) = vertViscTopOfEdge(:, iEdge) + constVisc
+ end do
+ !$omp end do
!--------------------------------------------------------------------
@@ -212,7 +221,7 @@ end subroutine ocn_vel_vmix_coefs_const!}}}
!> \brief Computes coefficients for vertical tracer mixing
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the constant vertical mixing coefficients for tracers
!
!-----------------------------------------------------------------------
@@ -242,6 +251,9 @@ subroutine ocn_tracer_vmix_coefs_const(meshPool, vertDiffTopOfCell, err)!{{{
real (kind=RKIND), dimension(:,:), intent(out) :: vertDiffTopOfCell !< Output: Vertical diffusion
+ integer :: iCell
+ integer, pointer :: nCells
+
integer, intent(out) :: err !< Output: error flag
!-----------------------------------------------------------------
@@ -254,7 +266,13 @@ subroutine ocn_tracer_vmix_coefs_const(meshPool, vertDiffTopOfCell, err)!{{{
if ( .not. constDiffOn ) return
- vertDiffTopOfCell = vertDiffTopOfCell + constDiff
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ vertDiffTopOfCell(:, iCell) = vertDiffTopOfCell(:, iCell) + constDiff
+ end do
+ !$omp end do
!--------------------------------------------------------------------
@@ -267,11 +285,11 @@ end subroutine ocn_tracer_vmix_coefs_const!}}}
!> \brief Initializes ocean momentum vertical mixing quantities
!> \author Mark Petersen
!> \date September 2011
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical velocity mixing in the ocean. Since a variety of
+!> \details
+!> This routine initializes a variety of quantities related to
+!> vertical velocity mixing in the ocean. Since a variety of
!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
+!> individual init routines for each parameterization.
!
!-----------------------------------------------------------------------
diff --git a/src/core_ocean/shared/mpas_ocn_vmix_coefs_redi.F b/src/core_ocean/shared/mpas_ocn_vmix_coefs_redi.F
index 5b1495c8a4..1e54097f25 100644
--- a/src/core_ocean/shared/mpas_ocn_vmix_coefs_redi.F
+++ b/src/core_ocean/shared/mpas_ocn_vmix_coefs_redi.F
@@ -8,7 +8,7 @@
!> \version SVN:$Id:$
!> \details
!> This module contains the routines for compounding
-!> the Redi vertical mixing coefficients.
+!> the Redi vertical mixing coefficients.
!>
!
!-----------------------------------------------------------------------
@@ -64,7 +64,7 @@ module ocn_vmix_coefs_redi
!> \author Doug Jacobsen
!> \date 19 September 2011
!> \version SVN:$Id$
-!> \details
+!> \details
!> This routine computes the vertical mixing coefficients for momentum
!> and tracers based user choices of mixing parameterization.
!
@@ -115,7 +115,7 @@ subroutine ocn_vmix_coefs_redi_build(meshPool, statePool, diagnosticsPool, err,
!-----------------------------------------------------------------
!
! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
+ ! note that the user can choose multiple options and the
! tendencies will be added together
!
!-----------------------------------------------------------------
@@ -141,7 +141,7 @@ end subroutine ocn_vmix_coefs_redi_build!}}}
!> \author Doug Jacobsen
!> \date 19 September 2011
!> \version SVN:$Id$
-!> \details
+!> \details
!> This routine computes the rediant vertical mixing coefficients for tracers
!
!-----------------------------------------------------------------------
@@ -173,6 +173,9 @@ subroutine ocn_tracer_vmix_coefs_redi(meshPool, vertDiffTopOfCell, vertRediDiff,
real (kind=RKIND), dimension(:,:), intent(in) :: vertRediDiff !< Output: Vertical diffusion
+ integer :: iCell
+ integer, pointer :: nCells
+
integer, intent(out) :: err !< Output: error flag
!-----------------------------------------------------------------
@@ -185,7 +188,13 @@ subroutine ocn_tracer_vmix_coefs_redi(meshPool, vertDiffTopOfCell, vertRediDiff,
if(.not.rediDiffOn) return
- vertDiffTopOfCell = vertDiffTopOfCell + vertRediDiff
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ vertDiffTopOfCell(:, iCell) = vertDiffTopOfCell(:, iCell) + vertRediDiff(:, iCell)
+ end do
+ !$omp end do
!--------------------------------------------------------------------
@@ -200,11 +209,11 @@ end subroutine ocn_tracer_vmix_coefs_redi!}}}
!> \author Doug Jacobsen
!> \date 19 September 2011
!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical velocity mixing in the ocean. Since a variety of
+!> \details
+!> This routine initializes a variety of quantities related to
+!> vertical velocity mixing in the ocean. Since a variety of
!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
+!> individual init routines for each parameterization.
!
!-----------------------------------------------------------------------
diff --git a/src/core_ocean/shared/mpas_ocn_vmix_coefs_rich.F b/src/core_ocean/shared/mpas_ocn_vmix_coefs_rich.F
index 1185fcd305..75bad57f14 100644
--- a/src/core_ocean/shared/mpas_ocn_vmix_coefs_rich.F
+++ b/src/core_ocean/shared/mpas_ocn_vmix_coefs_rich.F
@@ -13,8 +13,8 @@
!> \author Mark Petersen
!> \date September 2011
!> \details
-!> This module contains the routines for computing
-!> richardson vertical mixing coefficients.
+!> This module contains the routines for computing
+!> richardson vertical mixing coefficients.
!>
!
!-----------------------------------------------------------------------
@@ -25,6 +25,7 @@ module ocn_vmix_coefs_rich
use mpas_pool_routines
use mpas_constants
use mpas_timer
+ use mpas_threading
use ocn_constants
use ocn_equation_of_state
@@ -67,12 +68,12 @@ module ocn_vmix_coefs_rich
!> \brief Computes coefficients for vertical mixing
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the vertical mixing coefficients for momentum
-!> and tracers based user choices of mixing parameterization.
+!> and activeTracers based user choices of mixing parameterization.
!
!-----------------------------------------------------------------------
- subroutine ocn_vmix_coefs_rich_build(meshPool, statePool, diagnosticsPool, err, timeLevelIn)!{{{
+ subroutine ocn_vmix_coefs_rich_build(meshPool, statePool, diagnosticsPool, scratchPool, err, timeLevelIn)!{{{
!-----------------------------------------------------------------
!
@@ -83,6 +84,8 @@ subroutine ocn_vmix_coefs_rich_build(meshPool, statePool, diagnosticsPool, err,
type (mpas_pool_type), intent(in) :: &
meshPool !< Input: mesh information
+ type (mpas_pool_type), intent(in) :: scratchPool !< Input/Output: Scratch structure
+
integer, intent(in), optional :: timeLevelIn !< Input: Time level for state pool
!-----------------------------------------------------------------
@@ -112,33 +115,37 @@ subroutine ocn_vmix_coefs_rich_build(meshPool, statePool, diagnosticsPool, err,
!-----------------------------------------------------------------
integer :: err1, err2, err3, timeLevel
- integer, pointer :: indexT, indexS
+ integer, pointer :: indexTemperature, indexSalinity
+
+ type (mpas_pool_type), pointer :: tracersPool
real (kind=RKIND), dimension(:,:), pointer :: &
vertViscTopOfEdge, vertDiffTopOfCell, normalVelocity, layerThickness, layerThicknessEdge, density, displacedDensity
real (kind=RKIND), dimension(:,:), pointer :: RiTopOfEdge, RiTopOfCell
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+ real (kind=RKIND), dimension(:,:,:), pointer :: activeTracers
!-----------------------------------------------------------------
!
! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
+ ! note that the user can choose multiple options and the
! tendencies will be added together
!
!-----------------------------------------------------------------
err = 0
+ call mpas_pool_get_subpool(statePool, 'tracers', tracersPool)
+
if (present(timeLevelIn)) then
timeLevel = timeLevelIn
else
timeLevel = 1
end if
- call mpas_pool_get_dimension(statePool, 'index_temperature', indexT)
- call mpas_pool_get_dimension(statePool, 'index_salinity', indexS)
+ call mpas_pool_get_dimension(tracersPool, 'index_temperature', indexTemperature)
+ call mpas_pool_get_dimension(tracersPool, 'index_salinity', indexSalinity)
call mpas_pool_get_array(diagnosticsPool, 'vertViscTopOfEdge', vertViscTopOfEdge)
call mpas_pool_get_array(diagnosticsPool, 'vertDiffTopOfCell', vertDiffTopOfCell)
@@ -150,21 +157,23 @@ subroutine ocn_vmix_coefs_rich_build(meshPool, statePool, diagnosticsPool, err,
call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, timeLevel)
call mpas_pool_get_array(statePool, 'layerThickness', layerThickness, timeLevel)
- call mpas_pool_get_array(statePool, 'tracers', tracers, timeLevel)
+ call mpas_pool_get_array(tracersPool, 'activeTracers', activeTracers, timeLevel)
call mpas_timer_start("eos rich")
! compute in-place density
- call ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, 0, 'relative', density, err, timeLevelIn=timeLevel)
+ call ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, scratchPool, 0, 'relative', density, err, &
+ timeLevelIn=timeLevel)
- ! compute displacedDensity, density displaced adiabatically to the mid-depth one layer deeper.
+ ! compute displacedDensity, density displaced adiabatically to the mid-depth one layer deeper.
! That is, layer k has been displaced to the depth of layer k+1.
- call ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, 1, 'relative', displacedDensity, err, timeLevelIn=timeLevel)
+ call ocn_equation_of_state_density(statePool, diagnosticsPool, meshPool, scratchPool, 1, 'relative', displacedDensity, err, &
+ timeLevelIn=timeLevel)
call mpas_timer_stop("eos rich")
- call ocn_vmix_get_rich_numbers(meshPool, indexT, indexS, normalVelocity, layerThickness, layerThicknessEdge, &
- density, displacedDensity, tracers, RiTopOfEdge, RiTopOfCell, err1)
+ call ocn_vmix_get_rich_numbers(meshPool, scratchPool, indexTemperature, indexSalinity, normalVelocity, layerThickness, &
+ layerThicknessEdge, density, displacedDensity, activeTracers, RiTopOfEdge, RiTopOfCell, err1)
call ocn_vel_vmix_coefs_rich(meshPool, RiTopOfEdge, layerThicknessEdge, vertViscTopOfEdge, err2)
call ocn_tracer_vmix_coefs_rich(meshPool, RiTopOfCell, layerThickness, vertDiffTopOfCell, err3)
@@ -182,7 +191,7 @@ end subroutine ocn_vmix_coefs_rich_build!}}}
!> \brief Computes coefficients for vertical momentum mixing
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the richardson vertical mixing coefficients for momentum
!
!-----------------------------------------------------------------------
@@ -245,13 +254,14 @@ subroutine ocn_vel_vmix_coefs_rich(meshPool, RiTopOfEdge, layerThicknessEdge, ve
call mpas_pool_get_array(meshPool, 'maxLevelEdgeTop', maxLevelEdgeTop)
+ !$omp do schedule(runtime) private(k)
do iEdge = 1, nEdges
do k = 2, maxLevelEdgeTop(iEdge)
! efficiency note: these if statements are inside iEdge and k loops.
! Perhaps there is a more efficient way to do this.
- if (RiTopOfEdge(k,iEdge)>0.0) then
+ if (RiTopOfEdge(k,iEdge)>0.0_RKIND) then
vertViscTopOfEdge(k,iEdge) = vertViscTopOfEdge(k, iEdge) + config_bkrd_vert_visc &
- + config_rich_mix / (1.0 + 5.0*RiTopOfEdge(k,iEdge))**2
+ + config_rich_mix / (1.0_RKIND + 5.0_RKIND*RiTopOfEdge(k,iEdge))**2
if (vertViscTopOfEdge(k,iEdge) > config_convective_visc) then
vertViscTopOfEdge(k,iEdge) = config_convective_visc
end if
@@ -261,6 +271,7 @@ subroutine ocn_vel_vmix_coefs_rich(meshPool, RiTopOfEdge, layerThicknessEdge, ve
end if
end do
end do
+ !$omp end do
!--------------------------------------------------------------------
@@ -274,8 +285,8 @@ end subroutine ocn_vel_vmix_coefs_rich!}}}
!> \brief Computes coefficients for vertical tracer mixing
!> \author Mark Petersen
!> \date September 2011
-!> \details
-!> This routine computes the richardson vertical mixing coefficients for tracers
+!> \details
+!> This routine computes the richardson vertical mixing coefficients for activeTracers
!
!-----------------------------------------------------------------------
@@ -324,13 +335,12 @@ subroutine ocn_tracer_vmix_coefs_rich(meshPool, RiTopOfCell, layerThickness, ver
integer, dimension(:), pointer :: maxLevelCell
real (kind=RKIND) :: coef
- real (kind=RKIND), pointer :: config_density0, config_bkrd_vert_diff, config_bkrd_vert_visc, config_rich_mix, config_convective_diff
+ real (kind=RKIND), pointer :: config_bkrd_vert_diff, config_bkrd_vert_visc, config_rich_mix, config_convective_diff
err = 0
if(.not.richDiffOn) return
- call mpas_pool_get_config(ocnConfigs, 'config_density0', config_density0)
call mpas_pool_get_config(ocnConfigs, 'config_bkrd_vert_diff', config_bkrd_vert_diff)
call mpas_pool_get_config(ocnConfigs, 'config_bkrd_vert_visc', config_bkrd_vert_visc)
call mpas_pool_get_config(ocnConfigs, 'config_rich_mix', config_rich_mix)
@@ -340,16 +350,17 @@ subroutine ocn_tracer_vmix_coefs_rich(meshPool, RiTopOfCell, layerThickness, ver
call mpas_pool_get_array(meshPool, 'maxLevelCell', maxLevelCell)
- coef = -gravity / config_density0 / 2.0
+ coef = -gravity / rho_sw / 2.0_RKIND
+ !$omp do schedule(runtime) private(k)
do iCell = 1, nCells
do k = 2, maxLevelCell(iCell)
! efficiency note: these if statements are inside iEdge and k loops.
! Perhaps there is a more efficient way to do this.
- if (RiTopOfCell(k,iCell)>0.0) then
+ if (RiTopOfCell(k,iCell)>0.0_RKIND) then
vertDiffTopOfCell(k,iCell) = vertDiffTopOfCell(k, iCell) + config_bkrd_vert_diff &
- + (config_bkrd_vert_visc &
- + config_rich_mix / (1.0 + 5.0*RiTopOfCell(k,iCell))**2) &
- / (1.0 + 5.0*RiTopOfCell(k,iCell))
+ + (config_bkrd_vert_visc &
+ + config_rich_mix / (1.0_RKIND + 5.0_RKIND*RiTopOfCell(k,iCell))**2) &
+ / (1.0_RKIND + 5.0_RKIND*RiTopOfCell(k,iCell))
if (vertDiffTopOfCell(k,iCell) > config_convective_diff) then
vertDiffTopOfCell(k,iCell) = config_convective_diff
end if
@@ -359,7 +370,7 @@ subroutine ocn_tracer_vmix_coefs_rich(meshPool, RiTopOfCell, layerThickness, ver
end if
end do
end do
-
+ !$omp end do
!--------------------------------------------------------------------
@@ -372,14 +383,15 @@ end subroutine ocn_tracer_vmix_coefs_rich!}}}
!> \brief Build richardson numbers for vertical mixing
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> This routine builds the arrays needed for richardson number vertical
!> mixing coefficients.
!
!-----------------------------------------------------------------------
- subroutine ocn_vmix_get_rich_numbers(meshPool, indexT, indexS, normalVelocity, layerThickness, layerThicknessEdge, & !{{{
- density, displacedDensity, tracers, RiTopOfEdge, RiTopOfCell, err)
+ subroutine ocn_vmix_get_rich_numbers(meshPool, scratchPool, indexTemperature, indexSalinity, normalVelocity, & !{{{
+ layerThickness, layerThicknessEdge, density, displacedDensity, activeTracers, &
+ RiTopOfEdge, RiTopOfCell, err)
!-----------------------------------------------------------------
!
@@ -390,14 +402,16 @@ subroutine ocn_vmix_get_rich_numbers(meshPool, indexT, indexS, normalVelocity, l
type (mpas_pool_type), intent(in) :: &
meshPool !< Input: mesh information
- integer, intent(in) :: indexT !< Input: index for temperature
- integer, intent(in) :: indexS !< Input: index for salinity
+ type (mpas_pool_type), intent(in) :: scratchPool !< Input: scratch variables
+
+ integer, intent(in) :: indexTemperature !< Input: index for temperature
+ integer, intent(in) :: indexSalinity !< Input: index for salinity
real (kind=RKIND), dimension(:,:), intent(in) :: normalVelocity !< Input: horizontal velocity
real (kind=RKIND), dimension(:,:), intent(in) :: layerThickness !< Input: thickness
- real (kind=RKIND), dimension(:,:), intent(in) :: layerThicknessEdge !< Input: thickness at edge
+ real (kind=RKIND), dimension(:,:), intent(in) :: layerThicknessEdge !< Input: thickness at edge
- real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !< Input: tracers
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: activeTracers !< Input: activeTracers
!-----------------------------------------------------------------
!
@@ -433,17 +447,15 @@ subroutine ocn_vmix_get_rich_numbers(meshPool, indexT, indexS, normalVelocity, l
real (kind=RKIND) :: coef, invAreaCell
real (kind=RKIND), dimension(:), pointer :: dcEdge, dvEdge, areaCell
- real (kind=RKIND), dimension(:,:), allocatable :: ddensityTopOfCell, du2TopOfCell, &
- ddensityTopOfEdge, du2TopOfEdge
-
- real (kind=RKIND), pointer :: config_density0
+ real (kind=RKIND), dimension(:,:), pointer :: ddensityTopOfCell, du2TopOfCell, &
+ ddensityTopOfEdge, du2TopOfEdge
+ type (field2DReal), pointer :: ddensityTopOfCellField, du2TopOfCellField, &
+ ddensityTopOfEdgeField, du2TopOfEdgeField
err = 0
if ( ( .not. richViscOn ) .and. ( .not. richDiffOn ) ) return
- call mpas_pool_get_config(ocnConfigs, 'config_density0', config_density0)
-
call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
@@ -459,76 +471,114 @@ subroutine ocn_vmix_get_rich_numbers(meshPool, indexT, indexS, normalVelocity, l
call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell)
call mpas_pool_get_array(meshPool, 'edgeSignOnCell', edgeSignOnCell)
- allocate( &
- ddensityTopOfCell(nVertLevels+1,nCells+1), ddensityTopOfEdge(nVertLevels+1,nEdges), &
- du2TopOfCell(nVertLevels+1,nCells+1), du2TopOfEdge(nVertLevels+1,nEdges))
+ call mpas_pool_get_field(scratchPool, 'ddensityTopOfCell', ddensityTopOfCellField)
+ call mpas_pool_get_field(scratchPool, 'ddensityTopOfEdge', ddensityTopOfEdgeField)
+ call mpas_pool_get_field(scratchPool, 'du2TopOfCell', du2TopOfCellField)
+ call mpas_pool_get_field(scratchPool, 'du2TopOfEdge', du2TopOfEdgeField)
+ call mpas_allocate_scratch_field(ddensityTopOfCellField, .true.)
+ call mpas_allocate_scratch_field(ddensityTopOfEdgeField, .true.)
+ call mpas_allocate_scratch_field(du2TopOfCellField, .true.)
+ call mpas_allocate_scratch_field(du2TopOfEdgeField, .true.)
+ call mpas_threading_barrier()
+
+ ddensityTopOfCell => ddensityTopOfCellField % array
+ ddensityTopOfEdge => ddensityTopOfEdgeField % array
+ du2TopOfCell => du2TopOfCellField % array
+ du2TopOfEdge => du2TopOfEdgeField % array
! ddensityTopOfCell(k) = $\rho^*_{k-1}-\rho_k$, where $\rho^*$ has been adiabatically displaced to level k.
- ddensityTopOfCell = 0.0
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ ddensityTopOfCell(:, iCell) = 0.0_RKIND
+ du2TopOfCell(:, iCell) = 0.0_RKIND
+ RiTopOfCell(:, iCell) = 0.0_RKIND
+ end do
+ !$omp end do
+
+ !$omp do schedule(runtime)
+ do iEdge = 1, nEdges
+ ddensityTopOfEdge(:, iEdge) = 0.0_RKIND
+ du2TopOfEdge(:, iEdge) = 0.0_RKIND
+ RiTopOfEdge(:, iEdge) = 0.0_RKIND
+ end do
+ !$omp end do
+
+ !$omp do schedule(runtime) private(k)
do iCell = 1, nCells
do k = 2, maxLevelCell(iCell)
ddensityTopOfCell(k,iCell) = displacedDensity(k-1,iCell) - density(k,iCell)
end do
end do
+ !$omp end do
! interpolate ddensityTopOfCell to ddensityTopOfEdge
- ddensityTopOfEdge = 0.0
+ !$omp do schedule(runtime) private(cell1, cell2, k)
do iEdge = 1, nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
do k = 2, maxLevelEdgeTop(iEdge)
ddensityTopOfEdge(k,iEdge) = &
(ddensityTopOfCell(k,cell1) + &
- ddensityTopOfCell(k,cell2))/2
+ ddensityTopOfCell(k,cell2))/2
end do
end do
+ !$omp end do
! du2TopOfEdge(k) = $u_{k-1}-u_k$
- du2TopOfEdge=0.0
+ !$omp do schedule(runtime) private(k)
do iEdge = 1, nEdges
do k = 2, maxLevelEdgeTop(iEdge)
du2TopOfEdge(k,iEdge) = (normalVelocity(k-1,iEdge) - normalVelocity(k,iEdge))**2
end do
end do
+ !$omp end do
! interpolate du2TopOfEdge to du2TopOfCell
- du2TopOfCell = 0.0
+ !$omp do schedule(runtime) private(invAreaCell, i, iEdge, k)
do iCell = 1, nCells
- invAreaCell = 1.0 / areaCell(iCell)
+ invAreaCell = 1.0_RKIND / areaCell(iCell)
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i, iCell)
do k = 2, maxLevelEdgeBot(iEdge)
- du2TopOfCell(k, iCell) = du2TopOfCell(k, iCell) + 0.5 * dcEdge(iEdge) * dvEdge(iEdge) * du2TopOfEdge(k, iEdge) * invAreaCell
+ du2TopOfCell(k, iCell) = du2TopOfCell(k, iCell) + 0.5_RKIND * dcEdge(iEdge) * dvEdge(iEdge) &
+ * du2TopOfEdge(k, iEdge) * invAreaCell
end do
end do
end do
+ !$omp end do
! compute RiTopOfEdge using ddensityTopOfEdge and du2TopOfEdge
! coef = -g/density_0/2
- RiTopOfEdge = 0.0
- coef = -gravity / config_density0 / 2.0
+ coef = -gravity / rho_sw / 2.0_RKIND
+
+ !$omp do schedule(runtime) private(k)
do iEdge = 1, nEdges
do k = 2, maxLevelEdgeTop(iEdge)
RiTopOfEdge(k,iEdge) = coef * ddensityTopOfEdge(k,iEdge) &
* ( layerThicknessEdge(k-1,iEdge) + layerThicknessEdge(k,iEdge) ) &
- / ( du2TopOfEdge(k,iEdge) + 1e-20 )
+ / ( du2TopOfEdge(k,iEdge) + 1e-20_RKIND )
end do
end do
+ !$omp end do
! compute RiTopOfCell using ddensityTopOfCell and du2TopOfCell
! coef = -g/density_0/2
- RiTopOfCell = 0.0
+ !$omp do schedule(runtime) private(k)
do iCell = 1,nCells
do k = 2,maxLevelCell(iCell)
RiTopOfCell(k,iCell) = coef * ddensityTopOfCell(k,iCell) &
* (layerThickness(k-1,iCell) + layerThickness(k,iCell)) &
- / (du2TopOfCell(k,iCell) + 1e-20)
+ / (du2TopOfCell(k,iCell) + 1e-20_RKIND)
end do
end do
+ !$omp end do
- deallocate(ddensityTopOfCell, ddensityTopOfEdge, &
- du2TopOfCell, du2TopOfEdge)
+ call mpas_threading_barrier()
+ call mpas_deallocate_scratch_field(ddensityTopOfCellField, .true.)
+ call mpas_deallocate_scratch_field(ddensityTopOfEdgeField, .true.)
+ call mpas_deallocate_scratch_field(du2TopOfCellField, .true.)
+ call mpas_deallocate_scratch_field(du2TopOfEdgeField, .true.)
!--------------------------------------------------------------------
@@ -541,11 +591,11 @@ end subroutine ocn_vmix_get_rich_numbers!}}}
!> \brief Initializes ocean momentum vertical mixing quantities
!> \author Mark Petersen
!> \date September 2011
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical velocity mixing in the ocean. Since a variety of
+!> \details
+!> This routine initializes a variety of quantities related to
+!> vertical velocity mixing in the ocean. Since a variety of
!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
+!> individual init routines for each parameterization.
!
!-----------------------------------------------------------------------
diff --git a/src/core_ocean/shared/mpas_ocn_vmix_coefs_tanh.F b/src/core_ocean/shared/mpas_ocn_vmix_coefs_tanh.F
index a6f8c733ae..524b4ea117 100644
--- a/src/core_ocean/shared/mpas_ocn_vmix_coefs_tanh.F
+++ b/src/core_ocean/shared/mpas_ocn_vmix_coefs_tanh.F
@@ -13,8 +13,8 @@
!> \author Mark Petersen
!> \date September 2011
!> \details
-!> This module contains the routines for computing
-!> tanhant vertical mixing coefficients.
+!> This module contains the routines for computing
+!> tanhant vertical mixing coefficients.
!>
!
!-----------------------------------------------------------------------
@@ -64,7 +64,7 @@ module ocn_vmix_coefs_tanh
!> \brief Computes coefficients for vertical mixing
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the vertical mixing coefficients for momentum
!> and tracers based user choices of mixing parameterization.
!
@@ -117,7 +117,7 @@ subroutine ocn_vmix_coefs_tanh_build(meshPool, statePool, diagnosticsPool, err,
!-----------------------------------------------------------------
!
! call relevant routines for computing tendencies
- ! note that the user can choose multiple options and the
+ ! note that the user can choose multiple options and the
! tendencies will be added together
!
!-----------------------------------------------------------------
@@ -149,7 +149,7 @@ end subroutine ocn_vmix_coefs_tanh_build!}}}
!> \brief Computes coefficients for vertical momentum mixing
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the tanh vertical mixing coefficients for momentum
!
!-----------------------------------------------------------------------
@@ -187,8 +187,8 @@ subroutine ocn_vel_vmix_coefs_tanh(meshPool, vertViscTopOfEdge, err)!{{{
!
!-----------------------------------------------------------------
- integer :: k
- integer, pointer :: nVertLevels
+ integer :: k, iEdge
+ integer, pointer :: nVertLevels, nEdges
real (kind=RKIND), dimension(:), pointer :: refBottomDepth
real (kind=RKIND), pointer :: config_max_visc_tanh, config_min_visc_tanh, config_ZMid_tanh
@@ -203,18 +203,23 @@ subroutine ocn_vel_vmix_coefs_tanh(meshPool, vertViscTopOfEdge, err)!{{{
call mpas_pool_get_config(ocnConfigs, 'config_ZMid_tanh', config_ZMid_tanh)
call mpas_pool_get_config(ocnConfigs, 'config_zWidth_tanh', config_zWidth_tanh)
+ call mpas_pool_get_dimension(meshPool, 'nEdges', nEdges)
call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
- ! refBottomDepth is used here for simplicity. Using zMid and h, which
+ ! refBottomDepth is used here for simplicity. Using zMid and h, which
! vary in time, would give the exact location of the top, but it
! would only change the diffusion value very slightly.
- do k = 2, nVertLevels
- vertViscTopOfEdge(k,:) = vertViscTopOfEdge(k,:) - (config_max_visc_tanh - config_min_visc_tanh) / 2.0 &
- * tanh((refBottomDepth(k-1) + config_ZMid_tanh) &
- / config_zWidth_tanh) &
- + (config_max_visc_tanh + config_min_visc_tanh) / 2
+ !$omp do schedule(runtime) private(k)
+ do iEdge = 1, nEdges
+ do k = 2, nVertLevels
+ vertViscTopOfEdge(k, iEdge) = vertViscTopOfEdge(k, iEdge) - (config_max_visc_tanh - config_min_visc_tanh) / 2.0_RKIND &
+ * tanh((refBottomDepth(k-1) + config_ZMid_tanh) &
+ / config_zWidth_tanh) &
+ + (config_max_visc_tanh + config_min_visc_tanh) / 2
+ end do
end do
+ !$omp end do
!--------------------------------------------------------------------
@@ -228,7 +233,7 @@ end subroutine ocn_vel_vmix_coefs_tanh!}}}
!> \brief Computes coefficients for vertical tracer mixing
!> \author Mark Petersen
!> \date September 2011
-!> \details
+!> \details
!> This routine computes the tanh vertical mixing coefficients for tracers
!
!-----------------------------------------------------------------------
@@ -266,8 +271,8 @@ subroutine ocn_tracer_vmix_coefs_tanh(meshPool, vertDiffTopOfCell, err)!{{{
!
!-----------------------------------------------------------------
- integer :: k
- integer, pointer :: nVertLevels
+ integer :: k, iCell
+ integer, pointer :: nVertLevels, nCells
real (kind=RKIND), dimension(:), pointer :: refBottomDepth
@@ -283,18 +288,23 @@ subroutine ocn_tracer_vmix_coefs_tanh(meshPool, vertDiffTopOfCell, err)!{{{
call mpas_pool_get_config(ocnConfigs, 'config_ZMid_tanh', config_ZMid_tanh)
call mpas_pool_get_config(ocnConfigs, 'config_zWidth_tanh', config_zWidth_tanh)
+ call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
call mpas_pool_get_array(meshPool, 'refBottomDepth', refBottomDepth)
- ! refBottomDepth is used here for simplicity. Using zMid and h, which
+ ! refBottomDepth is used here for simplicity. Using zMid and h, which
! vary in time, would give the exact location of the top, but it
! would only change the diffusion value very slightly.
- do k=2,nVertLevels
- vertDiffTopOfCell(k,:) = vertDiffTopOfCell(k,:) - (config_max_diff_tanh - config_min_diff_tanh) / 2.0 &
- * tanh((refBottomDepth(k-1) + config_ZMid_tanh) &
- / config_zWidth_tanh) &
- + (config_max_diff_tanh + config_min_diff_tanh) / 2
+ !$omp do schedule(runtime) private(k)
+ do iCell = 1, nCells
+ do k=2,nVertLevels
+ vertDiffTopOfCell(k, iCell) = vertDiffTopOfCell(k, iCell) - (config_max_diff_tanh - config_min_diff_tanh) / 2.0_RKIND &
+ * tanh((refBottomDepth(k-1) + config_ZMid_tanh) &
+ / config_zWidth_tanh) &
+ + (config_max_diff_tanh + config_min_diff_tanh) / 2
+ end do
end do
+ !$omp end do
!--------------------------------------------------------------------
@@ -309,9 +319,9 @@ end subroutine ocn_tracer_vmix_coefs_tanh!}}}
!> \brief Initializes ocean vertical mixing quantities
!> \author Mark Petersen
!> \date September 2011
-!> \details
-!> This routine initializes a variety of quantities related to
-!> tanh vertical mixing in the ocean.
+!> \details
+!> This routine initializes a variety of quantities related to
+!> tanh vertical mixing in the ocean.
!
!-----------------------------------------------------------------------
diff --git a/src/core_ocean/shared/mpas_ocn_vmix_cvmix.F b/src/core_ocean/shared/mpas_ocn_vmix_cvmix.F
index caf54b5e12..97b742b298 100644
--- a/src/core_ocean/shared/mpas_ocn_vmix_cvmix.F
+++ b/src/core_ocean/shared/mpas_ocn_vmix_cvmix.F
@@ -17,7 +17,7 @@ module ocn_vmix_cvmix
use mpas_pool_routines
use mpas_timer
use mpas_io_units
-
+ use mpas_constants
use ocn_constants
use cvmix_kinds_and_types
@@ -58,7 +58,6 @@ module ocn_vmix_cvmix
type(cvmix_bkgnd_params_type) :: cvmix_background_params
type(cvmix_shear_params_type) :: cvmix_shear_params
type(cvmix_tidal_params_type) :: cvmix_tidal_params
- type(cvmix_data_type) :: cvmix_variables
logical :: cvmixOn, cvmixBackgroundOn, cvmixConvectionOn, cvmixKPPOn
real (kind=RKIND) :: backgroundVisc, backgroundDiff
@@ -75,13 +74,13 @@ module ocn_vmix_cvmix
!> \brief Computes mixing coefficients using CVMix
!> \author Todd Ringler
!> \date 04 February 2013
-!> \details
+!> \details
!> This routine computes the vertical mixing coefficients for momentum
!> and tracers by calling CVMix routines.
!
!-----------------------------------------------------------------------
- subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err, timeLevelIn)!{{{
+ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, forcingPool, diagnosticsPool, err, timeLevelIn)!{{{
!-----------------------------------------------------------------
!
@@ -91,7 +90,7 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
type (mpas_pool_type), intent(in) :: &
meshPool !< Input: mesh information
-
+
integer, intent(in), optional :: timeLevelIn !< Input: time level for state pool
!-----------------------------------------------------------------
@@ -106,6 +105,9 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
type (mpas_pool_type), intent(inout) :: &
diagnosticsPool !< Input/Output: diagnostic information
+ type (mpas_pool_type), intent(inout) :: &
+ forcingPool !< Input/Output: forcing information
+
!-----------------------------------------------------------------
!
! output variables
@@ -120,32 +122,38 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
!
!-----------------------------------------------------------------
+ type(cvmix_data_type) :: cvmix_variables
+
integer, dimension(:), pointer :: &
- maxLevelCell
+ maxLevelCell, nEdgesOnCell
real (kind=RKIND), dimension(:), pointer :: &
latCell, lonCell, bottomDepth, surfaceBuoyancyForcing, surfaceFrictionVelocity, fCell, &
- boundaryLayerDepth, ssh, indexBoundaryLayerDepth
-
+ boundaryLayerDepth, ssh, indexBoundaryLayerDepth, dcEdge, dvEdge, areaCell, iceFraction
+
real (kind=RKIND), dimension(:,:), pointer :: &
vertViscTopOfCell, vertDiffTopOfCell, layerThickness, &
zMid, zTop, density, displacedDensity, potentialDensity, &
bulkRichardsonNumber, RiTopOfCell, BruntVaisalaFreqTop, &
- bulkRichardsonNumberBuoy, bulkRichardsonNumberShear, unresolvedShear
+ bulkRichardsonNumberBuoy, bulkRichardsonNumberShear, unresolvedShear, normalVelocity
real (kind=RKIND), dimension(:,:,:), pointer :: vertNonLocalFlux
integer, pointer :: index_vertNonLocalFluxTemp
+ integer, dimension(:,:), pointer :: edgesOnCell
logical, pointer :: config_use_cvmix_shear, config_use_cvmix_convection, config_use_cvmix_kpp
logical, pointer :: config_use_cvmix_fixed_boundary_layer
real (kind=RKIND), pointer :: config_cvmix_kpp_stop_OBL_search, config_cvmix_kpp_criticalBulkRichardsonNumber
- real (kind=RKIND), pointer :: config_cvmix_kpp_boundary_layer_depth
+ real (kind=RKIND), pointer :: config_cvmix_kpp_boundary_layer_depth, config_cvmix_kpp_surface_layer_extent
+ real (kind=RKIND), pointer :: configure_cvmix_kpp_minimum_OBL_under_sea_ice
character (len=StrKIND), pointer :: config_cvmix_shear_mixing_scheme, config_cvmix_kpp_matching
- integer :: k, iCell, jCell, iNeighbor, iter, timeLevel, kIndexOBL
+ integer :: k, i, iCell, jCell, iNeighbor, iter, timeLevel, kIndexOBL, kav, iEdge
integer, pointer :: nVertLevels, nCells
- real (kind=RKIND) :: r, layerSum, bulkRichardsonNumberStop
- real (kind=RKIND), dimension(:), allocatable :: sigma, Nsqr_iface, turbulentScalarVelocityScale, tmp
+ real (kind=RKIND) :: r, layerSum, bulkRichardsonNumberStop, sfc_layer_depth, invAreaCell, deltaVelocitySquared
+ real (kind=RKIND) :: normalVelocityAv, factor, delU2
+ real (kind=RKIND) :: sigma, turbulentScalarVelocityScalePoint
+ real (kind=RKIND), dimension(:), allocatable :: Nsqr_iface, turbulentScalarVelocityScale
real (kind=RKIND), dimension(:), allocatable, target :: RiSmoothed, BVFSmoothed
logical :: bulkRichardsonFlag
@@ -154,11 +162,11 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
!-----------------------------------------------------------------
!
! call relevant routines for computing mixing-related fields
- ! note that the user can choose multiple options and the
+ ! note that the user can choose multiple options and the
! mixing fields have to be added/merged together
!
!-----------------------------------------------------------------
-
+
!
! assume no errors during initialization and set to 1 when error is encountered
!
@@ -181,7 +189,8 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
call mpas_pool_get_config(ocnConfigs, 'config_cvmix_background_viscosity', config_cvmix_background_viscosity)
call mpas_pool_get_config(ocnConfigs, 'config_cvmix_background_diffusion', config_cvmix_background_diffusion)
call mpas_pool_get_config(ocnConfigs, 'config_cvmix_kpp_stop_OBL_search', config_cvmix_kpp_stop_OBL_search)
- call mpas_pool_get_config(ocnConfigs, 'config_cvmix_kpp_criticalBulkRichardsonNumber', config_cvmix_kpp_criticalBulkRichardsonNumber)
+ call mpas_pool_get_config(ocnConfigs, 'config_cvmix_kpp_criticalBulkRichardsonNumber', &
+ config_cvmix_kpp_criticalBulkRichardsonNumber)
call mpas_pool_get_config(ocnConfigs, 'config_use_cvmix_shear', config_use_cvmix_shear)
call mpas_pool_get_config(ocnConfigs, 'config_use_cvmix_convection', config_use_cvmix_convection)
call mpas_pool_get_config(ocnConfigs, 'config_use_cvmix_kpp', config_use_cvmix_kpp)
@@ -189,9 +198,17 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
call mpas_pool_get_config(ocnConfigs, 'config_cvmix_kpp_matching', config_cvmix_kpp_matching)
call mpas_pool_get_config(ocnConfigs, 'config_use_cvmix_fixed_boundary_layer', config_use_cvmix_fixed_boundary_layer)
call mpas_pool_get_config(ocnConfigs, 'config_cvmix_kpp_boundary_layer_depth', config_cvmix_kpp_boundary_layer_depth)
-
+ call mpas_pool_get_config(ocnConfigs, 'config_cvmix_kpp_surface_layer_extent', config_cvmix_kpp_surface_layer_extent)
+ call mpas_pool_get_config(ocnConfigs, 'configure_cvmix_kpp_minimum_OBL_under_sea_ice', &
+ configure_cvmix_kpp_minimum_OBL_under_sea_ice)
call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels)
call mpas_pool_get_dimension(meshPool, 'nCells', nCells)
+ call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge)
+ call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge)
+ call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell)
+ call mpas_pool_get_array(meshPool, 'areaCell', areaCell)
+ call mpas_pool_get_array(statePool, 'normalVelocity', normalVelocity, timeLevel)
+ call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell)
!
! set pointers for fields related to position on sphere
@@ -227,6 +244,11 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
call mpas_pool_get_array(diagnosticsPool, 'bulkRichardsonNumberShear',bulkRichardsonNumberShear)
call mpas_pool_get_array(diagnosticsPool, 'indexBoundaryLayerDepth',indexBoundaryLayerDepth)
+ !
+ ! set pointers for fields related to ocean forcing state
+ !
+ call mpas_pool_get_array(forcingPool, 'iceFraction', iceFraction)
+
!
! set pointers for fields related forcing at ocean surface
!
@@ -239,8 +261,6 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
call mpas_pool_get_array(diagnosticsPool, 'vertViscTopOfCell', vertViscTopOfCell)
call mpas_pool_get_array(diagnosticsPool, 'vertDiffTopOfCell', vertDiffTopOfCell)
- vertViscTopOfCell = 0.0
- vertDiffTopOfCell = 0.0
!
! set pointers for nonlocal flux and intialize to zero
@@ -248,14 +268,24 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
call mpas_pool_get_array(diagnosticsPool, 'vertNonLocalFlux', vertNonLocalFlux)
call mpas_pool_get_dimension(diagnosticsPool, 'index_vertNonLocalFluxTemp', index_vertNonLocalFluxTemp)
- vertNonLocalFlux = 0.0
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ vertViscTopOfCell(:, iCell) = 0.0_RKIND
+ vertDiffTopOfCell(:, iCell) = 0.0_RKIND
+ vertNonLocalFlux(:, :, iCell) = 0.0_RKIND
+ end do
+ !$omp end do
!
! start by adding the mininum background values to the visocity/diffusivity arrays
!
if (cvmixBackgroundOn) then
- vertViscTopOfCell(:,:) = vertViscTopOfCell(:,:) + config_cvmix_background_viscosity
- vertDiffTopOfCell(:,:) = vertDiffTopOfCell(:,:) + config_cvmix_background_diffusion
+ !$omp do schedule(runtime)
+ do iCell = 1, nCells
+ vertViscTopOfCell(:, iCell) = vertViscTopOfCell(:, iCell) + config_cvmix_background_viscosity
+ vertDiffTopOfCell(:, iCell) = vertDiffTopOfCell(:, iCell) + config_cvmix_background_diffusion
+ end do
+ !$omp end do
endif
!
@@ -271,32 +301,34 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
allocate(cvmix_variables % dzt(nVertLevels))
allocate(cvmix_variables % kpp_Tnonlocal_iface(nVertLevels+1))
allocate(cvmix_variables % kpp_Snonlocal_iface(nVertLevels+1))
- allocate(cvmix_variables % BulkRichardson_cntr(nVertLevels))
- allocate(sigma(nVertLevels))
allocate(Nsqr_iface(nVertLevels+1))
allocate(turbulentScalarVelocityScale(nVertLevels))
- allocate(tmp(nVertLevels+1))
allocate(RiSmoothed(nVertLevels+1))
allocate(BVFSmoothed(nVertLevels+1))
+ Nsqr_iface(:) = 0.0_RKIND
+ turbulentScalarVelocityScale(:) = 0.0_RKIND
+
+ call mpas_timer_start('cvmix cell loop', .false.)
+ !$omp do schedule(runtime) private(k, bulkRichardsonNumberStop, kIndexOBL, bulkRichardsonFlag)
do iCell = 1, nCells
! specify geometry/location
cvmix_variables % SeaSurfaceHeight = ssh(iCell)
cvmix_variables % Coriolis = fCell(iCell)
- cvmix_variables % lat = latCell(iCell) * 180.0 / 3.14
- cvmix_variables % lon = lonCell(iCell) * 180.0 / 3.14
+ cvmix_variables % lat = latCell(iCell) * 180.0_RKIND / 3.14_RKIND
+ cvmix_variables % lon = lonCell(iCell) * 180.0_RKIND / 3.14_RKIND
! fill vertical position of column
! CVMix assume top of ocean is at z=0, so building all z-coordinate data based on layerThickness
- cvmix_variables % zw_iface(1) = 0.0
- cvmix_variables % dzw(1) = layerThickness(1,iCell)/2.0
- cvmix_variables % zt_cntr(1) = -layerThickness(1,iCell)/2.0
+ cvmix_variables % zw_iface(1) = 0.0_RKIND
+ cvmix_variables % dzw(1) = layerThickness(1,iCell)/2.0_RKIND
+ cvmix_variables % zt_cntr(1) = -layerThickness(1,iCell)/2.0_RKIND
do k=2,maxLevelCell(iCell)
cvmix_variables % zw_iface(k) = cvmix_variables % zw_iface(k-1) - layerThickness(k-1,iCell)
- cvmix_variables % zt_cntr(k) = cvmix_variables % zw_iface(k) - layerThickness(k,iCell)/2.0
- cvmix_variables % dzw(k) = cvmix_variables % zt_cntr(k-1) - cvmix_variables % zt_cntr(k)
+ cvmix_variables % zt_cntr(k) = cvmix_variables % zw_iface(k) - layerThickness(k,iCell)/2.0_RKIND
+ cvmix_variables % dzw(k) = cvmix_variables % zt_cntr(k-1) - cvmix_variables % zt_cntr(k)
cvmix_variables % dzt(k) = layerThickness(k,iCell)
enddo
k = maxLevelCell(iCell)+1
@@ -305,8 +337,8 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
do k = maxLevelCell(iCell) + 1, nVertLevels
cvmix_variables % zw_iface(k+1) = cvmix_variables % zw_iface(maxLevelCell(iCell)+1)
cvmix_variables % zt_cntr(k) = cvmix_variables % zw_iface(maxLevelCell(iCell)+1)
- cvmix_variables % dzw(k+1) = 0.0
- cvmix_variables % dzt(k) = 0.0
+ cvmix_variables % dzw(k+1) = 0.0_RKIND
+ cvmix_variables % dzt(k) = 0.0_RKIND
enddo
! fill the intent(in) convective adjustment
@@ -325,14 +357,37 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
cvmix_variables%ShearRichardson_iface => RiSmoothed
! fill BVF
- BVFSmoothed(1:nVertLevels) = BruntVaisalaFreqTop(1:nVertLevels,iCell)
- BVFSmoothed(nVertLevels+1) = BVFSmoothed(nVertLevels)
+ BVFSmoothed(1:nVertLevels) = max(0.0_RKIND,BruntVaisalaFreqTop(1:nVertLevels,iCell))
+ BVFSmoothed(nVertLevels+1) = max(0.0_RKIND,BVFSmoothed(nVertLevels))
cvmix_variables%SqrBuoyancyFreq_iface => BVFSmoothed
! fill the intent(in) KPP
cvmix_variables % SurfaceFriction = surfaceFrictionVelocity(iCell)
cvmix_variables % SurfaceBuoyancyForcing = surfaceBuoyancyForcing(iCell)
+ cvmix_variables % BulkRichardson_cntr => bulkRichardsonNumber(:, iCell)
+ if (config_use_cvmix_shear) then
+
+ cvmix_variables % Mdiff_iface(:)=0.0_RKIND
+ cvmix_variables % Tdiff_iface(:)=0.0_RKIND
+ call cvmix_coeffs_shear( &
+ cvmix_variables, &
+ cvmix_shear_params)
+ ! add shear mixing to vertical viscosity/diffusivity
+ ! at present, shear mixing adds in background values when using PP, but background is
+ ! accounted for seperately. so remove bac kground from shear mixing values
+
+ if(config_cvmix_shear_mixing_scheme=='PP') then
+ cvmix_variables % Mdiff_iface(:) = cvmix_variables % Mdiff_iface(:) - config_cvmix_background_viscosity
+ cvmix_variables % Tdiff_iface(:) = cvmix_variables % Tdiff_iface(:) - config_cvmix_background_diffusion
+ endif
+
+ do k = 1, maxLevelCell(iCell)
+ vertViscTopOfCell(k, iCell) = vertViscTopOfCell(k, iCell) + cvmix_variables % Mdiff_iface(k)
+ vertDiffTopOfCell(k, iCell) = vertDiffTopOfCell(k, iCell) + cvmix_variables % Tdiff_iface(k)
+ end do
+
+ endif ! if (config_use_cvmix_shear)
! call kpp ocean mixed layer scheme
if (cvmixKPPOn) then
@@ -342,6 +397,10 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
if (config_use_cvmix_fixed_boundary_layer) then
cvmix_variables % BoundaryLayerDepth = config_cvmix_kpp_boundary_layer_depth
+ cvmix_variables % kOBL_depth = cvmix_kpp_compute_kOBL_depth( &
+ zw_iface = cvmix_variables%zw_iface(1:nVertLevels+1), &
+ zt_cntr = cvmix_variables%zt_cntr(1:nVertLevels), &
+ OBL_depth = cvmix_variables % BoundaryLayerDepth )
else
@@ -355,81 +414,104 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
! compute bulk Richardson number
! assume boundary layer depth is at bottom of every kIndexOBL cell
bulkRichardsonNumberStop = config_cvmix_kpp_stop_OBL_search * config_cvmix_kpp_criticalBulkRichardsonNumber
- bulkRichardsonNumber(:,iCell) = bulkRichardsonNumberStop - 1.0
- kIndexOBL=1
+ bulkRichardsonNumber(:,iCell) = bulkRichardsonNumberStop - 1.0_RKIND
bulkRichardsonFlag = .false.
- do while (.not.bulkRichardsonFlag)
-
- ! set OBL at bottome of kIndexOBL cell for computation of bulk Richardson number
- cvmix_variables % BoundaryLayerDepth = cvmix_variables % zw_iface(kIndexOBL+1)
-
- ! define sigma based on assumption of where OBL bottom resides
- do k=1,maxLevelCell(iCell)
- sigma(k) = -cvmix_variables % zt_cntr(k) / cvmix_variables % BoundaryLayerDepth
- enddo
- do k=maxLevelCell(iCell)+1,nVertLevels
- sigma(k) = sigma(maxLevelCell(iCell))
- enddo
-
+! call mpas_timer_start('Bulk Richardson kIndexOBL loop')
+ do kIndexOBL = 1, maxLevelCell(iCell)
+
+ ! set OBL at bottom of kIndexOBL cell for computation of bulk Richardson number
+ cvmix_variables % BoundaryLayerDepth = abs(cvmix_variables % zw_iface(kIndexOBL+1))
+ sigma = -cvmix_variables % zt_cntr(kIndexOBL) / cvmix_variables % BoundaryLayerDepth
+
! compute the turbulent scales in order to compute the bulk Richardson number
call cvmix_kpp_compute_turbulent_scales( &
- sigma_coord = sigma(1:nVertLevels), &
+ sigma_coord = sigma, &
OBL_depth = cvmix_variables % BoundaryLayerDepth, &
surf_buoy_force = cvmix_variables % SurfaceBuoyancyForcing, &
surf_fric_vel = cvmix_variables % SurfaceFriction, &
- w_s = turbulentScalarVelocityScale(1:nVertLevels))
-
- cvmix_variables % BulkRichardson_cntr = cvmix_kpp_compute_bulk_Richardson( &
- zt_cntr = cvmix_variables % zt_cntr(1:nVertLevels), &
- delta_buoy_cntr = bulkRichardsonNumberBuoy(1:nVertLevels,iCell), &
- delta_Vsqr_cntr = bulkRichardsonNumberShear(1:nVertLevels,iCell), &
- ws_cntr = turbulentScalarVelocityScale(:), &
- Nsqr_iface = Nsqr_iface(1:nVertLevels+1) )
-
- unresolvedShear(:,iCell) = cvmix_kpp_compute_unresolved_shear( &
- zt_cntr = cvmix_variables % zt_cntr(1:nVertLevels), &
- ws_cntr = turbulentScalarVelocityScale(1:nVertLevels), &
- Nsqr_iface = Nsqr_iface(1:nVertLevels+1))
-
- ! each level of bulk Richardson is computed as if OBL resided at bottom of that level
- bulkRichardsonNumber(kIndexOBL,iCell) = cvmix_variables % BulkRichardson_cntr(kIndexOBL)
-
- ! test to see if search should be ended
- if(kIndexOBL.eq.maxLevelCell(iCell)) bulkRichardsonFlag=.true.
- if(bulkRichardsonNumber(kIndexOBL,iCell).gt.bulkRichardsonNumberStop) bulkRichardsonFlag=.true.
-
- ! move downward one level
- kIndexOBL = kIndexOBL + 1
-
- enddo ! do while (.not.bulkRichardsonFlag)
-
- call cvmix_kpp_compute_OBL_depth( &
- Ri_bulk = bulkRichardsonNumber(1:nVertLevels,iCell), &
- zw_iface = cvmix_variables % zw_iface(1:nVertLevels+1), &
- OBL_depth = cvmix_variables % BoundaryLayerDepth, &
- kOBL_depth = cvmix_variables % kOBL_depth, &
- zt_cntr = cvmix_variables % zt_cntr(1:nVertLevels), &
- surf_fric = cvmix_variables % SurfaceFriction, &
- surf_buoy = cvmix_variables % SurfaceBuoyancyForcing, &
- Coriolis = cvmix_variables % Coriolis)
+ w_s = turbulentScalarVelocityScale(kIndexOBL))
+
+ ! averaging over a surface layer assuming that BLdepth is cell bottom
+
+ ! move progressively downward to find the bottom most layer within the surface layer
+ sfc_layer_depth = cvmix_variables % BoundaryLayerDepth * config_cvmix_kpp_surface_layer_extent
+ do kav=1,kIndexOBL
+ if(cvmix_variables%zw_iface(kav+1) < -sfc_layer_depth) exit
+ enddo
+
+ !compute shear contribution assuming BLdepth is cell bottom
+
+ invAreaCell = 1.0_RKIND / areaCell(iCell)
+ deltaVelocitySquared = 0.0_RKIND
+ do i=1,nEdgesOnCell(iCell)
+ iEdge = edgesOnCell(i,iCell)
+
+ normalVelocityAv = sum(normalVelocity(1:kav,iEdge))/real(kav, kind=RKIND)
+ factor = 0.5_RKIND * dcEdge(iEdge) * dvEdge(iEdge) * invAreaCell
+ delU2 = (normalVelocityAv - normalVelocity(kIndexOBL,iEdge))**2
+ deltaVelocitySquared = deltaVelocitySquared + factor * delU2
+ enddo
+
+ bulkRichardsonNumberShear(kIndexOBL,iCell) = max(deltaVelocitySquared, 1.0e-15_RKIND)
+
+ bulkRichardsonNumberBuoy(kIndexOBL,iCell) = gravity * (potentialDensity(kIndexOBL,iCell) - &
+ sum(potentialDensity(1:kav,iCell))/real(kav, kind=RKIND)) / rho_sw
+
+ enddo ! do kIndexOBL
+! call mpas_timer_stop('Bulk Richardson kIndexOBL loop')
+
+ cvmix_variables % bulkRichardson_cntr(:) = cvmix_kpp_compute_bulk_Richardson( &
+ zt_cntr = cvmix_variables % zt_cntr(1:nVertLevels), &
+ delta_buoy_cntr = bulkRichardsonNumberBuoy(1:nVertLevels,iCell), &
+ delta_Vsqr_cntr = bulkRichardsonNumberShear(1:nVertLevels,iCell), &
+ ws_cntr = turbulentScalarVelocityScale(:), &
+ Nsqr_iface = Nsqr_iface(1:nVertLevels+1) )
+
+ ! each level of bulk Richardson is computed as if OBL resided at bottom of that level
+
+ call cvmix_kpp_compute_OBL_depth( &
+ Ri_bulk = bulkRichardsonNumber(1:nVertLevels,iCell), &
+ zw_iface = cvmix_variables % zw_iface(1:nVertLevels+1), &
+ OBL_depth = cvmix_variables % BoundaryLayerDepth, &
+ kOBL_depth = cvmix_variables % kOBL_depth, &
+ zt_cntr = cvmix_variables % zt_cntr(1:nVertLevels), &
+ surf_fric = cvmix_variables % SurfaceFriction, &
+ surf_buoy = cvmix_variables % SurfaceBuoyancyForcing, &
+ Coriolis = cvmix_variables % Coriolis)
endif ! if (config_use_cvmix_fixed_boundary_layer) then
! apply minimum limit to OBL
- if(cvmix_variables % BoundaryLayerDepth .lt. layerThickness(1,iCell)/2.0) then
- cvmix_variables % BoundaryLayerDepth = layerThickness(1,iCell)/2.0
+ if(cvmix_variables % BoundaryLayerDepth .lt. layerThickness(1,iCell)/2.0_RKIND) then
+ cvmix_variables % BoundaryLayerDepth = layerThickness(1,iCell)/2.0_RKIND
+ cvmix_variables % kOBL_depth = cvmix_kpp_compute_kOBL_depth( &
+ zw_iface = cvmix_variables%zw_iface(1:nVertLevels+1),&
+ zt_cntr = cvmix_variables%zt_cntr(1:nVertLevels), &
+ OBL_depth = cvmix_variables % BoundaryLayerDepth )
+ endif
+
+ ! apply minimum limit to OBL under sea-ice
+ if(iceFraction(iCell).gt.0.15_RKIND) then
+ if(cvmix_variables % BoundaryLayerDepth .lt. configure_cvmix_kpp_minimum_OBL_under_sea_ice) then
+ cvmix_variables % BoundaryLayerDepth = configure_cvmix_kpp_minimum_OBL_under_sea_ice
+ cvmix_variables % kOBL_depth = cvmix_kpp_compute_kOBL_depth( &
+ zw_iface = cvmix_variables%zw_iface(1:nVertLevels+1),&
+ zt_cntr = cvmix_variables%zt_cntr(1:nVertLevels), &
+ OBL_depth = cvmix_variables % BoundaryLayerDepth )
+ endif
endif
! apply maximum limit to OBL
if(cvmix_variables % BoundaryLayerDepth .gt. abs(cvmix_variables%zt_cntr(maxLevelCell(iCell)))) then
cvmix_variables % BoundaryLayerDepth = abs(cvmix_variables%zt_cntr(maxLevelCell(iCell)))
- endif
-
- cvmix_variables % kOBL_depth = cvmix_kpp_compute_kOBL_depth( &
+ cvmix_variables % kOBL_depth = cvmix_kpp_compute_kOBL_depth( &
zw_iface = cvmix_variables%zw_iface(1:nVertLevels+1), &
zt_cntr = cvmix_variables%zt_cntr(1:nVertLevels), &
OBL_depth = cvmix_variables % BoundaryLayerDepth )
+ endif
+
+! call mpas_timer_start('cvmix coeffs kpp', .false.)
call cvmix_coeffs_kpp( &
Mdiff_out = cvmix_variables % Mdiff_iface(1:nVertLevels+1), &
Tdiff_out = cvmix_variables % Tdiff_iface(1:nVertLevels+1), &
@@ -447,21 +529,26 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
surf_buoy = cvmix_variables%SurfaceBuoyancyForcing, &
nlev = maxLevelCell(iCell), &
max_nlev = nVertLevels)
+! call mpas_timer_stop('cvmix coeffs kpp')
! intent out of BoundaryLayerDepth is boundary layer depth measured in meters and vertical index
boundaryLayerDepth(iCell) = cvmix_variables % BoundaryLayerDepth
indexBoundaryLayerDepth(iCell) = cvmix_variables % kOBL_depth
- ! if using KPP with "MatchBoth" matching, then the output from KPP is the full viscosity/diffusivity
- ! if using KPP with "SimpleShape" matching, then the output from KPP needs to be added to current viscosity/diffusivity
- if(config_cvmix_kpp_matching.eq."MatchBoth") then
- vertViscTopOfCell(:,iCell) = cvmix_variables % Mdiff_iface(:)
- vertDiffTopOfCell(:,iCell) = cvmix_variables % Tdiff_iface(:)
- elseif(config_cvmix_kpp_matching.eq."SimpleShapes") then
- vertViscTopOfCell(:,iCell) = vertViscTopOfCell(:,iCell) + cvmix_variables % Mdiff_iface(:)
- vertDiffTopOfCell(:,iCell) = vertDiffTopOfCell(:,iCell) + cvmix_variables % Tdiff_iface(:)
+
+
+ if(config_cvmix_kpp_matching .eq. 'SimpleShapes') then
+ do k = 1, int(indexBoundaryLayerDepth(iCell))
+ vertViscTopOfCell(k,iCell) = vertViscTopOfCell(k,iCell) + cvmix_variables % Mdiff_iface(k)
+ vertDiffTopOfCell(k,iCell) = vertDiffTopOfCell(k,iCell) + cvmix_variables % Tdiff_iface(k)
+ end do
+ do k = int(indexBoundaryLayerDepth(iCell))+1, maxLevelCell(iCell)+1
+ vertViscTopOfCell(k,iCell) = cvmix_variables % Mdiff_iface(k)
+ vertDiffTopOfCell(k,iCell) = cvmix_variables % Tdiff_iface(k)
+ enddo
else
- stop
+ vertViscTopOfCell(:,iCell) = cvmix_variables % Mdiff_iface(:)
+ vertDiffTopOfCell(:,iCell) = cvmix_variables % Tdiff_iface(:)
endif
! store non-local flux terms
@@ -474,8 +561,8 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
! call convective mixing scheme
if (config_use_cvmix_convection) then
- cvmix_variables % Mdiff_iface(:)=0.0
- cvmix_variables % Tdiff_iface(:)=0.0
+ cvmix_variables % Mdiff_iface(:)=0.0_RKIND
+ cvmix_variables % Tdiff_iface(:)=0.0_RKIND
call cvmix_coeffs_conv( CVmix_vars = cvmix_variables )
! add convective mixing to vertical viscosity/diffusivity
@@ -491,33 +578,6 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
endif
endif ! if (config_use_cvmix_convection)
- ! call shear-based mixing scheme
- if (config_use_cvmix_shear) then
- cvmix_variables % Mdiff_iface(:)=0.0
- cvmix_variables % Tdiff_iface(:)=0.0
- call cvmix_coeffs_shear( &
- cvmix_variables, &
- cvmix_shear_params)
-
- ! add shear mixing to vertical viscosity/diffusivity
- ! at present, shear mixing adds in background values when using PP, but background is accounted for seperately. so remove background from shear mixing values
- if(config_cvmix_shear_mixing_scheme=='PP') then
- cvmix_variables % Mdiff_iface(:) = cvmix_variables % Mdiff_iface(:) - config_cvmix_background_viscosity
- cvmix_variables % Tdiff_iface(:) = cvmix_variables % Tdiff_iface(:) - config_cvmix_background_diffusion
- endif
-
- if(config_use_cvmix_kpp) then
- do k = int(indexBoundaryLayerDepth(iCell)) + 1, maxLevelCell(iCell)
- vertViscTopOfCell(k,iCell) = vertViscTopOfCell(k,iCell) + cvmix_variables % Mdiff_iface(k)
- vertDiffTopOfCell(k,iCell) = vertDiffTopOfCell(k,iCell) + cvmix_variables % Tdiff_iface(k)
- enddo
- else
- vertViscTopOfCell(:,iCell) = vertViscTopOfCell(:,iCell) + cvmix_variables % Mdiff_iface(:)
- vertDiffTopOfCell(:,iCell) = vertDiffTopOfCell(:,iCell) + cvmix_variables % Tdiff_iface(:)
- endif
-
- endif ! if (config_use_cvmix_shear)
-
!
! put tidal mixing here
!
@@ -529,27 +589,28 @@ subroutine ocn_vmix_coefs_cvmix_build(meshPool, statePool, diagnosticsPool, err,
! computation of viscosity/diffusivity complete
! impose no-flux boundary conditions at top and bottom by zero viscosity/diffusivity
- vertViscTopOfCell(1,iCell) = 0.0
- vertDiffTopOfCell(1,iCell) = 0.0
- vertViscTopOfCell(maxLevelCell(iCell)+1:nVertLevels,iCell)=0.0
- vertDiffTopOfCell(maxLevelCell(iCell)+1:nVertLevels,iCell)=0.0
+ vertViscTopOfCell(1,iCell) = 0.0_RKIND
+ vertDiffTopOfCell(1,iCell) = 0.0_RKIND
+ vertViscTopOfCell(maxLevelCell(iCell)+1:nVertLevels,iCell)=0.0_RKIND
+ vertDiffTopOfCell(maxLevelCell(iCell)+1:nVertLevels,iCell)=0.0_RKIND
end do ! do iCell=1,mesh%nCells
+ !$omp end do
+ call mpas_timer_stop('cvmix cell loop')
! dellocate cmvix variables
deallocate(cvmix_variables % Mdiff_iface)
deallocate(cvmix_variables % Tdiff_iface)
+ deallocate(cvmix_variables % Sdiff_iface)
deallocate(cvmix_variables % zw_iface)
deallocate(cvmix_variables % dzw)
deallocate(cvmix_variables % zt_cntr)
deallocate(cvmix_variables % dzt)
deallocate(cvmix_variables % kpp_Tnonlocal_iface)
- deallocate(cvmix_variables % BulkRichardson_cntr)
+ deallocate(cvmix_variables % kpp_Snonlocal_iface)
- deallocate(sigma)
deallocate(Nsqr_iface)
deallocate(turbulentScalarVelocityScale)
- deallocate(tmp)
deallocate(RiSmoothed)
deallocate(BVFSmoothed)
@@ -565,8 +626,8 @@ end subroutine ocn_vmix_coefs_cvmix_build!}}}
!> \ get and puts into CVMix
!> \author Todd Ringler
!> \date 04 February 2013
-!> \details
-!> This routine initializes a variety of quantities related to
+!> \details
+!> This routine initializes a variety of quantities related to
!> vertical mixing in the ocean. Parameters are set by calling into CVMix
!
!-----------------------------------------------------------------------
@@ -607,7 +668,8 @@ subroutine ocn_vmix_cvmix_init(domain,err)!{{{
! Convection configs
logical, pointer :: config_use_cvmix_convection
- real (kind=RKIND), pointer :: config_cvmix_convective_diffusion, config_cvmix_convective_viscosity, config_cvmix_convective_triggerBVF
+ real (kind=RKIND), pointer :: config_cvmix_convective_diffusion, config_cvmix_convective_viscosity, &
+ config_cvmix_convective_triggerBVF
logical, pointer :: config_cvmix_convective_basedOnBVF
! Tidal mixing
@@ -646,7 +708,8 @@ subroutine ocn_vmix_cvmix_init(domain,err)!{{{
call mpas_pool_get_config(ocnConfigs, 'config_use_cvmix_tidal_mixing', config_use_cvmix_tidal_mixing)
call mpas_pool_get_config(ocnConfigs, 'config_use_cvmix_double_diffusion', config_use_cvmix_double_diffusion)
call mpas_pool_get_config(ocnConfigs, 'config_use_cvmix_kpp', config_use_cvmix_kpp)
- call mpas_pool_get_config(ocnConfigs, 'config_cvmix_kpp_criticalBulkRichardsonNumber', config_cvmix_kpp_criticalBulkRichardsonNumber)
+ call mpas_pool_get_config(ocnConfigs, 'config_cvmix_kpp_criticalBulkRichardsonNumber', &
+ config_cvmix_kpp_criticalBulkRichardsonNumber)
call mpas_pool_get_config(ocnConfigs, 'config_cvmix_kpp_stop_OBL_search', config_cvmix_kpp_stop_OBL_search)
call mpas_pool_get_config(ocnConfigs, 'config_cvmix_kpp_interpolationOMLType', config_cvmix_kpp_interpolationOMLType)
call mpas_pool_get_config(ocnConfigs, 'config_cvmix_kpp_interpolationOMLType', config_cvmix_kpp_interpolationOMLType)
@@ -757,6 +820,15 @@ subroutine ocn_vmix_cvmix_init(domain,err)!{{{
! initialize KPP boundary layer scheme
!
if (config_use_cvmix_kpp) then
+ if(config_cvmix_kpp_matching.eq."MatchBoth") then
+ write(stderrUnit,*) "WARNING: use of option MatchBoth is discouraged, use SimpleShapes instead"
+ elseif(.not. config_cvmix_kpp_matching.eq."SimpleShapes") then
+ write(stderrUnit,*) "ERROR: unknown value for config_cvmix_kpp_matching., supported values are:"
+ write(stderrUnit,*) " SimpleShapes or MatchBoth"
+ err = 1
+ return
+ endif
+
call cvmix_init_kpp ( &
ri_crit = config_cvmix_kpp_criticalBulkRichardsonNumber, &
interp_type = config_cvmix_kpp_interpolationOMLType, &
diff --git a/src/core_ocean/tracer_groups/Registry_DMS.xml b/src/core_ocean/tracer_groups/Registry_DMS.xml
new file mode 100644
index 0000000000..b72771e6bf
--- /dev/null
+++ b/src/core_ocean/tracer_groups/Registry_DMS.xml
@@ -0,0 +1,192 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/tracer_groups/Registry_MacroMolecules.xml b/src/core_ocean/tracer_groups/Registry_MacroMolecules.xml
new file mode 100644
index 0000000000..dfb497c5a7
--- /dev/null
+++ b/src/core_ocean/tracer_groups/Registry_MacroMolecules.xml
@@ -0,0 +1,190 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/tracer_groups/Registry_TEMPLATEGRP.xml b/src/core_ocean/tracer_groups/Registry_TEMPLATEGRP.xml
new file mode 100644
index 0000000000..e2e908f0e0
--- /dev/null
+++ b/src/core_ocean/tracer_groups/Registry_TEMPLATEGRP.xml
@@ -0,0 +1,68 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/tracer_groups/Registry_activeTracers.xml b/src/core_ocean/tracer_groups/Registry_activeTracers.xml
new file mode 100644
index 0000000000..9b94bd91e5
--- /dev/null
+++ b/src/core_ocean/tracer_groups/Registry_activeTracers.xml
@@ -0,0 +1,161 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/tracer_groups/Registry_debugTracers.xml b/src/core_ocean/tracer_groups/Registry_debugTracers.xml
new file mode 100644
index 0000000000..2f176e61fb
--- /dev/null
+++ b/src/core_ocean/tracer_groups/Registry_debugTracers.xml
@@ -0,0 +1,115 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/tracer_groups/Registry_ecosys.xml b/src/core_ocean/tracer_groups/Registry_ecosys.xml
new file mode 100644
index 0000000000..cff4125dc9
--- /dev/null
+++ b/src/core_ocean/tracer_groups/Registry_ecosys.xml
@@ -0,0 +1,1267 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/core_ocean/tracer_groups/Registry_tracers.xml b/src/core_ocean/tracer_groups/Registry_tracers.xml
new file mode 100644
index 0000000000..ce11f75662
--- /dev/null
+++ b/src/core_ocean/tracer_groups/Registry_tracers.xml
@@ -0,0 +1,6 @@
+#include "Registry_activeTracers.xml"
+#include "Registry_debugTracers.xml"
+#include "Registry_ecosys.xml"
+#include "Registry_DMS.xml"
+#include "Registry_MacroMolecules.xml"
+//#include "Registry_TEMPLATEGRP.xml"
diff --git a/test_cases/ocean/general.config.ocean b/test_cases/ocean/general.config.ocean
index c537fe6936..72beefba61 100644
--- a/test_cases/ocean/general.config.ocean
+++ b/test_cases/ocean/general.config.ocean
@@ -9,8 +9,8 @@
# init namelists in the default_inputs directory after a successful build of
# the ocean model.
[namelists]
-forward = FULL_PATH_TO_FORWARD_TEMPLATE_NAMELIST
-init = FULL_PATH_TO_INIT_TEMPLATE_NAMELIST
+forward = /users/nilsfeige/git/moc_streamfunctionAM/namelist.ocean.forward
+init = /users/nilsfeige/git/moc_streamfunctionAM/namelist.ocean.init
# The streams section defines paths to template streams files that will be used
@@ -18,8 +18,8 @@ init = FULL_PATH_TO_INIT_TEMPLATE_NAMELIST
# init streams files in the default_inputs directory after a successful build of
# the ocean model.
[streams]
-forward = FULL_PATH_TO_FORWARD_TEMPLATE_STREAMS
-init = FULL_PATH_TO_INIT_TEMPLATE_STREAMS
+forward = /users/nilsfeige/git/moc_streamfunctionAM/streams.ocean.forward
+init = /users/nilsfeige/git/moc_streamfunctionAM/streams.ocean.init
# The executables section defines paths to required executables. These
@@ -27,11 +27,10 @@ init = FULL_PATH_TO_INIT_TEMPLATE_STREAMS
# Full paths should be provided in order to access the executables from
# anywhere on the machine.
[executables]
-model = FULL_PATH_TO_MODEL
-mesh_converter = FULL_PATH_TO_MESH_CONVERTER
-cell_culler = FULL_PATH_TO_CELL_CULLER
-metis = FULL_PATH_TO_METIS
-
+model = /users/nilsfeige/git/moc_streamfunctionAM/ocean_model
+mesh_converter = /turquoise/usr/projects/climate/mpeterse/mpas-tools_git/MPAS-Tools/grid_gen/mesh_conversion_tools/MpasMeshConverter.x
+cell_culler = /turquoise/usr/projects/climate/mpeterse/mpas-tools_git/MPAS-Tools/grid_gen/mesh_conversion_tools/MpasCellCuller.x
+metis = /turquoise/usr/projects/climate/mpeterse/software/metis-5.1.0/build/Linux-x86_64/programs/gpmetis
# The paths section describes paths that are used within the ocean core test
# cases.
@@ -42,5 +41,5 @@ metis = FULL_PATH_TO_METIS
# the same directory, or different directory. Additionally, if they are empty
# some test cases might download data into them, which will then be reused if
# the test case is run again later.
-mesh_database = FULL_PATH_TO_LOCAL_MESH_DATABASE
-initial_condition_database = FULL_PATH_TO_LOCAL_INITIAL_CONDITION_DATABASE
+mesh_database = /usr/projects/regionalclimate/COMMON_MPAS/ocean/grids/mesh_database
+initial_condition_database = /usr/projects/regionalclimate/COMMON_MPAS/ocean/grids/initial_condition_database
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/baroclinic_channel_10km_template.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/baroclinic_channel_10km_template.xml
new file mode 100644
index 0000000000..1a6ee9261e
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/baroclinic_channel_10km_template.xml
@@ -0,0 +1,39 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+ output
+ output.nc
+ 0000_00:00:01
+ truncate
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/decomp_test/config_4proc_run.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/decomp_test/config_4proc_run.xml
new file mode 100644
index 0000000000..2b5fb6d1c7
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/decomp_test/config_4proc_run.xml
@@ -0,0 +1,23 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/decomp_test/config_8proc_run.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/decomp_test/config_8proc_run.xml
new file mode 100644
index 0000000000..b115b563b8
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/decomp_test/config_8proc_run.xml
@@ -0,0 +1,23 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 8
+
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/decomp_test/config_driver.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/decomp_test/config_driver.xml
new file mode 100644
index 0000000000..df16eabc87
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/decomp_test/config_driver.xml
@@ -0,0 +1,19 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/decomp_test/config_init1.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/decomp_test/config_init1.xml
new file mode 100644
index 0000000000..aefd192a95
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/decomp_test/config_init1.xml
@@ -0,0 +1,63 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/decomp_test/config_init2.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/decomp_test/config_init2.xml
new file mode 100644
index 0000000000..1aff18fb70
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/decomp_test/config_init2.xml
@@ -0,0 +1,50 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/default/config_driver.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/default/config_driver.xml
new file mode 100644
index 0000000000..3e7a3fad37
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/default/config_driver.xml
@@ -0,0 +1,11 @@
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/default/config_forward.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/default/config_forward.xml
new file mode 100644
index 0000000000..4d403680d6
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/default/config_forward.xml
@@ -0,0 +1,23 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/default/config_init1.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/default/config_init1.xml
new file mode 100644
index 0000000000..aefd192a95
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/default/config_init1.xml
@@ -0,0 +1,63 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/default/config_init2.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/default/config_init2.xml
new file mode 100644
index 0000000000..1aff18fb70
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/default/config_init2.xml
@@ -0,0 +1,50 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/config_driver.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/config_driver.xml
new file mode 100644
index 0000000000..26852eca5f
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/config_driver.xml
@@ -0,0 +1,19 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/config_full_run.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/config_full_run.xml
new file mode 100644
index 0000000000..62b720a2de
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/config_full_run.xml
@@ -0,0 +1,26 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/config_init1.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/config_init1.xml
new file mode 100644
index 0000000000..aefd192a95
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/config_init1.xml
@@ -0,0 +1,63 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/config_init2.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/config_init2.xml
new file mode 100644
index 0000000000..1aff18fb70
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/config_init2.xml
@@ -0,0 +1,50 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/config_restart_run.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/config_restart_run.xml
new file mode 100644
index 0000000000..dc09fa5ef4
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/config_restart_run.xml
@@ -0,0 +1,31 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 0000-00-00_00:05:00
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/restart_setup_template.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/restart_setup_template.xml
new file mode 100644
index 0000000000..aa3af304b8
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/restart_test/restart_setup_template.xml
@@ -0,0 +1,17 @@
+
+
+
+
+
+
+
+
+ 0000-00-00_00:10:00
+
+
+ ../restarts/rst.$Y-$M-$D_$h.$m.$s.nc
+ output_interval
+ 0000-00-00_00:00:01
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/threads_test/config_4proc_run.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/threads_test/config_4proc_run.xml
new file mode 100644
index 0000000000..64ceb286ae
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/threads_test/config_4proc_run.xml
@@ -0,0 +1,23 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/threads_test/config_8proc_run.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/threads_test/config_8proc_run.xml
new file mode 100644
index 0000000000..d720bc16f0
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/threads_test/config_8proc_run.xml
@@ -0,0 +1,23 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/threads_test/config_driver.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/threads_test/config_driver.xml
new file mode 100644
index 0000000000..46562f3895
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/threads_test/config_driver.xml
@@ -0,0 +1,19 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/threads_test/config_init1.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/threads_test/config_init1.xml
new file mode 100644
index 0000000000..aefd192a95
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/threads_test/config_init1.xml
@@ -0,0 +1,63 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/baroclinic_channel/10km/threads_test/config_init2.xml b/test_cases/ocean/ocean/baroclinic_channel/10km/threads_test/config_init2.xml
new file mode 100644
index 0000000000..1aff18fb70
--- /dev/null
+++ b/test_cases/ocean/ocean/baroclinic_channel/10km/threads_test/config_init2.xml
@@ -0,0 +1,50 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/EC_60to30km/default/.gitignore b/test_cases/ocean/ocean/global_ocean/EC_60to30km/default/.gitignore
new file mode 100644
index 0000000000..ac604177b2
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/EC_60to30km/default/.gitignore
@@ -0,0 +1,4 @@
+run_test.py
+init_step1
+init_step2
+forward
diff --git a/test_cases/ocean/ocean/global_ocean/EC_60to30km/default/config_driver.xml b/test_cases/ocean/ocean/global_ocean/EC_60to30km/default/config_driver.xml
new file mode 100644
index 0000000000..b7cb2881ce
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/EC_60to30km/default/config_driver.xml
@@ -0,0 +1,16 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/EC_60to30km/default/config_forward.xml b/test_cases/ocean/ocean/global_ocean/EC_60to30km/default/config_forward.xml
new file mode 100644
index 0000000000..a743c7ca6f
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/EC_60to30km/default/config_forward.xml
@@ -0,0 +1,37 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+
+
+
+
+
+
+
+ 16
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/EC_60to30km/default/config_init1.xml b/test_cases/ocean/ocean/global_ocean/EC_60to30km/default/config_init1.xml
new file mode 100644
index 0000000000..154856c4a5
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/EC_60to30km/default/config_init1.xml
@@ -0,0 +1,62 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+
+
+ 16
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/EC_60to30km/default/config_init2.xml b/test_cases/ocean/ocean/global_ocean/EC_60to30km/default/config_init2.xml
new file mode 100644
index 0000000000..f0db37541b
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/EC_60to30km/default/config_init2.xml
@@ -0,0 +1,30 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 16
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/.gitignore b/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/.gitignore
new file mode 100644
index 0000000000..cfbea0f3d5
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/.gitignore
@@ -0,0 +1,5 @@
+run_test.py
+init_step1
+init_step2
+spin_up1
+forward
diff --git a/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/config_driver.xml b/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/config_driver.xml
new file mode 100644
index 0000000000..a140e32d49
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/config_driver.xml
@@ -0,0 +1,19 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/config_forward.xml b/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/config_forward.xml
new file mode 100644
index 0000000000..df244c6d82
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/config_forward.xml
@@ -0,0 +1,49 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+ 00-00-10_00:00:00
+
+
+ 00-00-10_00:00:00
+
+
+
+
+
+
+
+
+
+
+ 16
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/config_init1.xml b/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/config_init1.xml
new file mode 100644
index 0000000000..154856c4a5
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/config_init1.xml
@@ -0,0 +1,62 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+
+
+ 16
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/config_init2.xml b/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/config_init2.xml
new file mode 100644
index 0000000000..f0db37541b
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/config_init2.xml
@@ -0,0 +1,30 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 16
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/config_spin_up1.xml b/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/config_spin_up1.xml
new file mode 100644
index 0000000000..f94f6ee8a5
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/EC_60to30km/spin_up/config_spin_up1.xml
@@ -0,0 +1,48 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+ 00-00-10_00:00:00
+
+
+ 00-00-10_00:00:00
+
+
+
+
+
+
+
+
+
+
+ 16
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/EC_60to30km/template_forward.xml b/test_cases/ocean/ocean/global_ocean/EC_60to30km/template_forward.xml
new file mode 100644
index 0000000000..aca5194862
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/EC_60to30km/template_forward.xml
@@ -0,0 +1,10 @@
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_120km/default/.gitignore b/test_cases/ocean/ocean/global_ocean/QU_120km/default/.gitignore
new file mode 100644
index 0000000000..ac604177b2
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_120km/default/.gitignore
@@ -0,0 +1,4 @@
+run_test.py
+init_step1
+init_step2
+forward
diff --git a/test_cases/ocean/ocean/global_ocean/QU_120km/default/config_driver.xml b/test_cases/ocean/ocean/global_ocean/QU_120km/default/config_driver.xml
new file mode 100644
index 0000000000..b7cb2881ce
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_120km/default/config_driver.xml
@@ -0,0 +1,16 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_120km/default/config_forward.xml b/test_cases/ocean/ocean/global_ocean/QU_120km/default/config_forward.xml
new file mode 100644
index 0000000000..4c0420bf64
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_120km/default/config_forward.xml
@@ -0,0 +1,37 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_120km/default/config_init1.xml b/test_cases/ocean/ocean/global_ocean/QU_120km/default/config_init1.xml
new file mode 100644
index 0000000000..f3fd844ea6
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_120km/default/config_init1.xml
@@ -0,0 +1,61 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+
+
+ 4
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_120km/default/config_init2.xml b/test_cases/ocean/ocean/global_ocean/QU_120km/default/config_init2.xml
new file mode 100644
index 0000000000..22cda7a0ac
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_120km/default/config_init2.xml
@@ -0,0 +1,32 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_120km/template_forward.xml b/test_cases/ocean/ocean/global_ocean/QU_120km/template_forward.xml
new file mode 100644
index 0000000000..bd63f91740
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_120km/template_forward.xml
@@ -0,0 +1,7 @@
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/.gitignore b/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/.gitignore
new file mode 100644
index 0000000000..9eb6188da3
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/.gitignore
@@ -0,0 +1,6 @@
+run_test.py
+init_step1
+init_step2
+init_iter
+forward_iter
+forward
diff --git a/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_driver.xml b/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_driver.xml
new file mode 100644
index 0000000000..b003d60e3c
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_driver.xml
@@ -0,0 +1,23 @@
+
+
+
+
+
+
+
+
+ --iteration_count=5
+ --plot_globalStats
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_forward.xml b/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_forward.xml
new file mode 100644
index 0000000000..381c9562f4
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_forward.xml
@@ -0,0 +1,48 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+
+ 00-01-00_00:00:00
+
+
+ 00-01-00_00:00:00
+
+
+
+
+
+
+
+
+
+
+ 16
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_forward_iter.xml b/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_forward_iter.xml
new file mode 100644
index 0000000000..31b306d684
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_forward_iter.xml
@@ -0,0 +1,55 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ic/ocean.nc
+
+
+ ic/ocean.nc
+
+
+
+
+ ic/init_mode_forcing_data.nc
+
+
+
+
+ truncate
+ 0000_00:00:01
+
+
+ output
+ ssh_ssp.nc
+ 0000_04:00:00
+ truncate
+
+
+
+
+
+
+
+
+
+ 16
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_init1.xml b/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_init1.xml
new file mode 100644
index 0000000000..1ecd8b6831
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_init1.xml
@@ -0,0 +1,65 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+
+
+ 16
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_init2.xml b/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_init2.xml
new file mode 100644
index 0000000000..fd0b2d6bd7
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_init2.xml
@@ -0,0 +1,33 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 16
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_init_iter.xml b/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_init_iter.xml
new file mode 100644
index 0000000000..3e9318e58f
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_init_iter.xml
@@ -0,0 +1,43 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ../forward_iter/ssh_ssp.nc
+ initial_only
+ input
+
+
+
+
+
+
+
+
+
+ 16
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_link_run_iter.xml b/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_link_run_iter.xml
new file mode 100644
index 0000000000..2646388fa3
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_120km/with_land_ice/config_link_run_iter.xml
@@ -0,0 +1,5 @@
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/default/.gitignore b/test_cases/ocean/ocean/global_ocean/QU_240km/default/.gitignore
new file mode 100644
index 0000000000..ac604177b2
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/default/.gitignore
@@ -0,0 +1,4 @@
+run_test.py
+init_step1
+init_step2
+forward
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/default/config_driver.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/default/config_driver.xml
new file mode 100644
index 0000000000..b7cb2881ce
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/default/config_driver.xml
@@ -0,0 +1,16 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/default/config_forward.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/default/config_forward.xml
new file mode 100644
index 0000000000..4c0420bf64
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/default/config_forward.xml
@@ -0,0 +1,37 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/default/config_init1.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/default/config_init1.xml
new file mode 100644
index 0000000000..b31b9b2a3d
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/default/config_init1.xml
@@ -0,0 +1,59 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/default/config_init2.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/default/config_init2.xml
new file mode 100644
index 0000000000..f784dddb13
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/default/config_init2.xml
@@ -0,0 +1,27 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/.gitignore b/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/.gitignore
new file mode 100644
index 0000000000..9156165578
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/.gitignore
@@ -0,0 +1,5 @@
+run_test.py
+init_step1
+init_step2
+full_run
+restart_run
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/config_driver.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/config_driver.xml
new file mode 100644
index 0000000000..0850782e97
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/config_driver.xml
@@ -0,0 +1,19 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/config_full_run.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/config_full_run.xml
new file mode 100644
index 0000000000..b8f4598ad3
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/config_full_run.xml
@@ -0,0 +1,38 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/config_init1.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/config_init1.xml
new file mode 100644
index 0000000000..b31b9b2a3d
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/config_init1.xml
@@ -0,0 +1,59 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/config_init2.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/config_init2.xml
new file mode 100644
index 0000000000..f784dddb13
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/config_init2.xml
@@ -0,0 +1,27 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/config_restart_run.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/config_restart_run.xml
new file mode 100644
index 0000000000..27051a9672
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/config_restart_run.xml
@@ -0,0 +1,44 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+
+
+
+
+ 0000_04:00:00
+
+
+
+
+
+ 4
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/restart_setup_template.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/restart_setup_template.xml
new file mode 100644
index 0000000000..da27389a05
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/restart_test/restart_setup_template.xml
@@ -0,0 +1,17 @@
+
+
+
+
+
+
+
+
+ 0000-00-00_08:00:00
+
+
+ ../restarts/rst.$Y-$M-$D_$h.$m.$s.nc
+ output_interval
+ 0000-00-00_00:00:01
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/.gitignore b/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/.gitignore
new file mode 100644
index 0000000000..62e53f2630
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/.gitignore
@@ -0,0 +1,5 @@
+run_test.py
+init_step1
+init_step2
+4blocks_run
+8blocks_run
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/config_4blocks_run.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/config_4blocks_run.xml
new file mode 100644
index 0000000000..4c0e664110
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/config_4blocks_run.xml
@@ -0,0 +1,38 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/config_8blocks_run.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/config_8blocks_run.xml
new file mode 100644
index 0000000000..24e5eec5a5
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/config_8blocks_run.xml
@@ -0,0 +1,39 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+
+
+
+
+
+
+ 8
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/config_driver.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/config_driver.xml
new file mode 100644
index 0000000000..42721c6d84
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/config_driver.xml
@@ -0,0 +1,19 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/config_init1.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/config_init1.xml
new file mode 100644
index 0000000000..b31b9b2a3d
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/config_init1.xml
@@ -0,0 +1,59 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/config_init2.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/config_init2.xml
new file mode 100644
index 0000000000..f784dddb13
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/rk4_blocks_test/config_init2.xml
@@ -0,0 +1,27 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/.gitignore b/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/.gitignore
new file mode 100644
index 0000000000..62e53f2630
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/.gitignore
@@ -0,0 +1,5 @@
+run_test.py
+init_step1
+init_step2
+4blocks_run
+8blocks_run
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/config_4blocks_run.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/config_4blocks_run.xml
new file mode 100644
index 0000000000..fe333cc435
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/config_4blocks_run.xml
@@ -0,0 +1,35 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/config_8blocks_run.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/config_8blocks_run.xml
new file mode 100644
index 0000000000..0021edc578
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/config_8blocks_run.xml
@@ -0,0 +1,36 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+
+
+
+
+
+
+ 8
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/config_driver.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/config_driver.xml
new file mode 100644
index 0000000000..42721c6d84
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/config_driver.xml
@@ -0,0 +1,19 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/config_init1.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/config_init1.xml
new file mode 100644
index 0000000000..b31b9b2a3d
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/config_init1.xml
@@ -0,0 +1,59 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/config_init2.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/config_init2.xml
new file mode 100644
index 0000000000..f784dddb13
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/se_blocks_test/config_init2.xml
@@ -0,0 +1,27 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/template_forward.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/template_forward.xml
new file mode 100644
index 0000000000..937506e95d
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/template_forward.xml
@@ -0,0 +1,8 @@
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_driver.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_driver.xml
new file mode 100644
index 0000000000..af5ed400ed
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_driver.xml
@@ -0,0 +1,23 @@
+
+
+
+
+
+
+
+
+ --iteration_count=5
+ --plot_globalStats
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_forward.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_forward.xml
new file mode 100644
index 0000000000..85f68db7f6
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_forward.xml
@@ -0,0 +1,43 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ic/ocean.nc
+
+
+ ic/ocean.nc
+
+
+
+
+
+ ic/init_mode_forcing_data.nc
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_forward_iter.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_forward_iter.xml
new file mode 100644
index 0000000000..5ab5d2a23b
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_forward_iter.xml
@@ -0,0 +1,55 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ic/ocean.nc
+
+
+ ic/ocean.nc
+
+
+
+
+ ic/init_mode_forcing_data.nc
+
+
+
+
+ truncate
+ 0000_00:00:01
+
+
+ output
+ ssh_ssp.nc
+ 0000_06:00:00
+ truncate
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_init1.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_init1.xml
new file mode 100644
index 0000000000..f3134598c9
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_init1.xml
@@ -0,0 +1,63 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_init2.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_init2.xml
new file mode 100644
index 0000000000..eabe8b530d
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_init2.xml
@@ -0,0 +1,30 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_init_iter.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_init_iter.xml
new file mode 100644
index 0000000000..ec7206e5da
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_init_iter.xml
@@ -0,0 +1,39 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ../forward_iter/ssh_ssp.nc
+ initial_only
+ input
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_link_run_iter.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_link_run_iter.xml
new file mode 100644
index 0000000000..2646388fa3
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice/config_link_run_iter.xml
@@ -0,0 +1,5 @@
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice_no_iter/.gitignore b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice_no_iter/.gitignore
new file mode 100644
index 0000000000..ac604177b2
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice_no_iter/.gitignore
@@ -0,0 +1,4 @@
+run_test.py
+init_step1
+init_step2
+forward
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice_no_iter/config_driver.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice_no_iter/config_driver.xml
new file mode 100644
index 0000000000..0a67622836
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice_no_iter/config_driver.xml
@@ -0,0 +1,19 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice_no_iter/config_forward.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice_no_iter/config_forward.xml
new file mode 100644
index 0000000000..f8ba30688a
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice_no_iter/config_forward.xml
@@ -0,0 +1,42 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice_no_iter/config_init1.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice_no_iter/config_init1.xml
new file mode 100644
index 0000000000..35685123ab
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice_no_iter/config_init1.xml
@@ -0,0 +1,86 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice_no_iter/config_init2.xml b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice_no_iter/config_init2.xml
new file mode 100644
index 0000000000..64bf75ff6b
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_240km/with_land_ice_no_iter/config_init2.xml
@@ -0,0 +1,55 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_480km/default/.gitignore b/test_cases/ocean/ocean/global_ocean/QU_480km/default/.gitignore
new file mode 100644
index 0000000000..ac604177b2
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_480km/default/.gitignore
@@ -0,0 +1,4 @@
+run_test.py
+init_step1
+init_step2
+forward
diff --git a/test_cases/ocean/ocean/global_ocean/QU_480km/default/config_driver.xml b/test_cases/ocean/ocean/global_ocean/QU_480km/default/config_driver.xml
new file mode 100644
index 0000000000..b7cb2881ce
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_480km/default/config_driver.xml
@@ -0,0 +1,16 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_480km/default/config_forward.xml b/test_cases/ocean/ocean/global_ocean/QU_480km/default/config_forward.xml
new file mode 100644
index 0000000000..4c0420bf64
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_480km/default/config_forward.xml
@@ -0,0 +1,37 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_480km/default/config_init1.xml b/test_cases/ocean/ocean/global_ocean/QU_480km/default/config_init1.xml
new file mode 100644
index 0000000000..37b664ed3c
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_480km/default/config_init1.xml
@@ -0,0 +1,54 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_480km/default/config_init2.xml b/test_cases/ocean/ocean/global_ocean/QU_480km/default/config_init2.xml
new file mode 100644
index 0000000000..f784dddb13
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_480km/default/config_init2.xml
@@ -0,0 +1,27 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/QU_480km/template_forward.xml b/test_cases/ocean/ocean/global_ocean/QU_480km/template_forward.xml
new file mode 100644
index 0000000000..937506e95d
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/QU_480km/template_forward.xml
@@ -0,0 +1,8 @@
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/RRS_30to10km/default/.gitignore b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/default/.gitignore
new file mode 100644
index 0000000000..ac604177b2
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/default/.gitignore
@@ -0,0 +1,4 @@
+run_test.py
+init_step1
+init_step2
+forward
diff --git a/test_cases/ocean/ocean/global_ocean/RRS_30to10km/default/config_driver.xml b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/default/config_driver.xml
new file mode 100644
index 0000000000..b7cb2881ce
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/default/config_driver.xml
@@ -0,0 +1,16 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/RRS_30to10km/default/config_forward.xml b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/default/config_forward.xml
new file mode 100644
index 0000000000..0bfcbfa9da
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/default/config_forward.xml
@@ -0,0 +1,37 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+
+
+
+
+
+
+
+ 480
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/RRS_30to10km/default/config_init1.xml b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/default/config_init1.xml
new file mode 100644
index 0000000000..33213c12ae
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/default/config_init1.xml
@@ -0,0 +1,61 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+
+
+ 480
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/RRS_30to10km/default/config_init2.xml b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/default/config_init2.xml
new file mode 100644
index 0000000000..21cbd3eb87
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/default/config_init2.xml
@@ -0,0 +1,29 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 480
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/.gitignore b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/.gitignore
new file mode 100644
index 0000000000..7b4bf4d5ff
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/.gitignore
@@ -0,0 +1,8 @@
+run_test.py
+init_step1
+init_step2
+spin_up1
+spin_up2
+spin_up3
+spin_up4
+forward
diff --git a/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_driver.xml b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_driver.xml
new file mode 100644
index 0000000000..8c2dadab35
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_driver.xml
@@ -0,0 +1,28 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_forward.xml b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_forward.xml
new file mode 100644
index 0000000000..751b04bd62
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_forward.xml
@@ -0,0 +1,52 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+ 00-00-10_00:00:00
+
+
+ 00-00-01_00:00:00
+
+
+
+
+
+
+
+
+
+
+ 480
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_init1.xml b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_init1.xml
new file mode 100644
index 0000000000..33213c12ae
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_init1.xml
@@ -0,0 +1,61 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+
+
+ 480
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_init2.xml b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_init2.xml
new file mode 100644
index 0000000000..21cbd3eb87
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_init2.xml
@@ -0,0 +1,29 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 480
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_spin_up1.xml b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_spin_up1.xml
new file mode 100644
index 0000000000..aade05f0c1
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_spin_up1.xml
@@ -0,0 +1,49 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+ 00-00-10_00:00:00
+
+
+ 00-00-00_04:00:00
+
+
+
+
+
+
+
+
+
+
+ 480
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_spin_up2.xml b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_spin_up2.xml
new file mode 100644
index 0000000000..65ede0018a
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_spin_up2.xml
@@ -0,0 +1,53 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+ 00-00-10_00:00:00
+
+
+ 00-00-00_20:00:00
+
+
+
+
+
+
+
+
+
+
+ 480
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_spin_up3.xml b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_spin_up3.xml
new file mode 100644
index 0000000000..9ed377e9d1
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_spin_up3.xml
@@ -0,0 +1,53 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+ 00-00-10_00:00:00
+
+
+ 00-00-01_00:00:00
+
+
+
+
+
+
+
+
+
+
+ 480
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_spin_up4.xml b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_spin_up4.xml
new file mode 100644
index 0000000000..7081d2f426
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/spin_up/config_spin_up4.xml
@@ -0,0 +1,53 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+
+ 00-00-10_00:00:00
+
+
+ 00-00-01_00:00:00
+
+
+
+
+
+
+
+
+
+
+ 480
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/RRS_30to10km/template_forward.xml b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/template_forward.xml
new file mode 100644
index 0000000000..e1f5199b70
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/RRS_30to10km/template_forward.xml
@@ -0,0 +1,8 @@
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/template_forward.xml b/test_cases/ocean/ocean/global_ocean/template_forward.xml
new file mode 100644
index 0000000000..6b247053ba
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/template_forward.xml
@@ -0,0 +1,19 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/template_init1.xml b/test_cases/ocean/ocean/global_ocean/template_init1.xml
new file mode 100644
index 0000000000..b019e60ac6
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/template_init1.xml
@@ -0,0 +1,75 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/template_init2.xml b/test_cases/ocean/ocean/global_ocean/template_init2.xml
new file mode 100644
index 0000000000..539ba22126
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/template_init2.xml
@@ -0,0 +1,143 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ output
+ 0000_00:00:01
+ truncate
+ init_mode_forcing_data.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ output
+ 0000-00-00_00:00:01
+ truncate
+ init_mode_shortwaveData.nc
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/global_ocean/template_init_with_land_ice.xml b/test_cases/ocean/ocean/global_ocean/template_init_with_land_ice.xml
new file mode 100644
index 0000000000..17498ce908
--- /dev/null
+++ b/test_cases/ocean/ocean/global_ocean/template_init_with_land_ice.xml
@@ -0,0 +1,32 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt1.01_default/config_driver.xml b/test_cases/ocean/ocean/isomip/10km/expt1.01_default/config_driver.xml
new file mode 100644
index 0000000000..7ab8e1432e
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt1.01_default/config_driver.xml
@@ -0,0 +1,19 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt1.01_default/config_forward.xml b/test_cases/ocean/ocean/isomip/10km/expt1.01_default/config_forward.xml
new file mode 100644
index 0000000000..5f3e72455f
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt1.01_default/config_forward.xml
@@ -0,0 +1,25 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt1.01_default/config_init1.xml b/test_cases/ocean/ocean/isomip/10km/expt1.01_default/config_init1.xml
new file mode 100644
index 0000000000..554a2c2bb3
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt1.01_default/config_init1.xml
@@ -0,0 +1,36 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt1.01_default/config_init2.xml b/test_cases/ocean/ocean/isomip/10km/expt1.01_default/config_init2.xml
new file mode 100644
index 0000000000..f18de2e112
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt1.01_default/config_init2.xml
@@ -0,0 +1,23 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_driver.xml b/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_driver.xml
new file mode 100644
index 0000000000..37ef63921e
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_driver.xml
@@ -0,0 +1,24 @@
+
+
+
+
+
+
+
+
+ --iteration_count=5
+ --plot_globalStats
+ --plot_ssh_ssp
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_forward.xml b/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_forward.xml
new file mode 100644
index 0000000000..d69aa47c07
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_forward.xml
@@ -0,0 +1,32 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 0000_01:00:00
+
+
+
+
+ truncate
+ 0000_00:00:01
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_forward_iter.xml b/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_forward_iter.xml
new file mode 100644
index 0000000000..2b3e0d2548
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_forward_iter.xml
@@ -0,0 +1,41 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ truncate
+ 0000_00:00:01
+
+
+ output
+ ssh_ssp.nc
+ 0000_01:00:00
+ truncate
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_init1.xml b/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_init1.xml
new file mode 100644
index 0000000000..06a2af2bf9
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_init1.xml
@@ -0,0 +1,36 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_init2.xml b/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_init2.xml
new file mode 100644
index 0000000000..c953b9f082
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_init2.xml
@@ -0,0 +1,23 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_init_iter.xml b/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_init_iter.xml
new file mode 100644
index 0000000000..3bdb0879e1
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_init_iter.xml
@@ -0,0 +1,36 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ../forward_iter/ssh_ssp.nc
+ initial_only
+ input
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_link_run_iter.xml b/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_link_run_iter.xml
new file mode 100644
index 0000000000..4d9e38577a
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt1.01_iter/config_link_run_iter.xml
@@ -0,0 +1,6 @@
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt2.01_default/config_driver.xml b/test_cases/ocean/ocean/isomip/10km/expt2.01_default/config_driver.xml
new file mode 100644
index 0000000000..7ab8e1432e
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt2.01_default/config_driver.xml
@@ -0,0 +1,19 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt2.01_default/config_forward.xml b/test_cases/ocean/ocean/isomip/10km/expt2.01_default/config_forward.xml
new file mode 100644
index 0000000000..5f3e72455f
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt2.01_default/config_forward.xml
@@ -0,0 +1,25 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt2.01_default/config_init1.xml b/test_cases/ocean/ocean/isomip/10km/expt2.01_default/config_init1.xml
new file mode 100644
index 0000000000..a8041da327
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt2.01_default/config_init1.xml
@@ -0,0 +1,41 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt2.01_default/config_init2.xml b/test_cases/ocean/ocean/isomip/10km/expt2.01_default/config_init2.xml
new file mode 100644
index 0000000000..07338f76ed
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt2.01_default/config_init2.xml
@@ -0,0 +1,28 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_driver.xml b/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_driver.xml
new file mode 100644
index 0000000000..37ef63921e
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_driver.xml
@@ -0,0 +1,24 @@
+
+
+
+
+
+
+
+
+ --iteration_count=5
+ --plot_globalStats
+ --plot_ssh_ssp
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_forward.xml b/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_forward.xml
new file mode 100644
index 0000000000..d69aa47c07
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_forward.xml
@@ -0,0 +1,32 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 0000_01:00:00
+
+
+
+
+ truncate
+ 0000_00:00:01
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_forward_iter.xml b/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_forward_iter.xml
new file mode 100644
index 0000000000..2b3e0d2548
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_forward_iter.xml
@@ -0,0 +1,41 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ truncate
+ 0000_00:00:01
+
+
+ output
+ ssh_ssp.nc
+ 0000_01:00:00
+ truncate
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_init1.xml b/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_init1.xml
new file mode 100644
index 0000000000..fd4e0199cc
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_init1.xml
@@ -0,0 +1,41 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_init2.xml b/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_init2.xml
new file mode 100644
index 0000000000..c2dafe7136
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_init2.xml
@@ -0,0 +1,28 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_init_iter.xml b/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_init_iter.xml
new file mode 100644
index 0000000000..2c01204d89
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_init_iter.xml
@@ -0,0 +1,41 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ../forward_iter/ssh_ssp.nc
+ initial_only
+ input
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_link_run_iter.xml b/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_link_run_iter.xml
new file mode 100644
index 0000000000..4d9e38577a
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/10km/expt2.01_iter/config_link_run_iter.xml
@@ -0,0 +1,6 @@
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/template_forward.xml b/test_cases/ocean/ocean/isomip/template_forward.xml
new file mode 100644
index 0000000000..6dee0fbcb8
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/template_forward.xml
@@ -0,0 +1,72 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ic/ocean.nc
+
+
+ ic/ocean.nc
+
+
+ ic/init_mode_forcing_data.nc
+ initial_only
+ input
+ forcing_data
+
+
+
+
+
+
+
+
+
+ output
+ output.nc
+ 0000_00:00:01
+ truncate
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/isomip/template_init.xml b/test_cases/ocean/ocean/isomip/template_init.xml
new file mode 100644
index 0000000000..fa0e52c71e
--- /dev/null
+++ b/test_cases/ocean/ocean/isomip/template_init.xml
@@ -0,0 +1,63 @@
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ output
+ 0000_00:00:01
+ truncate
+ init_mode_forcing_data.nc
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/iterative_ssh_ssp_scripts/iterate_init.py b/test_cases/ocean/ocean/iterative_ssh_ssp_scripts/iterate_init.py
new file mode 100755
index 0000000000..121782d927
--- /dev/null
+++ b/test_cases/ocean/ocean/iterative_ssh_ssp_scripts/iterate_init.py
@@ -0,0 +1,81 @@
+#!/usr/bin/env python
+import sys, os, subprocess
+import xml.etree.ElementTree as ET
+import argparse
+import numpy
+from netCDF4 import Dataset
+
+
+## This script was generated by setup_testcases.py as part of a driver_script file.
+parser = argparse.ArgumentParser(description=__doc__, formatter_class=argparse.RawTextHelpFormatter)
+parser.add_argument("--iteration_count", dest="iteration_count", default=1, type=int, help="The number of iterations between init and forward mode for computing a balanced sea-surface pressure.")
+parser.add_argument("--first_iteration", dest="first_iteration", default=0, type=int, help="The iteration to start from (for continuing iteration if iterrupted or insufficient)")
+parser.add_argument("--plot_ssh_ssp", dest="plot_ssh_ssp", action='store_true', help="If present, plot Cartesian ssh, ssp and deltaSSH fields for debugging.")
+parser.add_argument("--plot_globalStats", dest="plot_globalStats", action='store_true', help="If present, plot mean and max KE, min layer thickness and mean temperature for debugging.")
+
+args = parser.parse_args()
+base_path = os.getcwd()
+dev_null = open('/dev/null', 'w')
+error = False
+
+if(args.first_iteration == 0):
+ subprocess.check_call(['ln', '-sfn', '../init_step2/', 'forward_iter/ic'], stdout=dev_null, stderr=dev_null, env=os.environ.copy())
+ subprocess.check_call(['mkdir', '-p', 'forward_iter/statsPlots'], stdout=dev_null, stderr=dev_null, env=os.environ.copy())
+
+for iterIndex in range(args.first_iteration,args.iteration_count):
+ print " * Iteration %i/%i"%(iterIndex+1,args.iteration_count)
+ os.chdir(base_path)
+ os.chdir('forward_iter')
+
+ print " * Running forward_iter"
+ # ./run.py
+ subprocess.check_call(['./run.py'], stdout=dev_null, stderr=dev_null, env=os.environ.copy())
+ print " - Complete"
+
+ if args.plot_globalStats:
+ print " * Plotting stats"
+ subprocess.check_call(['../plot_globalStats.py', '--out_dir=statsPlots','--iteration=%i'%iterIndex, 'kineticEnergyCellMax',
+ 'kineticEnergyCellAvg', 'layerThicknessMin'], stdout=dev_null, stderr=dev_null, env=os.environ.copy())
+ print " - Complete"
+
+ os.chdir(base_path)
+ os.chdir('init_iter')
+
+ print " * Running init_iter"
+ # ./run.py
+ subprocess.check_call(['./run.py'], stdout=dev_null, stderr=dev_null, env=os.environ.copy())
+ print " - Complete"
+
+ # Write the largest change in SSH and its lon/lat to a file
+ outFile = open('maxDeltaSSH_%03i.log'%iterIndex,'w')
+ inFile = Dataset('ocean.nc','r')
+
+ deltaSSH = inFile.variables['deltaSSH'][0,:]
+ lonCell = inFile.variables['lonCell'][:]
+ latCell = inFile.variables['latCell'][:]
+ ssh = inFile.variables['ssh'][0,:]
+ ssp = inFile.variables['seaSurfacePressure'][0,:]
+ inFile.close()
+ indices = numpy.nonzero(ssp)[0]
+ index = numpy.argmax(numpy.abs(deltaSSH[indices]))
+ iCell = indices[index]
+ outFile.write('deltaSSHMax: %g, lon/lat: %f %f, ssh: %g, ssp: %g\n'%(deltaSSH[iCell],
+ 180./numpy.pi*lonCell[iCell],
+ 180./numpy.pi*latCell[iCell],
+ ssh[iCell], ssp[iCell]))
+ outFile.close()
+
+ if args.plot_ssh_ssp:
+ print " * Plotting fields"
+ subprocess.check_call(['../plot_cart_ssh_ssp.py', '--iterIndex=%i'%iterIndex], stdout=dev_null, stderr=dev_null, env=os.environ.copy())
+ print " - Complete"
+
+ os.chdir(base_path)
+ subprocess.check_call(['ln', '-sfn', '../init_iter/', 'forward_iter/ic'], stdout=dev_null, stderr=dev_null, env=os.environ.copy())
+
+os.chdir(base_path)
+
+if error:
+ sys.exit(1)
+else:
+ sys.exit(0)
diff --git a/test_cases/ocean/ocean/iterative_ssh_ssp_scripts/plot_cart_ssh_ssp.py b/test_cases/ocean/ocean/iterative_ssh_ssp_scripts/plot_cart_ssh_ssp.py
new file mode 100755
index 0000000000..059e095357
--- /dev/null
+++ b/test_cases/ocean/ocean/iterative_ssh_ssp_scripts/plot_cart_ssh_ssp.py
@@ -0,0 +1,158 @@
+#!/usr/bin/env python
+import numpy
+from netCDF4 import Dataset
+
+from optparse import OptionParser
+import matplotlib
+matplotlib.use('Agg')
+import matplotlib.pyplot as plt
+from matplotlib.patches import Polygon
+from matplotlib.collections import PatchCollection
+
+import os
+import os.path
+
+import copy
+
+def computeCellPatches():
+ patches = []
+ for iCell in range(nCells):
+ nVert = nVerticesOnCell[iCell]
+ vertexIndices = verticesOnCell[iCell,:nVert]
+ vertices = numpy.zeros((nVert,2))
+ vertices[:,0] = 1e-3*xVertex[vertexIndices]
+ vertices[:,1] = 1e-3*yVertex[vertexIndices]
+ #middle = numpy.mean(vertices,axis=0)
+
+ #expansion = 1.05
+ # expand by 1% to avoid annoying gaps
+ #for iVert in range(nVert):
+ #vertices[iVert,:] = expansion*(vertices[iVert,:]-middle) + middle
+ polygon = Polygon(vertices, True)
+ patches.append(polygon)
+
+ p = PatchCollection(patches, cmap=matplotlib.cm.jet, alpha=1.)
+
+ return p
+
+def plotHorizField(field, title, prefix, vmin=None, vmax=None, figsize=[6,9]):
+ outFileName = '%s/%s_%04i.png'%(options.outImageFolder,prefix,tIndex+1)
+ #if(os.path.exists(outFileName)):
+ # return
+
+ if(vmin is None):
+ vmin = numpy.amin(field)
+ if(vmax is None):
+ vmax = numpy.amax(field)
+ localPatches = copy.copy(cellPatches)
+ localPatches.set_array(field)
+ localPatches.set_edgecolor('face')
+ localPatches.set_clim(vmin=vmin, vmax=vmax)
+
+ plt.figure(figsize=figsize)
+ ax = plt.subplot('111')
+ ax.add_collection(localPatches)
+ plt.colorbar(localPatches)
+ plt.axis([0,500,0,1000])
+ ax.set_aspect('equal')
+ ax.autoscale(tight=True)
+ plt.title(title)
+ plt.savefig(outFileName)
+ plt.close()
+
+def plotVertField(field, title, prefix, vmin=None, vmax=None, figsize=[9,6], inY=None, inZ=None):
+ outFileName = '%s/%s_%04i.png'%(options.outImageFolder,prefix,tIndex+1)
+ if(os.path.exists(outFileName)):
+ return
+ if(inY is None):
+ inY = Y
+ if(inZ is None):
+ inZ = Z
+ plt.figure(figsize=figsize)
+ ax = plt.subplot('111')
+ plt.pcolor(1e-3*inY,inZ,field,vmin=vmin,vmax=vmax)
+ plt.colorbar()
+ ax.autoscale(tight=True)
+ plt.ylim([numpy.amin(inZ),0])
+ plt.title(title)
+ plt.savefig(outFileName)
+ plt.close()
+
+def plotHorizVertField(field, name, units, prefix, vmin=None, vmax=None):
+ if(vmin is None):
+ vmin = numpy.amin(field)
+ if(vmax is None):
+ vmax = numpy.amax(field)
+
+ print name, numpy.amin(field), numpy.amax(field)
+ plotHorizField(field[:,0], 'top %s (%s)'%(name,units), 'top%s'%prefix, vmin=vmin, vmax=vmax)
+ field = field[sectionCellIndices,:].T
+ plotVertField(field, '%s along center line (%s)'%(name,units), 'center%s'%prefix, vmin=vmin, vmax=vmax)
+
+def computeSectionCellIndices():
+ x = options.sectionX
+ yMin = numpy.amin(yCell)
+ yMax = numpy.amax(yCell)
+ ys = numpy.linspace(yMin,yMax,10000)
+ cellIndices = []
+ for y in ys:
+ distanceSquared = (x - xCell)**2 + (y-yCell)**2
+ index = numpy.argmin(distanceSquared)
+ if(len(cellIndices) == 0 or cellIndices[-1] != index):
+ cellIndices.append(index)
+
+ return numpy.array(cellIndices)
+
+def cellToSectionEdges(field):
+ ny = len(sectionCellIndices)
+ fieldMid = field[sectionCellIndices]
+ fieldEdge = numpy.zeros(ny+1)
+ fieldEdge[1:-1] = 0.5*(fieldMid[0:-1]+fieldMid[1:])
+ # extrapolate ends
+ fieldEdge[0] = 2*fieldMid[0]-fieldEdge[1]
+ fieldEdge[-1] = 2*fieldMid[-1]-fieldEdge[-2]
+ return fieldEdge
+
+parser = OptionParser()
+
+parser.add_option("--outImageFolder", type="string", default="plots", dest="outImageFolder")
+parser.add_option("--inFolder", type="string", default=".", dest="inFolder")
+parser.add_option("--initFile", type="string", default='ocean.nc', dest="initFile")
+parser.add_option("--iterIndex", type="int", default=0, dest="iterIndex")
+
+options, args = parser.parse_args()
+
+try:
+ os.makedirs(options.outImageFolder)
+except OSError as e:
+ pass
+
+inFileName = '%s/%s'%(options.inFolder,options.initFile)
+print inFileName
+inFile = Dataset(inFileName,'r')
+
+nVertices = len(inFile.dimensions['nVertices'])
+nCells = len(inFile.dimensions['nCells'])
+nEdges = len(inFile.dimensions['nEdges'])
+nVertLevels = len(inFile.dimensions['nVertLevels'])
+nTime = len(inFile.dimensions['Time'])
+
+nVerticesOnCell = numpy.array(inFile.variables['nEdgesOnCell'])
+verticesOnCell = numpy.array(inFile.variables['verticesOnCell'])-1
+xVertex = numpy.array(inFile.variables['xVertex'])
+yVertex = numpy.array(inFile.variables['yVertex'])
+
+ssp = inFile.variables['seaSurfacePressure'][nTime-1,:]
+ssh = inFile.variables['ssh'][nTime-1,:]
+deltaSSH = inFile.variables['deltaSSH'][nTime-1,:]
+
+inFile.close()
+
+cellPatches = computeCellPatches()
+
+tIndex = options.iterIndex
+
+plotHorizField(ssp, 'SSP (Pa)', 'ssp')
+plotHorizField(ssh, 'SSH (m)', 'ssh')
+plotHorizField(deltaSSH, 'delta SSH (m)', 'deltaSSH')
+
diff --git a/test_cases/ocean/ocean/lock_exchange/0.5km/default/config_driver.xml b/test_cases/ocean/ocean/lock_exchange/0.5km/default/config_driver.xml
new file mode 100644
index 0000000000..d2f9203a97
--- /dev/null
+++ b/test_cases/ocean/ocean/lock_exchange/0.5km/default/config_driver.xml
@@ -0,0 +1,22 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/lock_exchange/0.5km/default/config_forward.xml b/test_cases/ocean/ocean/lock_exchange/0.5km/default/config_forward.xml
new file mode 100644
index 0000000000..62679bf32e
--- /dev/null
+++ b/test_cases/ocean/ocean/lock_exchange/0.5km/default/config_forward.xml
@@ -0,0 +1,53 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+ output
+ truncate
+ output.nc
+ 0000-00-00_00:03:00
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/lock_exchange/0.5km/default/config_init1.xml b/test_cases/ocean/ocean/lock_exchange/0.5km/default/config_init1.xml
new file mode 100644
index 0000000000..0e4ba8e4e1
--- /dev/null
+++ b/test_cases/ocean/ocean/lock_exchange/0.5km/default/config_init1.xml
@@ -0,0 +1,63 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+v
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/lock_exchange/0.5km/default/config_init2.xml b/test_cases/ocean/ocean/lock_exchange/0.5km/default/config_init2.xml
new file mode 100644
index 0000000000..583ce19f95
--- /dev/null
+++ b/test_cases/ocean/ocean/lock_exchange/0.5km/default/config_init2.xml
@@ -0,0 +1,50 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/lock_exchange/16km/default/config_driver.xml b/test_cases/ocean/ocean/lock_exchange/16km/default/config_driver.xml
new file mode 100644
index 0000000000..d2f9203a97
--- /dev/null
+++ b/test_cases/ocean/ocean/lock_exchange/16km/default/config_driver.xml
@@ -0,0 +1,22 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/lock_exchange/16km/default/config_forward.xml b/test_cases/ocean/ocean/lock_exchange/16km/default/config_forward.xml
new file mode 100644
index 0000000000..16530d4db4
--- /dev/null
+++ b/test_cases/ocean/ocean/lock_exchange/16km/default/config_forward.xml
@@ -0,0 +1,50 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+ output
+ truncate
+ output.nc
+ 0000-00-00_00:30:00
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+
+
diff --git a/test_cases/ocean/ocean/lock_exchange/16km/default/config_init1.xml b/test_cases/ocean/ocean/lock_exchange/16km/default/config_init1.xml
new file mode 100644
index 0000000000..3a8a4efa2a
--- /dev/null
+++ b/test_cases/ocean/ocean/lock_exchange/16km/default/config_init1.xml
@@ -0,0 +1,63 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+v
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/lock_exchange/16km/default/config_init2.xml b/test_cases/ocean/ocean/lock_exchange/16km/default/config_init2.xml
new file mode 100644
index 0000000000..f7e38c5e72
--- /dev/null
+++ b/test_cases/ocean/ocean/lock_exchange/16km/default/config_init2.xml
@@ -0,0 +1,51 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/overflow/10km/default/.gitignore b/test_cases/ocean/ocean/overflow/10km/default/.gitignore
new file mode 100644
index 0000000000..3d7c2b6dc3
--- /dev/null
+++ b/test_cases/ocean/ocean/overflow/10km/default/.gitignore
@@ -0,0 +1,4 @@
+run_test.py
+forward
+init_step1
+init_step2
diff --git a/test_cases/ocean/ocean/overflow/10km/default/config_driver.xml b/test_cases/ocean/ocean/overflow/10km/default/config_driver.xml
new file mode 100644
index 0000000000..d2f9203a97
--- /dev/null
+++ b/test_cases/ocean/ocean/overflow/10km/default/config_driver.xml
@@ -0,0 +1,22 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/overflow/10km/default/config_forward.xml b/test_cases/ocean/ocean/overflow/10km/default/config_forward.xml
new file mode 100644
index 0000000000..cc6a2393f3
--- /dev/null
+++ b/test_cases/ocean/ocean/overflow/10km/default/config_forward.xml
@@ -0,0 +1,51 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+ output
+ truncate
+ output.nc
+ 0000-00-00_00:03:00
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/overflow/10km/default/config_init1.xml b/test_cases/ocean/ocean/overflow/10km/default/config_init1.xml
new file mode 100644
index 0000000000..b1accdd39a
--- /dev/null
+++ b/test_cases/ocean/ocean/overflow/10km/default/config_init1.xml
@@ -0,0 +1,64 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/overflow/10km/default/config_init2.xml b/test_cases/ocean/ocean/overflow/10km/default/config_init2.xml
new file mode 100644
index 0000000000..8b47c52ab2
--- /dev/null
+++ b/test_cases/ocean/ocean/overflow/10km/default/config_init2.xml
@@ -0,0 +1,51 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/periodic_planar/20km/default/config_driver.xml b/test_cases/ocean/ocean/periodic_planar/20km/default/config_driver.xml
new file mode 100644
index 0000000000..3e7a3fad37
--- /dev/null
+++ b/test_cases/ocean/ocean/periodic_planar/20km/default/config_driver.xml
@@ -0,0 +1,11 @@
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/periodic_planar/20km/default/config_forward.xml b/test_cases/ocean/ocean/periodic_planar/20km/default/config_forward.xml
new file mode 100644
index 0000000000..4c112d35eb
--- /dev/null
+++ b/test_cases/ocean/ocean/periodic_planar/20km/default/config_forward.xml
@@ -0,0 +1,83 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ init.nc
+
+
+ 0000-01-00_00:00:00
+
+
+ output
+ output.nc
+ 0000-01-00_00:00:00
+ truncate
+
+
+
+
+
+
+
+
+
+
+
+
+ 0000_02:46:40
+
+
+ particle_full.nc
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/periodic_planar/20km/default/config_init1.xml b/test_cases/ocean/ocean/periodic_planar/20km/default/config_init1.xml
new file mode 100644
index 0000000000..06edb28e47
--- /dev/null
+++ b/test_cases/ocean/ocean/periodic_planar/20km/default/config_init1.xml
@@ -0,0 +1,64 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/periodic_planar/20km/default/config_init2.xml b/test_cases/ocean/ocean/periodic_planar/20km/default/config_init2.xml
new file mode 100644
index 0000000000..88ecc46d5b
--- /dev/null
+++ b/test_cases/ocean/ocean/periodic_planar/20km/default/config_init2.xml
@@ -0,0 +1,53 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ init.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/periodic_planar/20km/region_reset_test/config_driver.xml b/test_cases/ocean/ocean/periodic_planar/20km/region_reset_test/config_driver.xml
new file mode 100644
index 0000000000..3e7a3fad37
--- /dev/null
+++ b/test_cases/ocean/ocean/periodic_planar/20km/region_reset_test/config_driver.xml
@@ -0,0 +1,11 @@
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/periodic_planar/20km/region_reset_test/config_forward.xml b/test_cases/ocean/ocean/periodic_planar/20km/region_reset_test/config_forward.xml
new file mode 100644
index 0000000000..00319e2a90
--- /dev/null
+++ b/test_cases/ocean/ocean/periodic_planar/20km/region_reset_test/config_forward.xml
@@ -0,0 +1,99 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ init.nc
+
+
+ 0000-01-00_00:00:00
+
+
+ output
+ output.nc
+ 0000-01-00_00:00:00
+ truncate
+
+
+
+
+
+
+
+
+
+
+
+
+ 0000_02:46:40
+
+
+ particle_resets.nc
+
+
+ input
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/periodic_planar/20km/region_reset_test/config_init1.xml b/test_cases/ocean/ocean/periodic_planar/20km/region_reset_test/config_init1.xml
new file mode 100644
index 0000000000..06edb28e47
--- /dev/null
+++ b/test_cases/ocean/ocean/periodic_planar/20km/region_reset_test/config_init1.xml
@@ -0,0 +1,64 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/periodic_planar/20km/region_reset_test/config_init2.xml b/test_cases/ocean/ocean/periodic_planar/20km/region_reset_test/config_init2.xml
new file mode 100644
index 0000000000..88ecc46d5b
--- /dev/null
+++ b/test_cases/ocean/ocean/periodic_planar/20km/region_reset_test/config_init2.xml
@@ -0,0 +1,53 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ init.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/periodic_planar/20km/time_reset_test/config_driver.xml b/test_cases/ocean/ocean/periodic_planar/20km/time_reset_test/config_driver.xml
new file mode 100644
index 0000000000..3e7a3fad37
--- /dev/null
+++ b/test_cases/ocean/ocean/periodic_planar/20km/time_reset_test/config_driver.xml
@@ -0,0 +1,11 @@
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/periodic_planar/20km/time_reset_test/config_forward.xml b/test_cases/ocean/ocean/periodic_planar/20km/time_reset_test/config_forward.xml
new file mode 100644
index 0000000000..46930444b9
--- /dev/null
+++ b/test_cases/ocean/ocean/periodic_planar/20km/time_reset_test/config_forward.xml
@@ -0,0 +1,84 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ init.nc
+
+
+ 0000-01-00_00:00:00
+
+
+ output
+ output.nc
+ 0000-01-00_00:00:00
+ truncate
+
+
+
+
+
+
+
+
+
+
+
+
+ 0000_02:46:40
+
+
+ particle_resets.nc
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/periodic_planar/20km/time_reset_test/config_init1.xml b/test_cases/ocean/ocean/periodic_planar/20km/time_reset_test/config_init1.xml
new file mode 100644
index 0000000000..d8debdf5c1
--- /dev/null
+++ b/test_cases/ocean/ocean/periodic_planar/20km/time_reset_test/config_init1.xml
@@ -0,0 +1,64 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/periodic_planar/20km/time_reset_test/config_init2.xml b/test_cases/ocean/ocean/periodic_planar/20km/time_reset_test/config_init2.xml
new file mode 100644
index 0000000000..88ecc46d5b
--- /dev/null
+++ b/test_cases/ocean/ocean/periodic_planar/20km/time_reset_test/config_init2.xml
@@ -0,0 +1,53 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ init.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/regression_suites/land_ice_fluxes.xml b/test_cases/ocean/ocean/regression_suites/land_ice_fluxes.xml
new file mode 100644
index 0000000000..b52887d002
--- /dev/null
+++ b/test_cases/ocean/ocean/regression_suites/land_ice_fluxes.xml
@@ -0,0 +1,26 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/regression_suites/nightly.xml b/test_cases/ocean/ocean/regression_suites/nightly.xml
new file mode 100644
index 0000000000..b75cd7f50e
--- /dev/null
+++ b/test_cases/ocean/ocean/regression_suites/nightly.xml
@@ -0,0 +1,23 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/scripts/plot_globalStats.py b/test_cases/ocean/ocean/scripts/plot_globalStats.py
new file mode 100755
index 0000000000..8bf0dfedc1
--- /dev/null
+++ b/test_cases/ocean/ocean/scripts/plot_globalStats.py
@@ -0,0 +1,82 @@
+#!/usr/bin/env python
+'''
+This script plots the global stats variables given as command-line arguments
+'''
+import numpy
+from netCDF4 import Dataset
+
+from optparse import OptionParser
+import matplotlib
+matplotlib.use('Agg')
+import matplotlib.pyplot as plt
+
+import glob
+
+import os
+
+parser = OptionParser()
+
+parser.add_option("--out_dir", type="string", default='globalStatsPlots', dest="out_dir")
+parser.add_option("--iteration", type="int", default=-1, dest="iteration")
+
+options, args = parser.parse_args()
+
+varNames = args
+
+if(len(args) < 1):
+ print "usage: plot_globalStats.py [ ...]"
+ print "where , etc. are variables in a globalStats file"
+ exit(1)
+
+try:
+ os.makedirs(options.out_dir)
+except OSError:
+ pass
+
+inFolder = '.'
+inFiles = glob.glob('%s/analysis_members/globalStats*.nc'%(inFolder))
+if(len(inFiles) == 0):
+ print "Error: files not found in %s"%(inFolder)
+ exit(1)
+inFiles.sort()
+
+fields = []
+for varIndex in range(len(varNames)):
+ fields.append(numpy.empty(0))
+times = numpy.empty(0)
+for inFileName in inFiles:
+ inFile = Dataset(inFileName,'r')
+
+ localTime = inFile.variables['daysSinceStartOfSim']
+ for varIndex in range(len(varNames)):
+ fieldLocal = numpy.array(inFile.variables[varNames[varIndex]])
+ fields[varIndex] = numpy.append(fields[varIndex],fieldLocal)
+
+ times = numpy.append(times,localTime)
+
+if(times[-1] < 1/24.):
+ timeUnit = 's'
+ times *= 3600.*24.
+elif(times[-1] < 1.):
+ timeUnit = 'hrs'
+ times *= 24.
+elif(times[-1] < 365):
+ timeUnit = 'days'
+else:
+ timeUnit = 'yrs'
+ times /= 365
+
+for varIndex in range(len(varNames)):
+ plt.figure(varIndex+1)
+ plt.plot(times,fields[varIndex])
+
+for varIndex in range(len(varNames)):
+ plt.figure(varIndex+1)
+ plt.xlabel('time (%s)'%timeUnit)
+ plt.title(varNames[varIndex])
+ if(options.iteration >= 0):
+ fileName = '%s/%s%02i.png'%(options.out_dir,varNames[varIndex],options.iteration)
+ else:
+ fileName = '%s/%s.png'%(options.out_dir,varNames[varIndex])
+ plt.savefig(fileName)
+ plt.close()
diff --git a/test_cases/ocean/ocean/sea_mount/6.7km/.gitignore b/test_cases/ocean/ocean/sea_mount/6.7km/.gitignore
new file mode 100644
index 0000000000..4b2e84bcb7
--- /dev/null
+++ b/test_cases/ocean/ocean/sea_mount/6.7km/.gitignore
@@ -0,0 +1,3 @@
+init_step1
+init_step2
+forward
diff --git a/test_cases/ocean/ocean/sea_mount/6.7km/default/config_driver.xml b/test_cases/ocean/ocean/sea_mount/6.7km/default/config_driver.xml
new file mode 100644
index 0000000000..3e7a3fad37
--- /dev/null
+++ b/test_cases/ocean/ocean/sea_mount/6.7km/default/config_driver.xml
@@ -0,0 +1,11 @@
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sea_mount/6.7km/default/config_forward.xml b/test_cases/ocean/ocean/sea_mount/6.7km/default/config_forward.xml
new file mode 100644
index 0000000000..2f493851da
--- /dev/null
+++ b/test_cases/ocean/ocean/sea_mount/6.7km/default/config_forward.xml
@@ -0,0 +1,25 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/sea_mount/6.7km/default/config_init1.xml b/test_cases/ocean/ocean/sea_mount/6.7km/default/config_init1.xml
new file mode 100644
index 0000000000..6191b84866
--- /dev/null
+++ b/test_cases/ocean/ocean/sea_mount/6.7km/default/config_init1.xml
@@ -0,0 +1,63 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/sea_mount/6.7km/default/config_init2.xml b/test_cases/ocean/ocean/sea_mount/6.7km/default/config_init2.xml
new file mode 100644
index 0000000000..bd332f01c6
--- /dev/null
+++ b/test_cases/ocean/ocean/sea_mount/6.7km/default/config_init2.xml
@@ -0,0 +1,51 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sea_mount/6.7km/template_forward.xml b/test_cases/ocean/ocean/sea_mount/6.7km/template_forward.xml
new file mode 100644
index 0000000000..799cde6e92
--- /dev/null
+++ b/test_cases/ocean/ocean/sea_mount/6.7km/template_forward.xml
@@ -0,0 +1,36 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+ output
+ output.nc
+ 0000_00:00:01
+ truncate
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/single_column_model/planar/cvmix_test/config_driver.xml b/test_cases/ocean/ocean/single_column_model/planar/cvmix_test/config_driver.xml
new file mode 100644
index 0000000000..936d57b327
--- /dev/null
+++ b/test_cases/ocean/ocean/single_column_model/planar/cvmix_test/config_driver.xml
@@ -0,0 +1,8 @@
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/single_column_model/planar/cvmix_test/config_forward.xml b/test_cases/ocean/ocean/single_column_model/planar/cvmix_test/config_forward.xml
new file mode 100644
index 0000000000..8f9effa238
--- /dev/null
+++ b/test_cases/ocean/ocean/single_column_model/planar/cvmix_test/config_forward.xml
@@ -0,0 +1,88 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+ output
+ output/output.$Y-$M-$D_$h.$m.$s.nc
+ 0001_00:00:00
+ 01-00-00_00:00:00
+ truncate
+ 0000-01-01_00:00:00
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 8
+
+
+ 8
+ ./ocean_model
+ namelist.ocean
+ streams.ocean
+
+
+
diff --git a/test_cases/ocean/ocean/single_column_model/planar/cvmix_test/config_init.xml b/test_cases/ocean/ocean/single_column_model/planar/cvmix_test/config_init.xml
new file mode 100644
index 0000000000..7deb72e4ea
--- /dev/null
+++ b/test_cases/ocean/ocean/single_column_model/planar/cvmix_test/config_init.xml
@@ -0,0 +1,119 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ output
+ init_mode_forcing_data.nc
+ truncate
+ 0000-00-00_00:00:01
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+ 1
+ ./ocean_model
+ namelist.ocean
+ streams.ocean
+
+
+
diff --git a/test_cases/ocean/ocean/single_column_model/sphere/cvmix_test/config_driver.xml b/test_cases/ocean/ocean/single_column_model/sphere/cvmix_test/config_driver.xml
new file mode 100644
index 0000000000..936d57b327
--- /dev/null
+++ b/test_cases/ocean/ocean/single_column_model/sphere/cvmix_test/config_driver.xml
@@ -0,0 +1,8 @@
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/single_column_model/sphere/cvmix_test/config_forward.xml b/test_cases/ocean/ocean/single_column_model/sphere/cvmix_test/config_forward.xml
new file mode 100644
index 0000000000..8f9effa238
--- /dev/null
+++ b/test_cases/ocean/ocean/single_column_model/sphere/cvmix_test/config_forward.xml
@@ -0,0 +1,88 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+ output
+ output/output.$Y-$M-$D_$h.$m.$s.nc
+ 0001_00:00:00
+ 01-00-00_00:00:00
+ truncate
+ 0000-01-01_00:00:00
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 8
+
+
+ 8
+ ./ocean_model
+ namelist.ocean
+ streams.ocean
+
+
+
diff --git a/test_cases/ocean/ocean/single_column_model/sphere/cvmix_test/config_init.xml b/test_cases/ocean/ocean/single_column_model/sphere/cvmix_test/config_init.xml
new file mode 100644
index 0000000000..ad5e658fcd
--- /dev/null
+++ b/test_cases/ocean/ocean/single_column_model/sphere/cvmix_test/config_init.xml
@@ -0,0 +1,120 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ output
+ init_mode_forcing_data.nc
+ truncate
+ 0000-00-00_00:00:01
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+ 1
+ ./ocean_model
+ namelist.ocean
+ streams.ocean
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/.gitignore b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/.gitignore
new file mode 100644
index 0000000000..4b2e84bcb7
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/.gitignore
@@ -0,0 +1,3 @@
+init_step1
+init_step2
+forward
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_driver.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_driver.xml
new file mode 100644
index 0000000000..76330b4563
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_driver.xml
@@ -0,0 +1,16 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_forward.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_forward.xml
new file mode 100644
index 0000000000..b0d5f8f15b
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_forward.xml
@@ -0,0 +1,42 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 0000_00:00:01
+
+
+ forcing_data.nc
+ initial_only
+ input
+ forcing_data
+
+
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_init1.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_init1.xml
new file mode 100644
index 0000000000..ee392f8c25
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_init1.xml
@@ -0,0 +1,73 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_init2.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_init2.xml
new file mode 100644
index 0000000000..084570f5b1
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_init2.xml
@@ -0,0 +1,71 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ output
+ 0000_00:00:01
+ truncate
+ init_mode_forcing_data.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_driver.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_driver.xml
new file mode 100644
index 0000000000..5ffeade4ad
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_driver.xml
@@ -0,0 +1,21 @@
+
+
+
+
+
+
+
+
+ --iteration_count=20
+ --plot_globalStats
+ --plot_ssh_ssp
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_forward.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_forward.xml
new file mode 100644
index 0000000000..2bfce10e65
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_forward.xml
@@ -0,0 +1,27 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 0000_00:00:01
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_forward_iter.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_forward_iter.xml
new file mode 100644
index 0000000000..b418abb7e8
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_forward_iter.xml
@@ -0,0 +1,39 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ truncate
+ 0000_00:00:01
+
+
+ output
+ ssh_ssp.nc
+ 0000_01:00:00
+ truncate
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_init1.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_init1.xml
new file mode 100644
index 0000000000..5ed1f9ff88
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_init1.xml
@@ -0,0 +1,35 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_init2.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_init2.xml
new file mode 100644
index 0000000000..d2d357d268
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_init2.xml
@@ -0,0 +1,22 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_init_iter.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_init_iter.xml
new file mode 100644
index 0000000000..4277882b16
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_init_iter.xml
@@ -0,0 +1,33 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ../forward_iter/ssh_ssp.nc
+ initial_only
+ input
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_link_run_iter.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_link_run_iter.xml
new file mode 100644
index 0000000000..4d9e38577a
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_link_run_iter.xml
@@ -0,0 +1,6 @@
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/template_forward.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/template_forward.xml
new file mode 100644
index 0000000000..3bc47a14b8
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/template_forward.xml
@@ -0,0 +1,51 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ic/ocean.nc
+
+
+ ic/ocean.nc
+
+
+ ic/init_mode_forcing_data.nc
+ initial_only
+ input
+ forcing_data
+
+
+
+
+
+
+
+
+
+ output
+ output.nc
+ 0000_00:00:01
+ truncate
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/template_init.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/template_init.xml
new file mode 100644
index 0000000000..2eccc7405a
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/template_init.xml
@@ -0,0 +1,67 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ output
+ 0000_00:00:01
+ truncate
+ init_mode_forcing_data.nc
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/default/config_driver.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/default/config_driver.xml
new file mode 100644
index 0000000000..76330b4563
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/default/config_driver.xml
@@ -0,0 +1,16 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/default/config_forward.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/default/config_forward.xml
new file mode 100644
index 0000000000..b0d5f8f15b
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/default/config_forward.xml
@@ -0,0 +1,42 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 0000_00:00:01
+
+
+ forcing_data.nc
+ initial_only
+ input
+ forcing_data
+
+
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/default/config_init1.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/default/config_init1.xml
new file mode 100644
index 0000000000..f5b71b9a24
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/default/config_init1.xml
@@ -0,0 +1,56 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/default/config_init2.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/default/config_init2.xml
new file mode 100644
index 0000000000..5d8ce8c57b
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/default/config_init2.xml
@@ -0,0 +1,68 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ output
+ 0000_00:00:01
+ truncate
+ init_mode_forcing_data.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_driver.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_driver.xml
new file mode 100644
index 0000000000..5ffeade4ad
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_driver.xml
@@ -0,0 +1,21 @@
+
+
+
+
+
+
+
+
+ --iteration_count=20
+ --plot_globalStats
+ --plot_ssh_ssp
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_forward.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_forward.xml
new file mode 100644
index 0000000000..2bfce10e65
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_forward.xml
@@ -0,0 +1,27 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 0000_00:00:01
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_forward_iter.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_forward_iter.xml
new file mode 100644
index 0000000000..b418abb7e8
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_forward_iter.xml
@@ -0,0 +1,39 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ truncate
+ 0000_00:00:01
+
+
+ output
+ ssh_ssp.nc
+ 0000_01:00:00
+ truncate
+
+
+
+
+
+
+
+
+
+ 4
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_init1.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_init1.xml
new file mode 100644
index 0000000000..5ed1f9ff88
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_init1.xml
@@ -0,0 +1,35 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_init2.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_init2.xml
new file mode 100644
index 0000000000..d2d357d268
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_init2.xml
@@ -0,0 +1,22 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_init_iter.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_init_iter.xml
new file mode 100644
index 0000000000..4277882b16
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_init_iter.xml
@@ -0,0 +1,33 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ../forward_iter/ssh_ssp.nc
+ initial_only
+ input
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_link_run_iter.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_link_run_iter.xml
new file mode 100644
index 0000000000..4d9e38577a
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/config_link_run_iter.xml
@@ -0,0 +1,6 @@
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/template_forward.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/template_forward.xml
new file mode 100644
index 0000000000..3bc47a14b8
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/template_forward.xml
@@ -0,0 +1,51 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ic/ocean.nc
+
+
+ ic/ocean.nc
+
+
+ ic/init_mode_forcing_data.nc
+ initial_only
+ input
+ forcing_data
+
+
+
+
+
+
+
+
+
+ output
+ output.nc
+ 0000_00:00:01
+ truncate
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/template_init.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/template_init.xml
new file mode 100644
index 0000000000..3ce6f4d4ee
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/iterative_init/template_init.xml
@@ -0,0 +1,64 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ output
+ 0000_00:00:01
+ truncate
+ init_mode_forcing_data.nc
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/template_forward.xml b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/template_forward.xml
new file mode 100644
index 0000000000..689ec2a6d1
--- /dev/null
+++ b/test_cases/ocean/ocean/sub_ice_shelf_2D/5km/template_forward.xml
@@ -0,0 +1,38 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ init.nc
+
+
+ init.nc
+
+
+ output
+ output.nc
+ 0000_00:00:01
+ truncate
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/analysis_members/debug_diagnostics.xml b/test_cases/ocean/ocean/templates/analysis_members/debug_diagnostics.xml
new file mode 100644
index 0000000000..9f81c171d3
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/analysis_members/debug_diagnostics.xml
@@ -0,0 +1,28 @@
+
+
+
+
+
+
+
+
+
+
+
+ single_file
+ debugDiagnosticsOutput
+ 01-00-00_00:00:00
+ append
+ 0000_01:00:00
+ 0000-01-01_00:00:00
+ analysis_members/debugDiagnostics.$Y-$M-$D_$h.$m.$s.nc
+ debugDiagnosticsAMPKG
+ output
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/analysis_members/eliassen_palm.xml b/test_cases/ocean/ocean/templates/analysis_members/eliassen_palm.xml
new file mode 100644
index 0000000000..d2b73d8322
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/analysis_members/eliassen_palm.xml
@@ -0,0 +1,90 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ single_file
+ eliassenPalmOutput
+ 01-00-00_00:00:00
+ truncate
+ 0000-01-01_00:00:00
+ 00-00-01_00:00:00
+ analysis_members/eliassenPalm.$Y-$M-$D.nc
+ eliassenPalmAMPKG
+ output
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ single_file
+ eliassenPalmRestart
+ 01-00-00_00:00:00
+ truncate
+ stream:restart:output_interval
+ restarts/eliassenPalm_restart.$Y-$M-$D.nc
+ initial_only
+ eliassenPalmAMPKG
+ input;output
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/analysis_members/global_stats.xml b/test_cases/ocean/ocean/templates/analysis_members/global_stats.xml
new file mode 100644
index 0000000000..3fe5d118e1
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/analysis_members/global_stats.xml
@@ -0,0 +1,38 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+ single_file
+ globalStatsOutput
+ 01-00-00_00:00:00
+ append
+ 0000_01:00:00
+ 0000-01-01_00:00:00
+ analysis_members/globalStats.$Y-$M-$D_$h.$m.$s.nc
+ globalStatsAMPKG
+ output
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/analysis_members/high_frequency_output.xml b/test_cases/ocean/ocean/templates/analysis_members/high_frequency_output.xml
new file mode 100644
index 0000000000..a57f8d855d
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/analysis_members/high_frequency_output.xml
@@ -0,0 +1,30 @@
+
+
+
+
+
+
+
+
+
+
+
+ single_file
+ highFrequencyOutput
+ 01-00-00_00:00:00
+ truncate
+ 0000-01-01_00:00:00
+ 00-00-01_00:00:00
+ analysis_members/highFrequencyOutput.$Y-$M-$D.nc
+ highFrequencyOutputAMPKG
+ output
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/analysis_members/lagrangian_particle_tracking.xml b/test_cases/ocean/ocean/templates/analysis_members/lagrangian_particle_tracking.xml
new file mode 100644
index 0000000000..bad83c1b8f
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/analysis_members/lagrangian_particle_tracking.xml
@@ -0,0 +1,169 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ single_file
+ lagrPartTrackOutput
+ 01-00-00_00:00:00
+ truncate
+ 0002_00:00:00
+ analysis_members/lagrPartTrack.$Y-$M-$D_$h.$m.$s.nc
+ lagrPartTrackAMPKG
+ output
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ lagrPartTrackRestart
+ output_interval
+ truncate
+ stream:restart:output_interval
+ analysis_members/lagrangianParticleTrackingRestart.$Y-$M-$D_$h.$m.$s.nc
+ initial_only
+ lagrPartTrackAMPKG
+ input;output
+ true
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ analysis_members/lagrangianParticleTrackingInput.nc
+ lagrPartTrackInput
+ initial_only
+ lagrPartTrackAMPKG
+ input
+ true
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ none
+ particle_regions.nc
+ lagrPartTrackRegions
+ initial_only
+ lagrPartTrackAMPKG
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/analysis_members/layer_volume_weighted_averages.xml b/test_cases/ocean/ocean/templates/analysis_members/layer_volume_weighted_averages.xml
new file mode 100644
index 0000000000..1d9d36e90e
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/analysis_members/layer_volume_weighted_averages.xml
@@ -0,0 +1,31 @@
+
+
+
+
+
+
+
+
+
+
+
+ single_file
+ layerVolumeWeightedAverageOutput
+ 01-00-00_00:00:00
+ truncate
+ 00-00-05_00:00:00
+ analysis_members/layerVolumeWeightedAverage.$Y-$M-$D_$h.$m.$s.nc
+ layerVolumeWeightedAverageAMPKG
+ output
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/analysis_members/meridional_heat_transport.xml b/test_cases/ocean/ocean/templates/analysis_members/meridional_heat_transport.xml
new file mode 100644
index 0000000000..6f78ac8e70
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/analysis_members/meridional_heat_transport.xml
@@ -0,0 +1,34 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ single_file
+ meridionalHeatTransportOutput
+ 01-00-00_00:00:00
+ truncate
+ 0000-01-01_00:00:00
+ 0001_00:00:00
+ analysis_members/meridionalHeatTransport.$Y-$M-$D_$h.$m.$s.nc
+ meridionalHeatTransportAMPKG
+ output
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/analysis_members/mixed_layer_depths.xml b/test_cases/ocean/ocean/templates/analysis_members/mixed_layer_depths.xml
new file mode 100644
index 0000000000..44a756c513
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/analysis_members/mixed_layer_depths.xml
@@ -0,0 +1,41 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ single_file
+ mixedLayerDepthsOutput
+ 01-00-00_00:00:00
+ truncate
+ 0000-01-01_00:00:00
+ 00-00-01_00:00:00
+ analysis_members/mixedLayerDepths.$Y-$M-$D.nc
+ mixedLayerDepthsAMPKG
+ output
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/analysis_members/okubo_weiss.xml b/test_cases/ocean/ocean/templates/analysis_members/okubo_weiss.xml
new file mode 100644
index 0000000000..92ef652358
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/analysis_members/okubo_weiss.xml
@@ -0,0 +1,36 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ single_file
+ okuboWeissOutput
+ 01-00-00_00:00:00
+ truncate
+ 00-00-05_00:00:00
+ analysis_members/okuboWeiss.$Y-$M-$D_$h.$m.$s.nc
+ okuboWeissAMPKG
+ output
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/analysis_members/surface_area_weighted_averages.xml b/test_cases/ocean/ocean/templates/analysis_members/surface_area_weighted_averages.xml
new file mode 100644
index 0000000000..6ad412f1e7
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/analysis_members/surface_area_weighted_averages.xml
@@ -0,0 +1,28 @@
+
+
+
+
+
+
+
+
+
+
+
+ single_file
+ surfaceAreaWeightedAveragesOutput
+ 01-00-00_00:00:00
+ truncate
+ 00-00-05_00:00:00
+ analysis_members/surfaceAreaWeightedAverages.$Y-$M-$D_$h.$m.$s.nc
+ surfaceAreaWeightedAveragesAMPKG
+ output
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/analysis_members/test_compute_interval.xml b/test_cases/ocean/ocean/templates/analysis_members/test_compute_interval.xml
new file mode 100644
index 0000000000..22e7db0b2d
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/analysis_members/test_compute_interval.xml
@@ -0,0 +1,26 @@
+
+
+
+
+
+
+
+
+
+
+
+ single_file
+ testComputeIntervalOutput
+ 01-00-00_00:00:00
+ truncate
+ 00-00-01_00:00:00
+ analysis_members/testComputeInterval.$Y-$M-$D.nc
+ testComputeIntervalAMPKG
+ output
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/analysis_members/time_filters.xml b/test_cases/ocean/ocean/templates/analysis_members/time_filters.xml
new file mode 100644
index 0000000000..474b6ea6c7
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/analysis_members/time_filters.xml
@@ -0,0 +1,51 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ single_file
+ timeFiltersOutput
+ 01-00-00_00:00:00
+ truncate
+ 0000-01-01_00:00:00
+ 00-00-01_00:00:00
+ analysis_members/timeFilters.$Y-$M-$D_$h.nc
+ timeFiltersAMPKG
+ output
+
+
+
+
+
+
+
+
+
+
+ single_file
+ timeFiltersRestart
+ 01-00-00_00:00:00
+ truncate
+ stream:restart:output_interval
+ restarts/timeFiltersRestart.$Y-$M-$D_$h.nc
+ initial_only
+ timeFiltersAMPKG
+ input;output
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/analysis_members/time_series_stats.xml b/test_cases/ocean/ocean/templates/analysis_members/time_series_stats.xml
new file mode 100644
index 0000000000..b779ee9280
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/analysis_members/time_series_stats.xml
@@ -0,0 +1,58 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ single_file
+ timeSeriesStatsOutput
+ 00-01-00_00:00:00
+ truncate
+ 00-00-01_00:00:00
+ analysis_members/timeSeriesStats.$Y-$M-$D.nc
+ timeSeriesStatsAMPKG
+ none
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ timeSeriesStatsRestart
+ output_interval
+ truncate
+ 0000-01-01_00:00:00
+ stream:restart:output_interval
+ restarts/restart.AM.timeSeriesStats.$Y-$M-$D_$h.$m.$s.nc
+ initial_only
+ input;output
+ true
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/analysis_members/water_mass_census.xml b/test_cases/ocean/ocean/templates/analysis_members/water_mass_census.xml
new file mode 100644
index 0000000000..645ea57880
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/analysis_members/water_mass_census.xml
@@ -0,0 +1,34 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ single_file
+ waterMassCensusOutput
+ 01-00-00_00:00:00
+ truncate
+ 00-00-05_00:00:00
+ analysis_members/waterMassCensus.$Y-$M-$D_$h.$m.$s.nc
+ waterMassCensusAMPKG
+ output
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/analysis_members/zonal_mean.xml b/test_cases/ocean/ocean/templates/analysis_members/zonal_mean.xml
new file mode 100644
index 0000000000..6c069eb9a9
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/analysis_members/zonal_mean.xml
@@ -0,0 +1,35 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ single_file
+ zonalMeanOutput
+ 01-00-00_00:00:00
+ truncate
+ 0000_12:00:00
+ analysis_members/zonalMeans.$Y-$M-$D_$h.$m.$s.nc
+ zonalMeanAMPKG
+ output
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/debugging.xml b/test_cases/ocean/ocean/templates/debugging.xml
new file mode 100644
index 0000000000..48e1ec906e
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/debugging.xml
@@ -0,0 +1,33 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/streams/KPP_testing.xml b/test_cases/ocean/ocean/templates/streams/KPP_testing.xml
new file mode 100644
index 0000000000..f20bd751aa
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/streams/KPP_testing.xml
@@ -0,0 +1,38 @@
+
+
+
+ output/KPP_test.$Y-$M-$D_$h.$m.$s.nc
+ KPP_testing
+ 00-01-00_00:00:00
+ truncate
+ 0000-01-01_00:00:00
+ output
+ 0000_01:00:00
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/streams/forcing_data.xml b/test_cases/ocean/ocean/templates/streams/forcing_data.xml
new file mode 100644
index 0000000000..adf015c0a2
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/streams/forcing_data.xml
@@ -0,0 +1,27 @@
+
+
+
+ forcing_data.nc
+ initial_only
+ input
+ forcing_data
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/streams/land_ice_fluxes.xml b/test_cases/ocean/ocean/templates/streams/land_ice_fluxes.xml
new file mode 100644
index 0000000000..cb1860a29b
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/streams/land_ice_fluxes.xml
@@ -0,0 +1,27 @@
+
+
+
+ output
+ land_ice_fluxes.nc
+ 0000_00:00:01
+ truncate
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/streams/minimal_output.xml b/test_cases/ocean/ocean/templates/streams/minimal_output.xml
new file mode 100644
index 0000000000..f7cdb61344
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/streams/minimal_output.xml
@@ -0,0 +1,17 @@
+
+
+
+ output
+ output.nc
+ 0000_00:00:01
+ truncate
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/streams/output.xml b/test_cases/ocean/ocean/templates/streams/output.xml
new file mode 100644
index 0000000000..f2c02237b6
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/streams/output.xml
@@ -0,0 +1,38 @@
+
+
+
+ output/output.$Y-$M-$D_$h.$m.$s.nc
+ output
+ 01-00-00_00:00:00
+ truncate
+ 0000-01-01_00:00:00
+ output
+ 0001_00:00:00
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/streams/shortwave_forcing_data.xml b/test_cases/ocean/ocean/templates/streams/shortwave_forcing_data.xml
new file mode 100644
index 0000000000..de2812a1fc
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/streams/shortwave_forcing_data.xml
@@ -0,0 +1,16 @@
+
+
+
+ shortwaveData.nc
+ none
+ input
+ shortwave_forcing_data
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/validations/land_ice_flux_comparison.xml b/test_cases/ocean/ocean/templates/validations/land_ice_flux_comparison.xml
new file mode 100644
index 0000000000..49944d631d
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/validations/land_ice_flux_comparison.xml
@@ -0,0 +1,22 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/templates/validations/prognostic_comparison.xml b/test_cases/ocean/ocean/templates/validations/prognostic_comparison.xml
new file mode 100644
index 0000000000..a736088b92
--- /dev/null
+++ b/test_cases/ocean/ocean/templates/validations/prognostic_comparison.xml
@@ -0,0 +1,9 @@
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/ziso/10km/default/config_driver.xml b/test_cases/ocean/ocean/ziso/10km/default/config_driver.xml
new file mode 100644
index 0000000000..3e7a3fad37
--- /dev/null
+++ b/test_cases/ocean/ocean/ziso/10km/default/config_driver.xml
@@ -0,0 +1,11 @@
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/ziso/10km/default/config_forward.xml b/test_cases/ocean/ocean/ziso/10km/default/config_forward.xml
new file mode 100644
index 0000000000..f9555297c2
--- /dev/null
+++ b/test_cases/ocean/ocean/ziso/10km/default/config_forward.xml
@@ -0,0 +1,52 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+ make_particle_resets.py
+ mesh.nc
+ particles.nc
+ graph.info.part.4
+ 11
+
+
+
+
diff --git a/test_cases/ocean/ocean/ziso/10km/default/config_init1.xml b/test_cases/ocean/ocean/ziso/10km/default/config_init1.xml
new file mode 100644
index 0000000000..2b6de8a3db
--- /dev/null
+++ b/test_cases/ocean/ocean/ziso/10km/default/config_init1.xml
@@ -0,0 +1,70 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/ziso/10km/default/config_init2.xml b/test_cases/ocean/ocean/ziso/10km/default/config_init2.xml
new file mode 100644
index 0000000000..50be92b030
--- /dev/null
+++ b/test_cases/ocean/ocean/ziso/10km/default/config_init2.xml
@@ -0,0 +1,71 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ init.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ output
+ forcing.nc
+ truncate
+ 0000_00:00:01
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/ziso/2.5km/default/config_driver.xml b/test_cases/ocean/ocean/ziso/2.5km/default/config_driver.xml
new file mode 100644
index 0000000000..3e7a3fad37
--- /dev/null
+++ b/test_cases/ocean/ocean/ziso/2.5km/default/config_driver.xml
@@ -0,0 +1,11 @@
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/ziso/2.5km/default/config_forward.xml b/test_cases/ocean/ocean/ziso/2.5km/default/config_forward.xml
new file mode 100644
index 0000000000..53587affa8
--- /dev/null
+++ b/test_cases/ocean/ocean/ziso/2.5km/default/config_forward.xml
@@ -0,0 +1,52 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+ make_particle_resets.py
+ mesh.nc
+ particles.nc
+ graph.info.part.4
+ 11
+
+
+
+
diff --git a/test_cases/ocean/ocean/ziso/2.5km/default/config_init1.xml b/test_cases/ocean/ocean/ziso/2.5km/default/config_init1.xml
new file mode 100644
index 0000000000..936b70ce05
--- /dev/null
+++ b/test_cases/ocean/ocean/ziso/2.5km/default/config_init1.xml
@@ -0,0 +1,70 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/ziso/2.5km/default/config_init2.xml b/test_cases/ocean/ocean/ziso/2.5km/default/config_init2.xml
new file mode 100644
index 0000000000..50be92b030
--- /dev/null
+++ b/test_cases/ocean/ocean/ziso/2.5km/default/config_init2.xml
@@ -0,0 +1,71 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ init.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ output
+ forcing.nc
+ truncate
+ 0000_00:00:01
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/ziso/20km/default/config_driver.xml b/test_cases/ocean/ocean/ziso/20km/default/config_driver.xml
new file mode 100644
index 0000000000..0808114ebc
--- /dev/null
+++ b/test_cases/ocean/ocean/ziso/20km/default/config_driver.xml
@@ -0,0 +1,17 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/ziso/20km/default/config_forward.xml b/test_cases/ocean/ocean/ziso/20km/default/config_forward.xml
new file mode 100644
index 0000000000..7861e991fe
--- /dev/null
+++ b/test_cases/ocean/ocean/ziso/20km/default/config_forward.xml
@@ -0,0 +1,52 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+ make_particle_resets.py
+ mesh.nc
+ particles.nc
+ graph.info.part.4
+ 11
+
+
+
+
diff --git a/test_cases/ocean/ocean/ziso/20km/default/config_init1.xml b/test_cases/ocean/ocean/ziso/20km/default/config_init1.xml
new file mode 100644
index 0000000000..2e60f0cd36
--- /dev/null
+++ b/test_cases/ocean/ocean/ziso/20km/default/config_init1.xml
@@ -0,0 +1,70 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/ziso/20km/default/config_init2.xml b/test_cases/ocean/ocean/ziso/20km/default/config_init2.xml
new file mode 100644
index 0000000000..b867d82ab2
--- /dev/null
+++ b/test_cases/ocean/ocean/ziso/20km/default/config_init2.xml
@@ -0,0 +1,71 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ init.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ output
+ forcing.nc
+ truncate
+ 0000_00:00:01
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/ziso/5km/default/config_driver.xml b/test_cases/ocean/ocean/ziso/5km/default/config_driver.xml
new file mode 100644
index 0000000000..3e7a3fad37
--- /dev/null
+++ b/test_cases/ocean/ocean/ziso/5km/default/config_driver.xml
@@ -0,0 +1,11 @@
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/ziso/5km/default/config_forward.xml b/test_cases/ocean/ocean/ziso/5km/default/config_forward.xml
new file mode 100644
index 0000000000..12b5fe8246
--- /dev/null
+++ b/test_cases/ocean/ocean/ziso/5km/default/config_forward.xml
@@ -0,0 +1,52 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 4
+
+
+ make_particle_resets.py
+ mesh.nc
+ particles.nc
+ graph.info.part.4
+ 11
+
+
+
+
diff --git a/test_cases/ocean/ocean/ziso/5km/default/config_init1.xml b/test_cases/ocean/ocean/ziso/5km/default/config_init1.xml
new file mode 100644
index 0000000000..a8be98ff16
--- /dev/null
+++ b/test_cases/ocean/ocean/ziso/5km/default/config_init1.xml
@@ -0,0 +1,70 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ ocean.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ base_mesh.nc
+ mesh.nc
+
+
+
+
+
+ ocean.nc
+
+
+
diff --git a/test_cases/ocean/ocean/ziso/5km/default/config_init2.xml b/test_cases/ocean/ocean/ziso/5km/default/config_init2.xml
new file mode 100644
index 0000000000..50be92b030
--- /dev/null
+++ b/test_cases/ocean/ocean/ziso/5km/default/config_init2.xml
@@ -0,0 +1,71 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ output
+ 0000_00:00:01
+ truncate
+ init.nc
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ output
+ forcing.nc
+ truncate
+ 0000_00:00:01
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/test_cases/ocean/ocean/ziso/ziso_template.xml b/test_cases/ocean/ocean/ziso/ziso_template.xml
new file mode 100644
index 0000000000..7874ac95d3
--- /dev/null
+++ b/test_cases/ocean/ocean/ziso/ziso_template.xml
@@ -0,0 +1,136 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mesh.nc
+
+
+ init.nc
+
+
+ 0030_00:00:00
+
+
+ 0001_00:00:00
+
+
+ 0000-01-00_00:00:00
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ forcing.nc
+
+
+ 0001_00:00:00
+
+
+ 0003_00:00:00
+
+
+ 00-00-05_00:00:00
+ 0000-01-01_00:00:00
+
+
+ 00-00-01_00:00:00
+
+
+ 0000-01-00_00:00:00
+
+
+ 00-01-00_00:00:00
+
+
+ particles.nc
+
+
+
+
+
+