diff --git a/Makefile b/Makefile
index baceb05cb7..5fbaeca357 100644
--- a/Makefile
+++ b/Makefile
@@ -6,18 +6,18 @@ dummy:
 
 xlf:
 	( $(MAKE) all \
-	"FC_PARALLEL = mpxlf90" \
-	"CC_PARALLEL = mpcc" \
-	"CXX_PARALLEL = mpixlcxx" \
-	"FC_SERIAL = xlf90" \
-	"CC_SERIAL = xlc" \
-	"CXX_SERIAL = xlcxx" \
+	"FC_PARALLEL = mpifort" \
+	"CC_PARALLEL = mpicc" \
+	"CXX_PARALLEL = mpic++" \
+	"FC_SERIAL = xlf2003_r" \
+	"CC_SERIAL = xlc_r" \
+	"CXX_SERIAL = xlc++_r" \
 	"FFLAGS_PROMOTION = -qrealsize=8" \
-	"FFLAGS_OPT = -O3" \
+	"FFLAGS_OPT = -O3 -qufmt=be -WF,-qnotrigraph" \
 	"CFLAGS_OPT = -O3" \
 	"CXXFLAGS_OPT = -O3" \
 	"LDFLAGS_OPT = -O3" \
-	"FFLAGS_DEBUG = -O0 -g -C" \
+	"FFLAGS_DEBUG = -O0 -g -C -qufmt=be -WF,-qnotrigraph" \
 	"CFLAGS_DEBUG = -O0 -g" \
 	"CXXFLAGS_DEBUG = -O0 -g" \
 	"LDFLAGS_DEBUG = -O0 -g" \
@@ -48,7 +48,7 @@ ftn:
 	"DEBUG = $(DEBUG)" \
 	"USE_PAPI = $(USE_PAPI)" \
 	"OPENMP = $(OPENMP)" \
-	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" )
+	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" )
 
 titan-cray:
 	( $(MAKE) all \
@@ -66,7 +66,7 @@ titan-cray:
 	"DEBUG = $(DEBUG)" \
 	"USE_PAPI = $(USE_PAPI)" \
 	"OPENMP = $(OPENMP)" \
-	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" )
+	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" )
 
 pgi:
 	( $(MAKE) all \
@@ -91,7 +91,7 @@ pgi:
 	"DEBUG = $(DEBUG)" \
 	"USE_PAPI = $(USE_PAPI)" \
 	"OPENMP = $(OPENMP)" \
-	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" )
+	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" )
 
 pgi-nersc:
 	( $(MAKE) all \
@@ -112,7 +112,7 @@ pgi-nersc:
 	"DEBUG = $(DEBUG)" \
 	"USE_PAPI = $(USE_PAPI)" \
 	"OPENMP = $(OPENMP)" \
-	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" )
+	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" )
 
 pgi-llnl:
 	( $(MAKE) all \
@@ -133,7 +133,7 @@ pgi-llnl:
 	"DEBUG = $(DEBUG)" \
 	"USE_PAPI = $(USE_PAPI)" \
 	"OPENMP = $(OPENMP)" \
-	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" )
+	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" )
 
 ifort:
 	( $(MAKE) all \
@@ -144,11 +144,11 @@ ifort:
 	"CC_SERIAL = icc" \
 	"CXX_SERIAL = icpc" \
 	"FFLAGS_PROMOTION = -real-size 64" \
-	"FFLAGS_OPT = -O3 -convert big_endian -FR" \
+	"FFLAGS_OPT = -O3 -convert big_endian -free -align array64byte" \
 	"CFLAGS_OPT = -O3" \
 	"CXXFLAGS_OPT = -O3" \
 	"LDFLAGS_OPT = -O3" \
-	"FFLAGS_DEBUG = -g -convert big_endian -FR -CU -CB -check all -fpe0 -traceback" \
+	"FFLAGS_DEBUG = -g -convert big_endian -free -CU -CB -check all -fpe0 -traceback" \
 	"CFLAGS_DEBUG = -g -traceback" \
 	"CXXFLAGS_DEBUG = -g -traceback" \
 	"LDFLAGS_DEBUG = -g -fpe0 -traceback" \
@@ -158,7 +158,7 @@ ifort:
 	"DEBUG = $(DEBUG)" \
 	"USE_PAPI = $(USE_PAPI)" \
 	"OPENMP = $(OPENMP)" \
-	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" )
+	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" )
 
 ifort-scorep:
 	( $(MAKE) all \
@@ -169,11 +169,11 @@ ifort-scorep:
 	"CC_SERIAL = icc" \
 	"CXX_SERIAL = icpc" \
 	"FFLAGS_PROMOTION = -real-size 64" \
-	"FFLAGS_OPT = -O3 -g -convert big_endian -FR" \
+	"FFLAGS_OPT = -O3 -g -convert big_endian -free -align array64byte" \
 	"CFLAGS_OPT = -O3 -g" \
 	"CXXFLAGS_OPT = -O3 -g" \
 	"LDFLAGS_OPT = -O3 -g" \
-	"FFLAGS_DEBUG = -g -convert big_endian -FR -CU -CB -check all -fpe0 -traceback" \
+	"FFLAGS_DEBUG = -g -convert big_endian -free -CU -CB -check all -fpe0 -traceback" \
 	"CFLAGS_DEBUG = -g -traceback" \
 	"CXXFLAGS_DEBUG = -g -traceback" \
 	"LDFLAGS_DEBUG = -g -fpe0 -traceback" \
@@ -183,7 +183,7 @@ ifort-scorep:
 	"DEBUG = $(DEBUG)" \
 	"USE_PAPI = $(USE_PAPI)" \
 	"OPENMP = $(OPENMP)" \
-	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" )
+	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" )
 
 ifort-gcc:
 	( $(MAKE) all \
@@ -194,11 +194,11 @@ ifort-gcc:
 	"CC_SERIAL = gcc" \
 	"CXX_SERIAL = g++" \
 	"FFLAGS_PROMOTION = -real-size 64" \
-	"FFLAGS_OPT = -O3 -convert big_endian -FR" \
+	"FFLAGS_OPT = -O3 -convert big_endian -free -align array64byte" \
 	"CFLAGS_OPT = -O3" \
 	"CXXFLAGS_OPT = -O3" \
 	"LDFLAGS_OPT = -O3" \
-	"FFLAGS_DEBUG = -g -convert big_endian -FR -CU -CB -check all -fpe0 -traceback" \
+	"FFLAGS_DEBUG = -g -convert big_endian -free -CU -CB -check all -fpe0 -traceback" \
 	"CFLAGS_DEBUG = -g" \
 	"CXXFLAGS_DEBUG = -g" \
 	"LDFLAGS_DEBUG = -g -fpe0 -traceback" \
@@ -208,7 +208,7 @@ ifort-gcc:
 	"DEBUG = $(DEBUG)" \
 	"USE_PAPI = $(USE_PAPI)" \
 	"OPENMP = $(OPENMP)" \
-	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" )
+	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" )
 
 gfortran:
 	( $(MAKE) all \
@@ -233,7 +233,7 @@ gfortran:
 	"DEBUG = $(DEBUG)" \
 	"USE_PAPI = $(USE_PAPI)" \
 	"OPENMP = $(OPENMP)" \
-	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" )
+	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" )
 
 gfortran-clang:
 	( $(MAKE) all \
@@ -258,7 +258,7 @@ gfortran-clang:
 	"DEBUG = $(DEBUG)" \
 	"USE_PAPI = $(USE_PAPI)" \
 	"OPENMP = $(OPENMP)" \
-	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" )
+	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" )
 
 g95:
 	( $(MAKE) all \
@@ -279,7 +279,7 @@ g95:
 	"DEBUG = $(DEBUG)" \
 	"USE_PAPI = $(USE_PAPI)" \
 	"OPENMP = $(OPENMP)" \
-	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" )
+	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" )
 
 pathscale-nersc:
 	( $(MAKE) all \
@@ -300,7 +300,7 @@ pathscale-nersc:
 	"DEBUG = $(DEBUG)" \
 	"USE_PAPI = $(USE_PAPI)" \
 	"OPENMP = $(OPENMP)" \
-	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" )
+	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" )
 
 cray-nersc:
 	( $(MAKE) all \
@@ -321,7 +321,7 @@ cray-nersc:
 	"DEBUG = $(DEBUG)" \
 	"USE_PAPI = $(USE_PAPI)" \
 	"OPENMP = $(OPENMP)" \
-	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" )
+	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" )
 
 gnu-nersc:
 	( $(MAKE) all \
@@ -344,7 +344,7 @@ gnu-nersc:
 	"DEBUG = $(DEBUG)" \
 	"SERIAL = $(SERIAL)" \
 	"USE_PAPI = $(USE_PAPI)" \
-	"CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE -D_MPI $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
 
 intel-nersc:
 	( $(MAKE) all \
@@ -355,13 +355,13 @@ intel-nersc:
 	"CC_SERIAL = cc" \
 	"CXX_SERIAL = CC" \
 	"FFLAGS_PROMOTION = -real-size 64" \
-	"FFLAGS_OPT = -O3 -convert big_endian -FR" \
+	"FFLAGS_OPT = -O3 -convert big_endian -free -align array64byte" \
 	"CFLAGS_OPT = -O3" \
 	"CXXFLAGS_OPT = -O3" \
 	"LDFLAGS_OPT = -O3" \
 	"FFLAGS_OMP = -qopenmp" \
 	"CFLAGS_OMP = -qopenmp" \
-	"FFLAGS_DEBUG = -real-size 64 -g -convert big_endian -FR -CU -CB -check all -gen-interfaces -warn interfaces -traceback" \
+	"FFLAGS_DEBUG = -real-size 64 -g -convert big_endian -free -CU -CB -check all -gen-interfaces -warn interfaces -traceback" \
 	"CFLAGS_DEBUG = -g -traceback" \
 	"CXXFLAGS_DEBUG = -g -traceback" \
 	"LDFLAGS_DEBUG = -g -traceback" \
@@ -369,7 +369,7 @@ intel-nersc:
 	"DEBUG = $(DEBUG)" \
 	"USE_PAPI = $(USE_PAPI)" \
 	"OPENMP = $(OPENMP)" \
-	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" )
+	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" )
 
 bluegene:
 	( $(MAKE) all \
@@ -396,41 +396,79 @@ bluegene:
 	"OPENMP = $(OPENMP)" \
 	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" )
 
+llvm:
+	( $(MAKE) all \
+	"FC_PARALLEL = mpifort" \
+	"CC_PARALLEL = mpicc" \
+	"CXX_PARALLEL = mpic++" \
+	"FC_SERIAL = flang" \
+	"CC_SERIAL = clang" \
+	"CXX_SERIAL = clang++" \
+	"FFLAGS_PROMOTION = -r8" \
+	"FFLAGS_OPT = -O3 -g -Mbyteswapio -Mfreeform" \
+	"CFLAGS_OPT = -O3 -g" \
+	"CXXFLAGS_OPT = -O3 -g" \
+	"LDFLAGS_OPT = -O3 -g" \
+	"FFLAGS_DEBUG = -O0 -g -Mbounds -Mchkptr -Mbyteswapio -Mfreeform -Mstandard" \
+	"CFLAGS_DEBUG = -O0 -g -Weverything" \
+	"CXXFLAGS_DEBUG = -O0 -g -Weverything" \
+	"LDFLAGS_DEBUG = -O0 -g" \
+	"FFLAGS_OMP = -mp" \
+	"CFLAGS_OMP = -fopenmp" \
+	"CORE = $(CORE)" \
+	"DEBUG = $(DEBUG)" \
+	"USE_PAPI = $(USE_PAPI)" \
+	"OPENMP = $(OPENMP)" \
+	"CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" )
+
 CPPINCLUDES = 
 FCINCLUDES = 
 LIBS = 
-ifneq ($(wildcard $(PIO)/lib), ) # Check for newer PIO version
+
+#
+# If user has indicated a PIO2 library, define USE_PIO2 pre-processor macro
+#
 ifeq "$(USE_PIO2)" "true"
-	CPPINCLUDES = -DUSE_PIO2 -I$(PIO)/include
-	FCINCLUDES = -DUSE_PIO2 -I$(PIO)/include
-	LIBS = -L$(PIO)/lib -lpiof -lpioc
-ifneq ($(wildcard $(PIO)/lib/libgptl.a), ) # Check for GPTL library for PIO2
-	LIBS += -lgptl
+	override CPPFLAGS += -DUSE_PIO2
 endif
+
+#
+# Regardless of PIO library version, look for a lib subdirectory of PIO path
+# NB: PIO_LIB is used later, so we don't just set LIBS directly
+#
+ifneq ($(wildcard $(PIO)/lib), )
+	PIO_LIB = $(PIO)/lib
 else
-	CPPINCLUDES = -I$(PIO)/include
-	FCINCLUDES = -I$(PIO)/include
-	LIBS = -L$(PIO)/lib -lpio
+	PIO_LIB = $(PIO)
 endif
+LIBS = -L$(PIO_LIB)
+
+#
+# Regardless of PIO library version, look for an include subdirectory of PIO path
+#
+ifneq ($(wildcard $(PIO)/include), )
+	CPPINCLUDES += -I$(PIO)/include
+	FCINCLUDES += -I$(PIO)/include
 else
-ifeq "$(USE_PIO2)" "true"
-	CPPINCLUDES = -DUSE_PIO2 -I$(PIO)/include
-	FCINCLUDES = -DUSE_PIO2 -I$(PIO)/include
-	LIBS = -L$(PIO) -lpiof -lpioc
-ifneq ($(wildcard $(PIO)/libgptl.a), ) # Check for GPTL library for PIO2
-	LIBS += -lgptl
+	CPPINCLUDES += -I$(PIO)
+	FCINCLUDES += -I$(PIO)
 endif
-else
-	CPPINCLUDES = -I$(PIO)
-	FCINCLUDES = -I$(PIO)
-	LIBS = -L$(PIO) -lpio
+
+#
+# Depending on PIO version, libraries may be libpio.a, or libpiof.a and libpioc.a
+# Keep open the possibility of shared libraries in future with, e.g., .so suffix
+#
+ifneq ($(wildcard $(PIO_LIB)/libpio\.*), )
+	LIBS += -lpio
 endif
+ifneq ($(wildcard $(PIO_LIB)/libpiof\.*), )
+	LIBS += -lpiof
 endif
-
-ifneq "$(PNETCDF)" ""
-	CPPINCLUDES += -I$(PNETCDF)/include
-	FCINCLUDES += -I$(PNETCDF)/include
-	LIBS += -L$(PNETCDF)/lib -lpnetcdf
+ifneq ($(wildcard $(PIO_LIB)/libpioc\.*), )
+	LIBS += -lpioc
+endif
+ifneq ($(wildcard $(PIO_LIB)/libgptl\.*), )
+	LIBS += -lgptl
 endif
 
 ifneq "$(NETCDF)" ""
@@ -450,6 +488,13 @@ ifneq "$(NETCDF)" ""
 	LIBS += $(NCLIB)
 endif
 
+
+ifneq "$(PNETCDF)" ""
+	CPPINCLUDES += -I$(PNETCDF)/include
+	FCINCLUDES += -I$(PNETCDF)/include
+	LIBS += -L$(PNETCDF)/lib -lpnetcdf
+endif
+
 RM = rm -f
 CPP = cpp -P -traditional
 RANLIB = ranlib
@@ -574,6 +619,7 @@ else
 endif
 
 ifeq "$(GEN_F90)" "true"
+	override CPPFLAGS += -Uvector
 	GEN_F90_MESSAGE="MPAS generated and was built with intermediate .f90 files."
 else
 	override GEN_F90=false
@@ -670,7 +716,7 @@ endif
 endif
 
 
-compiler_test:
+openmp_test:
 ifeq "$(OPENMP)" "true"
 	@echo "Testing compiler for OpenMP support"
 	@echo "#include <omp.h>" > conftest.c; echo "int main() { int n = omp_get_num_threads(); return 0; }" >> conftest.c; $(SCC) $(CFLAGS) -o conftest.out conftest.c || \
@@ -687,7 +733,47 @@ ifeq "$(OPENMP)" "true"
 endif
 
 
-mpas_main: compiler_test
+pio_test:
+	@#
+	@# Create two test programs: one that should work with PIO1 and a second that should work with PIO2
+	@#
+	@echo "program pio1; use pio; use pionfatt_mod; integer, parameter :: MPAS_IO_OFFSET_KIND = PIO_OFFSET; integer, parameter :: MPAS_INT_FILLVAL = NF_FILL_INT; end program" > pio1.f90
+	@echo "program pio2; use pio; integer, parameter :: MPAS_IO_OFFSET_KIND = PIO_OFFSET_KIND; integer, parameter :: MPAS_INT_FILLVAL = PIO_FILL_INT; end program" > pio2.f90
+
+	@#
+	@# See whether either of the test programs can be compiled
+	@#
+	@echo "Checking for a usable PIO library..."
+	@($(FC) pio1.f90 $(FCINCLUDES) $(FFLAGS) $(LDFLAGS) $(LIBS) -o pio1.out &> /dev/null && echo "=> PIO 1 detected") || \
+	 ($(FC) pio2.f90 $(FCINCLUDES) $(FFLAGS) $(LDFLAGS) $(LIBS) -o pio2.out &> /dev/null && echo "=> PIO 2 detected") || \
+	 (echo "************ ERROR ************"; \
+	  echo "Failed to compile a PIO test program"; \
+	  echo "Please ensure the PIO environment variable is set to the PIO installation directory"; \
+	  echo "************ ERROR ************"; \
+	  rm -rf pio[12].f90 pio[12].out; exit 1)
+
+	@rm -rf pio[12].out
+
+	@#
+	@# Check that what the user has specified agrees with the PIO library version that was detected
+	@#
+ifeq "$(USE_PIO2)" "true"
+	@($(FC) pio2.f90 $(FCINCLUDES) $(FFLAGS) $(LDFLAGS) $(LIBS) -o pio2.out &> /dev/null) || \
+	(echo "************ ERROR ************"; \
+	 echo "PIO 1 was detected, but USE_PIO2=true was specified in the make command"; \
+	 echo "************ ERROR ************"; \
+	 rm -rf pio[12].f90 pio[12].out; exit 1)
+else
+	@($(FC) pio1.f90 $(FCINCLUDES) $(FFLAGS) $(LDFLAGS) $(LIBS) -o pio1.out &> /dev/null) || \
+	(echo "************ ERROR ************"; \
+	 echo "PIO 2 was detected. Please specify USE_PIO2=true in the make command"; \
+	 echo "************ ERROR ************"; \
+	 rm -rf pio[12].f90 pio[12].out; exit 1)
+endif
+	@rm -rf pio[12].f90 pio[12].out
+
+
+mpas_main: openmp_test pio_test
 ifeq "$(AUTOCLEAN)" "true"
 	$(RM) .mpas_core_*
 endif
diff --git a/README.md b/README.md
index 8d0be792c3..c29fec6914 100644
--- a/README.md
+++ b/README.md
@@ -1,4 +1,4 @@
-MPAS-v6.3
+MPAS-v7.0
 ====
 
 The Model for Prediction Across Scales (MPAS) is a collaborative project for
diff --git a/src/Makefile.in.CESM b/src/Makefile.in.CESM
deleted file mode 100644
index 7644f65c4a..0000000000
--- a/src/Makefile.in.CESM
+++ /dev/null
@@ -1,90 +0,0 @@
-# Duplicate logic from Tools/Makefile to set compile_threaded
-compile_threaded = false
-ifeq ($(strip $(SMP)),TRUE)
-   compile_threaded = true
-   THREADDIR = threads
-else
-   ifeq ($(strip $(BUILD_THREADED)),TRUE)
-      compile_threaded = true
-      THREADDIR = threads
-   else
-      THREADDIR = nothreads
-   endif
-endif
-# End duplicated logic
-
-include $(CASEROOT)/Macros.make
-
-ifneq ($(wildcard core_$(CORE)/build_options.mk), ) # Check for build_options.mk
-    include core_$(CORE)/build_options.mk
-else # ELSE Use Default Options
-    EXE_NAME=$(CORE)_model
-    NAMELIST_SUFFIX=$(CORE)
-endif
-
-# Map the ESM component corresponding to each MPAS core
-ifeq "$(CORE)" "ocean"
-    COMPONENT=ocn
-else ifeq "$(CORE)" "landice"
-    COMPONENT=glc
-else ifeq "$(CORE)" "seaice"
-    COMPONENT=ice
-endif
-
-ifeq ($(strip $(USE_ESMF_LIB)), TRUE)
-   ESMFDIR = esmf
-else
-   ESMFDIR = noesmf
-endif
-
-RM = rm -f
-CPP = cpp -P -traditional
-FC=$(MPIFC)
-CC=$(MPICC)
-CXX=$(MPICXX)
-NETCDF=$(NETCDF_PATH)
-PNETCDF=$(PNETCDF_PATH)
-PIO=$(EXEROOT)/pio
-FILE_OFFSET = -DOFFSET64BIT
-override CFLAGS += -DMPAS_NO_LOG_REDIRECT -DMPAS_NO_ESMF_INIT -DMPAS_ESM_SHR_CONST -DMPAS_PERF_MOD_TIMERS
-override FFLAGS += -DMPAS_NO_LOG_REDIRECT -DMPAS_NO_ESMF_INIT -DMPAS_ESM_SHR_CONST -DMPAS_PERF_MOD_TIMERS
-override CPPFLAGS += $(CPPDEFS) $(MODEL_FORMULATION) $(FILE_OFFSET) $(ZOLTAN_DEFINE) -DMPAS_NO_LOG_REDIRECT -DMPAS_NO_ESMF_INIT -DMPAS_ESM_SHR_CONST -D_MPI -DMPAS_NAMELIST_SUFFIX=$(NAMELIST_SUFFIX) -DMPAS_EXE_NAME=$(EXE_NAME) -DMPAS_PERF_MOD_TIMERS
-override CPPINCLUDES += -I$(EXEROOT)/$(COMPONENT)/source/inc -I$(SHAREDPATH)/include -I$(SHAREDPATH)/$(COMP_INTERFACE)/$(ESMFDIR)/$(NINST_VALUE)/csm_share -I$(NETCDF)/include -I$(PIO) -I$(PNETCDF)/include
-override FCINCLUDES += -I$(EXEROOT)/$(COMPONENT)/source/inc -I$(SHAREDPATH)/include -I$(SHAREDPATH)/$(COMP_INTERFACE)/$(ESMFDIR)/$(NINST_VALUE)/csm_share -I$(NETCDF)/include -I$(PIO) -I$(PNETCDF)/include
-LIBS += -L$(PIO) -L$(PNETCDF)/lib -L$(NETCDF)/lib -L$(LIBROOT) -L$(SHAREDPATH)/lib -lpio -lpnetcdf -lnetcdf
-
-ifneq (,$(findstring FORTRANUNDERSCORE, $(CPPFLAGS)))
-ifeq (,$(findstring DUNDERSCORE, $(CPPFLAGS)))
-    override CPPFLAGS += -DUNDERSCORE
-endif
-endif
-
-ifeq ($(DEBUG), TRUE)
-    override CPPFLAGS += -DMPAS_DEBUG
-endif
-
-ifeq ($(compile_threaded), true)
-    override CPPFLAGS += -DMPAS_OPENMP
-endif
-
-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)" \
-	  CPPFLAGS="$(CPPFLAGS)" CPPINCLUDES="$(CPPINCLUDES)" FCINCLUDES="$(FCINCLUDES)" \
-	  FFLAGS="$(FFLAGS)" CFLAGS="$(CFLAGS)" LDFLAGS="$(LDFLAGS)" )
-
-mpas: externals frame ops dycore drver
-	ar ru lib$(COMPONENT).a framework/*.o
-	ar ru lib$(COMPONENT).a operators/*.o
-	ar ru lib$(COMPONENT).a external/ezxml/*.o
-	ar ru lib$(COMPONENT).a `find core_$(CORE)/ -type f -name "*.o"`  # Find command finds objects in any subdirectories
-	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 )
-
-drver: externals frame ops dycore
-	( cd $(DRIVER); $(MAKE) CPPFLAGS="$(CPPFLAGS)" CPPINCLUDES="$(CPPINCLUDES)" FREEFLAGS="$(FREEFLAGS)" all ) 
-
diff --git a/src/Makefile.in.ACME b/src/Makefile.in.E3SM
similarity index 92%
rename from src/Makefile.in.ACME
rename to src/Makefile.in.E3SM
index ad507cf3af..1988564a83 100644
--- a/src/Makefile.in.ACME
+++ b/src/Makefile.in.E3SM
@@ -1,11 +1,11 @@
 # Duplicate logic from Tools/Makefile to set compile_threaded
-compile_threaded = false
+compile_threaded = FALSE
 ifeq ($(strip $(SMP)),TRUE)
-   compile_threaded = true
+   compile_threaded = TRUE
    THREADDIR = threads
 else
    ifeq ($(strip $(BUILD_THREADED)),TRUE)
-      compile_threaded = true
+      compile_threaded = TRUE
       THREADDIR = threads
    else
       THREADDIR = nothreads
@@ -53,20 +53,18 @@ override CPPINCLUDES += -I$(EXEROOT)/$(COMPONENT)/source/inc -I$(INSTALL_SHAREDP
 override FCINCLUDES += -I$(EXEROOT)/$(COMPONENT)/source/inc -I$(INSTALL_SHAREDPATH)/include -I$(INSTALL_SHAREDPATH)/$(COMP_INTERFACE)/$(ESMFDIR)/$(NINST_VALUE)/csm_share -I$(NETCDF)/include -I$(PIO) -I$(PNETCDF)/include
 LIBS += -L$(PIO) -L$(PNETCDF)/lib -L$(NETCDF)/lib -L$(LIBROOT) -L$(INSTALL_SHAREDPATH)/lib -lpio -lpnetcdf -lnetcdf
 
-ifneq (,$(findstring FORTRANUNDERSCORE, $(CPPFLAGS)))
-ifeq (,$(findstring DUNDERSCORE, $(CPPFLAGS)))
-    override CPPFLAGS += -DUNDERSCORE
-endif
-endif
-
 ifeq ($(DEBUG), TRUE)
     override CPPFLAGS += -DMPAS_DEBUG
 endif
 
-ifeq ($(compile_threaded), true)
+ifeq ($(compile_threaded), TRUE)
     override CPPFLAGS += -DMPAS_OPENMP
 endif
 
+ifeq "$(GEN_F90)" "true"
+    override CPPFLAGS += -Uvector
+endif
+
 all:
 	@echo $(CPPINCLUDES)
 	@echo $(FCINCLUDES)
diff --git a/src/core_atmosphere/Makefile b/src/core_atmosphere/Makefile
index 2e77cf8846..0909d55952 100644
--- a/src/core_atmosphere/Makefile
+++ b/src/core_atmosphere/Makefile
@@ -70,8 +70,8 @@ clean:
 .F.o:
 	$(RM) $@ $*.mod
 ifeq "$(GEN_F90)" "true"
-	$(CPP) $(CPPFLAGS) $(PHYSICS) $(CPPINCLUDES) $< > $*.f90
+	$(CPP) $(CPPFLAGS) $(PHYSICS) $(CPPINCLUDES) -I./inc $< > $*.f90
 	$(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I../framework -I../operators -I./physics -I./dynamics -I./diagnostics -I./physics/physics_wrf -I../external/esmf_time_f90
 else
-	$(FC) $(CPPFLAGS) $(PHYSICS) $(FFLAGS) -c $*.F $(CPPINCLUDES) $(FCINCLUDES) -I../framework -I../operators -I./physics -I./dynamics -I./diagnostics -I./physics/physics_wrf -I../external/esmf_time_f90
+	$(FC) $(CPPFLAGS) $(PHYSICS) $(FFLAGS) -c $*.F $(CPPINCLUDES) $(FCINCLUDES) -I./inc -I../framework -I../operators -I./physics -I./dynamics -I./diagnostics -I./physics/physics_wrf -I../external/esmf_time_f90
 endif
diff --git a/src/core_atmosphere/Registry.xml b/src/core_atmosphere/Registry.xml
index 2e16e764b8..e4cf270af4 100644
--- a/src/core_atmosphere/Registry.xml
+++ b/src/core_atmosphere/Registry.xml
@@ -1,5 +1,5 @@
 <?xml version="1.0"?>
-<registry model="mpas" core="atmosphere" core_abbrev="atm" version="6.3">
+<registry model="mpas" core="atmosphere" core_abbrev="atm" version="7.0">
 
 <!-- **************************************************************************************** -->
 <!-- ************************************** Dimensions ************************************** -->
@@ -101,7 +101,7 @@
 
                 <nml_option name="config_dynamics_split_steps" type="integer" default_value="3"
                      units="-"
-                     description="When config\_split\_dynamics\_transport = T, the number of RK steps per transport step"
+                     description="When config_split_dynamics_transport = T, the number of RK steps per transport step"
                      possible_values="Positive integer values"/>
 
                 <nml_option name="config_h_mom_eddy_visc2" type="real" default_value="0.0"
@@ -255,8 +255,35 @@
                      units="-"
                      description="Maximum w-damping coefficient at model top"
                      possible_values="0 $\leq$ config_xnutr $\leq$ 1"/>
+
+                <nml_option name="config_mpas_cam_coef" type="real" default_value="0.0" in_defaults="false"
+                     units="-"
+                     description="Coefficient for scaling the 2nd-order horizontal mixing in the mpas_cam absorbing layer"
+                     possible_values="0 $\leq$ config_mpas_cam_coef $\leq$ 1, standard value is 0.2"/>
+
+                <nml_option name="config_rayleigh_damp_u" type="logical" default_value="false" in_defaults="false"
+                     units="-"
+                     description="Whether to apply Rayleigh damping on horizontal velocity in the top-most model levels. The number of levels is specified by the config_number_rayleigh_damp_u_levels option, and the damping timescale is specified by the config_rayleigh_damp_u_timescale_days option."
+                     possible_values=".true. or .false."/>
+
+                <nml_option name="config_rayleigh_damp_u_timescale_days" type="real" default_value="5.0" in_defaults="false"
+                     units="days"
+                     description="Timescale, in days (86400 s), for the Rayleigh damping on horizontal velocity in the top-most model levels."
+                     possible_values="Positive real values"/>
+
+                <nml_option name="config_number_rayleigh_damp_u_levels" type="integer" default_value="6" in_defaults="false"
+                     units="-"
+                     description="Number layers in which to apply Rayleigh damping on horizontal velocity at top of model; damping linearly ramps to zero by layer number from the top"
+                     possible_values="Positive integer values"/>
         </nml_record>
 
+        <nml_record name="limited_area" in_defaults="true">
+                <nml_option name="config_apply_lbcs" type="logical" default_value="false"
+                     units="-"
+                     description="Whether to apply lateral boundary conditions"
+                     possible_values="true or false; this option must be set to true for limited-area simulations and false for global simulations"/>
+	</nml_record>
+
         <nml_record name="io" in_defaults="true">
                 <nml_option name="config_restart_timestamp_name" type="character" default_value="restart_timestamp" in_defaults="false"
                      units="-"
@@ -336,6 +363,12 @@
                      possible_values="Non-negative real values"/>
 	</nml_record>
 
+        <nml_record name="assimilation" in_defaults="false">
+                <nml_option name="config_jedi_da" type="logical" default_value="false"
+                     units="-"
+                     description="Whether this run is within the JEDI data assimilation framework; used to add temperature and specific humidity as diagnostics"
+                     possible_values=".true. or .false."/>
+        </nml_record>
 
 <!-- **************************************************************************************** -->
 <!-- **************************************  Packages  ************************************** -->
@@ -352,6 +385,8 @@
                 <package name="bl_mynn_in" description="parameterization of MYNN Planetary Boundary Layer."/>
 
                 <package name="iau" description="Incremental Analysis Update"/>
+                <package name="limited_area" description="Limited-area simulations, which have lateral boundaries"/>
+                <package name="jedi_da" description="Data Assimilation in JEDI framework"/>
         </packages>
 
 
@@ -407,6 +442,9 @@
 			<var name="fEdge"/>
 			<var name="fVertex"/>
 			<var name="meshDensity"/>
+			<var name="bdyMaskCell"/>
+			<var name="bdyMaskEdge"/>
+			<var name="bdyMaskVertex"/>
 			<var name="cf1"/>
 			<var name="cf2"/>
 			<var name="cf3"/>
@@ -422,6 +460,7 @@
 			<var name="zb3"/>
 			<var name="dss"/>
 			<var name="u_init"/>
+			<var name="v_init"/>
 			<var name="t_init"/>
 			<var name="qv_init"/>
 			<var name="deriv_two"/>
@@ -442,6 +481,8 @@
 			<var name="isltyp"/>
 			<var name="ivgtyp"/>
 			<var name="mminlu"/>
+			<var name="isice_lu"/>
+			<var name="iswater_lu"/>
 			<var name="landmask"/>
 			<var name="shdmin"/>
 			<var name="shdmax"/>
@@ -531,6 +572,11 @@
 			<var name="meshDensity"/>
 			<var name="meshScalingDel2"/>
 			<var name="meshScalingDel4"/>
+			<var name="meshScalingRegionalCell"/>
+			<var name="meshScalingRegionalEdge"/>
+			<var name="bdyMaskCell"/>
+			<var name="bdyMaskEdge"/>
+			<var name="bdyMaskVertex"/>
 			<var name="cf1"/>
 			<var name="cf2"/>
 			<var name="cf3"/>
@@ -546,6 +592,7 @@
 			<var name="zb3"/>
 			<var name="dss"/>
 			<var name="u_init"/>
+			<var name="v_init"/>
 			<var name="t_init"/>
 			<var name="qv_init"/>
 			<var name="deriv_two"/>
@@ -711,6 +758,7 @@
 			<var name="noahres"/>
 			<var name="potevp"/>
 			<var name="sfc_albedo"/>
+			<var name="sfc_albedo_seaice"/>
 			<var name="sfc_emiss"/>
 			<var name="sfc_emibck"/>
 			<var name="sfcrunoff"/>
@@ -758,6 +806,8 @@
 			<var name="isltyp"/>
 			<var name="ivgtyp"/>
 			<var name="mminlu"/>
+			<var name="isice_lu"/>
+			<var name="iswater_lu"/>
 			<var name="landmask"/>
 			<var name="shdmin"/>
 			<var name="shdmax"/>
@@ -907,6 +957,8 @@
 			<var name="pin"/>
 			<var name="ozmixm"/>
 			<var name="mminlu"/>
+			<var name="isice_lu"/>
+			<var name="iswater_lu"/>
 			<var name="xland"/>
 			<var name="skintemp"/>
 			<var name="snow"/>
@@ -1048,6 +1100,23 @@
 			<var name="xtime"/>
 			<var_struct name="tend_iau"/>
 		</stream>
+
+                <stream name="lbc_in"
+                        type="input"
+                        filename_template="lbc.$Y-$M-$D_$h.$m.$s.nc"
+                        filename_interval="input_interval"
+                        input_interval="3:00:00" 
+                        runtime_format="single_file"
+                        immutable="true"
+                        packages="limited_area">
+
+                        <var name="lbc_u" />
+                        <var name="lbc_w" />
+                        <var name="lbc_rho" />
+                        <var name="lbc_theta" />
+                        <var_array name="lbc_scalars" />
+
+                </stream>
 	</streams>
 
 
@@ -1199,6 +1268,12 @@
                 <var name="meshScalingDel4" type="real" dimensions="nEdges" units="unitless"
                      description="Scaling coefficient for $\nabla^4$ eddy hyper-viscosity"/>
 
+                <var name="meshScalingRegionalCell" type="real" dimensions="nCells" units="unitless"
+                     description="Cell-centered Scaling coefficient for relaxation zone"/>
+
+                <var name="meshScalingRegionalEdge" type="real" dimensions="nEdges" units="unitless"
+                     description="Edge-centered Scaling coefficient for relaxation zone"/>
+
                 <var name="edgesOnVertex_sign" type="real" dimensions="vertexDegree nVertices" units="-"
                      description="Sign for edges incident with a vertex: positive for positive inward tengential velocity"/>
 
@@ -1263,6 +1338,9 @@
                 <var name="u_init" type="real" dimensions="nVertLevels" units="m s^{-1}"
                      description="u reference profile"/>
 
+                <var name="v_init" type="real" dimensions="nVertLevels" units="m s^{-1}"
+                     description="v reference profile"/>
+
                 <var name="t_init" type="real" dimensions="nVertLevels nCells" units="K"
                      description="theta reference profile"/>
 
@@ -1301,6 +1379,34 @@
 
                 <var name="north" type="real" dimensions="R3 nCells" units="unitless"
                      description="Cartesian components of the unit vector pointing north"/>
+
+                <var name="bdyMaskCell" type="integer" dimensions="nCells" default_value="0"
+                     units="-"
+                     description="Limited-area specified/relaxation zone index for cells"/>
+
+                <var name="bdyMaskEdge" type="integer" dimensions="nEdges" default_value="0"
+                     units="-"
+                     description="Limited-area specified/relaxation zone index for edges"/>
+
+                <var name="bdyMaskVertex" type="integer" dimensions="nVertices" default_value="0"
+                     units="-"
+                     description="Limited-area specified/relaxation zone index for vertices"/>
+
+                <var name="specZoneMaskCell" type="real" dimensions="nCells" default_value="0.0"
+                     units="-"
+                     description="0/1 mask on cells, defined as 1 for cells in the limited-area specified zone"/>
+
+                <var name="specZoneMaskEdge" type="real" dimensions="nEdges" default_value="0.0"
+                     units="-"
+                     description="0/1 mask on edges, defined as 1 for edges in the limited-area specified zone"/>
+
+                <var name="specZoneMaskVertex" type="real" dimensions="nVertices" default_value="0.0"
+                     units="-"
+                     description="0/1 mask on vertices, defined as 1 for vertices in the limited-area specified zone"/>
+
+                <var name="nearestRelaxationCell" type="integer" dimensions="nCells" units="-"
+                     description="For cells in the specified zone, gives the index of the nearest cell in the relaxation zone"/>
+
         </var_struct>
 
         <var_struct name="state" time_levs="2">
@@ -1439,9 +1545,17 @@
                 <var name="theta" type="real" dimensions="nVertLevels nCells Time" units="K"
                      description="Potential temperature"/>
 
+                <var name="temperature" type="real" dimensions="nVertLevels nCells Time" units="K"
+                     description="temperature"
+                     packages="jedi_da"/>
+
                 <var name="relhum" type="real" dimensions="nVertLevels nCells Time" units="percent"
                      description="Relative humidity"/>
 
+                <var name="spechum" type="real" dimensions="nVertLevels nCells Time" units="kg kg^{-1}"
+                     description="Specific humidity"
+                     packages="jedi_da"/>
+
                 <var name="v" type="real" dimensions="nVertLevels nEdges Time" units="m s^{-1}"
                      description="Horizontal tangential velocity at edges"/>
 
@@ -1664,6 +1778,63 @@
                 </var_array>
         </var_struct>
 
+        <!-- ===================================================================================== -->
+        <!-- Storage for lateral boundary conditions:                                              -->
+        <!-- Time-level 1 contains tendencies for variables                                        -->
+        <!-- Time-level 2 contains values for variables valid at the end of the boundary interval  -->
+        <!-- ===================================================================================== -->
+        <var_struct name="lbc" time_levs="2" packages="limited_area">
+                <var name="lbc_u" type="real" dimensions="nVertLevels nEdges Time" units="m s^{-2}"
+                     description="Lateral boundary tendency of u"/>
+
+                <var name="lbc_ru" type="real" dimensions="nVertLevels nEdges Time" units="kg m^{-2} s^{-2}"
+                     description="Lateral boundary tendency of rho_zz-coupled u"/>
+
+                <var name="lbc_w" type="real" dimensions="nVertLevelsP1 nCells Time" units="m s^{-2}"
+                     description="Lateral boundary tendency of w"/>
+
+                <var name="lbc_rho" type="real" dimensions="nVertLevels nCells Time" units="kg m^{-3} s^{-1}"
+                     description="Lateral boundary tendency of rho"/>
+
+                <var name="lbc_rho_zz" type="real" dimensions="nVertLevels nCells Time" units="kg m^{-3} s^{-1}"
+                     description="Lateral boundary tendency of rho_zz"/>
+
+                <var name="lbc_rho_edge" type="real" dimensions="nVertLevels nEdges Time" units="kg m^{-3} s^{-1}"
+                     description="Lateral boundary tendency of rho_zz averaged from cell centers to cell faces (edges)"/>
+
+                <var name="lbc_theta" type="real" dimensions="nVertLevels nCells Time" units="K s^{-2}"
+                     description="Lateral boundary tendency of theta"/>
+
+                <var name="lbc_rtheta_m" type="real" dimensions="nVertLevels nCells Time" units="kg K m^{-3} s^{-2}"
+                     description="Lateral boundary tendency of rho_zz-coupled theta_m"/>
+
+                <var_array name="lbc_scalars" type="real" dimensions="nVertLevels nCells Time">
+                        <var name="lbc_qv" name_in_code="qv" array_group="moist" units="kg kg^{-1} s^{-1}"
+                             description="Lateral boundary tendency of water vapor mixing ratio"/>
+
+                        <var name="lbc_qc" name_in_code="qc" array_group="moist"  packages="bl_mynn_in;cu_tiedtke_in;mp_kessler_in;mp_thompson_in;mp_wsm6_in" units="kg kg^{-1} s^{-1}"
+                             description="Lateral boundary tendency of cloud water mixing ratio"/>
+
+                        <var name="lbc_qr" name_in_code="qr" array_group="moist"  packages="mp_kessler_in;mp_thompson_in;mp_wsm6_in" units="kg kg^{-1} s^{-1}"
+                             description="Lateral boundary tendency of rain water mixing ratio"/>
+
+                        <var name="lbc_qi" name_in_code="qi" array_group="moist"  packages="bl_mynn_in;cu_tiedtke_in;mp_thompson_in;mp_wsm6_in" units="kg kg^{-1} s^{-1}"
+                             description="Lateral boundary tendency of ice mixing ratio"/>
+
+                        <var name="lbc_qs" name_in_code="qs" array_group="moist"  packages="mp_thompson_in;mp_wsm6_in" units="kg kg^{-1} s^{-1}"
+                             description="Lateral boundary tendency of snow mixing ratio"/>
+
+                        <var name="lbc_qg" name_in_code="qg" array_group="moist"  packages="mp_thompson_in;mp_wsm6_in" units="kg kg^{-1} s^{-1}"
+                             description="Lateral boundary tendency of graupel mixing ratio"/>
+
+                        <var name="lbc_nr" name_in_code="nr" array_group="number" packages="mp_thompson_in" units="m^{-3} s^{-1}"
+                             description="Lateral boundary tendency of rain number concentration"/>
+
+                        <var name="lbc_ni" name_in_code="ni" array_group="number" packages="bl_mynn_in;mp_thompson_in" units="m^{-3} s^{-1}"
+                             description="Lateral boundary tendency of ice number concentration"/>
+                </var_array>
+        </var_struct>
+
 
 <!-- ================================================================================================== -->
 <!--  DECLARATIONS OF ALL PHYSICS VARIABLES (will need to be moved to a Physics Registry shared by the  -->
@@ -2367,7 +2538,6 @@
                 <var name="i_acswuptc" type="integer" dimensions="nCells Time" units="unitless"
                      description="incidence of accumulated clear-sky upward top-of-atmosphere shortwave radiation greater than config_bucket_radt"/>
 
-
                 <var name="coszr" type="real" dimensions="nCells Time" units="unitless"
                      description="cosine of zenith solar angle"/>
 
@@ -2378,7 +2548,7 @@
                      description="all-sky downward surface shortwave radiation flux"/>
 
                 <var name="swdnbc" type="real" dimensions="nCells Time" units="W m^{-2}"
-                     description="clear-sky downward surface shortwave radiation flux"/>                
+                     description="clear-sky downward surface shortwave radiation flux"/>
 
                 <var name="swdnt" type="real" dimensions="nCells Time" units="W m^{-2}"
                      description="all-sky downward top-of-atmosphere shortwave radiation flux"/>
@@ -2402,7 +2572,7 @@
                      description="accumulated all-sky downward surface shortwave radiation flux"/>
 
                 <var name="acswdnbc" type="real" dimensions="nCells Time" units="W m^{-2}"
-                     description="accumulated clear-sky downward surface shortwave radiation flux"/>                
+                     description="accumulated clear-sky downward surface shortwave radiation flux"/>
 
                 <var name="acswdnt" type="real" dimensions="nCells Time" units="W m^{-2}"
                      description="accumulated all-sky downward top-of-atmosphere shortwave radiation flux"/>
@@ -2425,7 +2595,6 @@
                 <var name="gsw" type="real" dimensions="nCells Time" units="W m^{-2}"
                      description="net surface shortwave radiation flux"/>
 
-
                 <!-- RRTMG SW ONLY: -->
                 <var name="swdnflx" type="real" dimensions="nVertLevelsP2 nCells Time" units="-"
                      description="-"/>
@@ -2484,22 +2653,22 @@
                      description="clear-sky downward surface longwave radiation flux"/>
 
                 <var name="lwdnt" type="real" dimensions="nCells Time" units="W m^{-2}"
-                     description="clear-sky downward surface longwave radiation flux"/>
+                     description="all-sky downward top-of-the-atmosphere longwave radiation flux"/>
 
                 <var name="lwdntc" type="real" dimensions="nCells Time" units="W m^{-2}"
-                     description="clear-sky downward surface longwave radiation flux"/>
+                     description="clear-sky downward top-of-the-atmosphere longwave radiation flux"/>
 
                 <var name="lwupb" type="real" dimensions="nCells Time" units="W m^{-2}"
                      description="all-sky upward surface longwave radiation flux"/>
 
                 <var name="lwupbc" type="real" dimensions="nCells Time" units="W m^{-2}"
-                     description="all-sky upward surface longwave radiation flux"/>
+                     description="clear-sky upward surface longwave radiation flux"/>
 
                 <var name="lwupt" type="real" dimensions="nCells Time" units="W m^{-2}"
-                     description="all-sky upward surface longwave radiation flux"/>
+                     description="all-sky upward top-of-the-atmosphere longwave radiation flux"/>
 
                 <var name="lwuptc" type="real" dimensions="nCells Time" units="W m^{-2}"
-                     description="all-sky upward surface longwave radiation flux"/>
+                     description="clear-sky upward top-of-the-atmosphere longwave radiation flux"/>
 
                 <var name="aclwdnb" type="real" dimensions="nCells Time" units="W m^{-2}"
                      description="accumulated all-sky downward surface longwave radiation flux"/>
@@ -2508,28 +2677,28 @@
                      description="accumulated clear-sky downward surface longwave radiation flux"/>
 
                 <var name="aclwdnt" type="real" dimensions="nCells Time" units="W m^{-2}"
-                     description="accumulated clear-sky downward surface longwave radiation flux"/>
+                     description="accumulated all-sky downward top-of-the-atmosphere longwave radiation flux"/>
 
                 <var name="aclwdntc" type="real" dimensions="nCells Time" units="W m^{-2}"
-                     description="accumulated clear-sky downward surface longwave radiation flux"/>
+                     description="accumulated clear-sky downward top-of-the-atmosphere longwave radiation flux"/>
 
                 <var name="aclwupb" type="real" dimensions="nCells Time" units="W m^{-2}"
                      description="accumulated all-sky upward surface longwave radiation flux"/>
 
                 <var name="aclwupbc" type="real" dimensions="nCells Time" units="W m^{-2}"
-                     description="accumulated all-sky upward surface longwave radiation flux"/>
+                     description="accumulated clear-sky upward surface longwave radiation flux"/>
 
                 <var name="aclwupt" type="real" dimensions="nCells Time" units="W m^{-2}"
-                     description="accumulated all-sky upward surface longwave radiation flux"/>
+                     description="accumulated all-sky upward top-of-the-atmosphere longwave radiation flux"/>
 
                 <var name="aclwuptc" type="real" dimensions="nCells Time" units="W m^{-2}"
-                     description="accumulated all-sky upward surface longwave radiation flux"/>
+                     description="accumulated clear-sky upward top-of-the-atmosphere longwave radiation flux"/>
 
                 <var name="olrtoa" type="real" dimensions="nCells Time" units="W m^{-2}"
-                     description="top-of-atmosphere outgoing longwave radiation flux"/>
+                     description="all-sky top-of-atmosphere outgoing longwave radiation flux"/>
 
                 <var name="glw" type="real" dimensions="nCells Time" units="W m^{-2}"
-                     description="all downward surface longwave radiation"/>
+                     description="all-sky downward surface longwave radiation"/>
 
                 <var name="rre_cloud" type="real" dimensions="nVertLevels nCells Time" units="microns"
                      description="effective radius of cloud water droplets calculated in RRTMG radiation"/>
@@ -2537,8 +2706,8 @@
                 <var name="rre_ice" type="real" dimensions="nVertLevels nCells Time" units="microns"
                      description="effective radius of cloud ice crystals calculated in RRTMG radiation"/>
 
-                <var name="rre_snow" type="real" dimensions="nVertLevels nCells Time"/>
-                     description="effective radius of cloud ice crystals calculated in RRTMG radiation"/>
+                <var name="rre_snow" type="real" dimensions="nVertLevels nCells Time" units="microns"
+                     description="effective radius of snow crystals calculated in RRTMG radiation"/>
 
 
                 <!-- ================================================================================================== -->
@@ -2612,6 +2781,9 @@
                 <var name="sfc_albedo" type="real" dimensions="nCells Time" units="unitless"
                      description="surface albedo"/>
 
+                <var name="sfc_albedo_seaice" type="real" dimensions="nCells Time" units="unitless"
+                     description="surface albedo over seaice"/>
+
                 <var name="sfc_emiss" type="real" dimensions="nCells Time" units="unitless"
                      description="surface emissivity"/>
 
@@ -2634,7 +2806,7 @@
                      description="initial number of time-steps since last snow fall"/>
 
                 <var name="sstsk" type="real" dimensions="nCells Time" units="K"
-                     description="skin sea-aurface temperature"/>
+                     description="skin sea-surface temperature"/>
 
                 <var name="sstsk_dtc" type="real" dimensions="nCells Time" units="K"
                      description="skin sea-surface temperature cooling"/>
@@ -2815,6 +2987,12 @@
                 <var name="mminlu" type="text" dimensions="" units="unitless"
                      description="land use classification"/>
 
+                <var name="isice_lu" name_in_code="isice" type="integer" dimensions="" units="unitless" default_value="24"
+                     description="Index category for snow/ice"/>
+
+                <var name="iswater_lu" name_in_code="iswater" type="integer" dimensions="" units="unitless" default_value="16"
+                     description="Index category for water"/>
+
                 <var name="landmask" type="integer"  dimensions="nCells" units="unitless"
                      description="land-ocean mask (1=land ; 0=ocean)"/>
 
diff --git a/src/core_atmosphere/diagnostics/convective_diagnostics.F b/src/core_atmosphere/diagnostics/convective_diagnostics.F
index 549e6292ca..9554113e4e 100644
--- a/src/core_atmosphere/diagnostics/convective_diagnostics.F
+++ b/src/core_atmosphere/diagnostics/convective_diagnostics.F
@@ -185,7 +185,7 @@ subroutine convective_diagnostics_update()
     
                   ! compute above ground level (AGL) heights
                   z_agl(1:nVertLevelsP1) = zgrid(1:nVertLevelsP1,iCell) - zgrid(1,iCell)
-                  uph = integral_zstaggered(updraft_helicity(1:nVertLevels,iCell),z_agl,2000.,5000.,nVertLevels,nVertLevelsP1)
+                  uph = integral_zstaggered(updraft_helicity(1:nVertLevels,iCell),z_agl,2000.0_RKIND,5000.0_RKIND,nVertLevels,nVertLevelsP1)
                   updraft_helicity_max(iCell) = max( updraft_helicity_max(iCell),uph)
         
                 end do
@@ -385,16 +385,16 @@ subroutine convective_diagnostics_compute()
               temperature_surface(iCell) = temperature(1,iCell)
               dewpoint_surface(iCell) = dewpoint(1,iCell)
               if (need_uzonal_1km) then
-                  uzonal_1km(iCell)      = column_height_value(uzonal(1:nVertLevels,iCell),      zp, 1000., nVertLevels)
+                  uzonal_1km(iCell)      = column_height_value(uzonal(1:nVertLevels,iCell),      zp, 1000.0_RKIND, nVertLevels)
               end if
               if (need_umerid_1km) then
-                  umeridional_1km(iCell) = column_height_value(umeridional(1:nVertLevels,iCell), zp, 1000., nVertLevels)
+                  umeridional_1km(iCell) = column_height_value(umeridional(1:nVertLevels,iCell), zp, 1000.0_RKIND, nVertLevels)
               end if
               if (need_uzonal_6km) then
-                  uzonal_6km(iCell)      = column_height_value(uzonal(1:nVertLevels,iCell),      zp, 6000., nVertLevels)
+                  uzonal_6km(iCell)      = column_height_value(uzonal(1:nVertLevels,iCell),      zp, 6000.0_RKIND, nVertLevels)
               end if
               if (need_umerid_6km) then
-                  umeridional_6km(iCell) = column_height_value(umeridional(1:nVertLevels,iCell), zp, 6000., nVertLevels)
+                  umeridional_6km(iCell) = column_height_value(umeridional(1:nVertLevels,iCell), zp, 6000.0_RKIND, nVertLevels)
               end if
 
            !  storm-relative helicity
@@ -441,10 +441,10 @@ subroutine convective_diagnostics_compute()
                    end do
 
                    if (need_srh_01km) then
-                       srh_0_1km(iCell) = integral_zpoint(srh, zrel, 0., 1000., nVertLevelsP1)
+                       srh_0_1km(iCell) = integral_zpoint(srh, zrel, 0.0_RKIND, 1000.0_RKIND, nVertLevelsP1)
                    end if
                    if (need_srh_03km) then
-                       srh_0_3km(iCell) = integral_zpoint(srh, zrel, 0., 3000., nVertLevelsP1)
+                       srh_0_3km(iCell) = integral_zpoint(srh, zrel, 0.0_RKIND, 3000.0_RKIND, nVertLevelsP1)
                    end if
                end if
 
@@ -454,8 +454,8 @@ subroutine convective_diagnostics_compute()
             if (need_cape .or. need_cin) then
                 do iCell=1, nCellsSolve
                     p_in(1:nVertLevels) = (pressure_p(1:nVertLevels,iCell) + pressure_base(1:nVertLevels,iCell)) / 100.0_RKIND
-                    t_in(1:nVertLevels) = temperature(1:nVertLevels,iCell) - 273.15
-                    td_in(1:nVertLevels) = dewpoint(1:nVertLevels,iCell) - 273.15
+                    t_in(1:nVertLevels) = temperature(1:nVertLevels,iCell) - 273.15_RKIND
+                    td_in(1:nVertLevels) = dewpoint(1:nVertLevels,iCell) - 273.15_RKIND
 
                  !   do k=1,nVertLevels
                  !     relhum(k,iCell) = max(1.e-08,min(1.,relhum(k,iCell)))
@@ -569,8 +569,8 @@ end function integral_zstaggered
       real (kind=RKIND) function integral_zpoint( column_values, z, zbot, ztop, n )
       implicit none
       integer n
-      real :: column_values(n), z(n), zbot, ztop
-      real :: zb, zt, dz, zr_midpoint, midpoint_value
+      real(kind=RKIND) :: column_values(n), z(n), zbot, ztop
+      real(kind=RKIND) :: zb, zt, dz, zr_midpoint, midpoint_value
 
       integer :: k
 
@@ -929,7 +929,7 @@ subroutine getcape( nk , p_in , t_in , td_in, cape , cin )
           cpm=cp+cpv*qvbar+cpl*qlbar+cpi*qibar
           th2=th1*exp(  lhv*(ql2-ql1)/(cpm*tbar)     &
                        +lhs*(qi2-qi1)/(cpm*tbar)     &
-                       +(rm/cpm-rd/cp)*alog(p2/p1) )
+                       +(rm/cpm-rd/cp)*log(p2/p1) )
 
           if(i .gt. 90 .and. debug_level .gt. 0) call mpas_log_write('$i $r $r $r', intArgs=(/i/), realArgs=(/th2,thlast,th2-thlast/))
           if(i .gt. 100)then
@@ -1083,7 +1083,7 @@ real (kind=RKIND) function getthe(p,t,td,q)
     if( (td-t).ge.-0.1 )then
       tlcl = t
     else
-      tlcl = 56.0 + ( (td-56.0)**(-1) + 0.00125*alog(t/td) )**(-1)
+      tlcl = 56.0 + ( (td-56.0)**(-1) + 0.00125*log(t/td) )**(-1)
     endif
 
     getthe=t*( (100000.0/p)**(0.2854*(1.0-0.28*q)) )   &
diff --git a/src/core_atmosphere/diagnostics/isobaric_diagnostics.F b/src/core_atmosphere/diagnostics/isobaric_diagnostics.F
index f9a7821806..c7aa9b568c 100644
--- a/src/core_atmosphere/diagnostics/isobaric_diagnostics.F
+++ b/src/core_atmosphere/diagnostics/isobaric_diagnostics.F
@@ -839,7 +839,7 @@ subroutine interp_diagnostics(mesh, state, time_lev, diag)
             !!!!!!!!!!! Calculate mean temperature in 500 hPa - 300 hPa layer !!!!!!!!!!!
      
             if (need_meanT_500_300) then
-                call compute_layer_mean(meanT_500_300, 50000.0, 30000.0, field_in, press_in)
+                call compute_layer_mean(meanT_500_300, 50000.0_RKIND, 30000.0_RKIND, field_in, press_in)
             end if
      
      
diff --git a/src/core_atmosphere/diagnostics/soundings.F b/src/core_atmosphere/diagnostics/soundings.F
index 68c331bd69..c213f6f82b 100644
--- a/src/core_atmosphere/diagnostics/soundings.F
+++ b/src/core_atmosphere/diagnostics/soundings.F
@@ -402,20 +402,20 @@ end function sphere_distance
 ! THIS FUNCTION CALCULATES THE LIQUID SATURATION VAPOR MIXING RATIO AS
 ! A FUNCTION OF TEMPERATURE AND PRESSURE
 !
-      REAL FUNCTION RSLF(P,T)
+      REAL(KIND=RKIND) FUNCTION RSLF(P,T)
 
       IMPLICIT NONE
-      REAL, INTENT(IN):: P, T
-      REAL:: ESL,X
-      REAL, PARAMETER:: C0= .611583699E03
-      REAL, PARAMETER:: C1= .444606896E02
-      REAL, PARAMETER:: C2= .143177157E01
-      REAL, PARAMETER:: C3= .264224321E-1
-      REAL, PARAMETER:: C4= .299291081E-3
-      REAL, PARAMETER:: C5= .203154182E-5
-      REAL, PARAMETER:: C6= .702620698E-8
-      REAL, PARAMETER:: C7= .379534310E-11
-      REAL, PARAMETER:: C8=-.321582393E-13
+      REAL(KIND=RKIND), INTENT(IN):: P, T
+      REAL(KIND=RKIND):: ESL,X
+      REAL(KIND=RKIND), PARAMETER:: C0= .611583699E03
+      REAL(KIND=RKIND), PARAMETER:: C1= .444606896E02
+      REAL(KIND=RKIND), PARAMETER:: C2= .143177157E01
+      REAL(KIND=RKIND), PARAMETER:: C3= .264224321E-1
+      REAL(KIND=RKIND), PARAMETER:: C4= .299291081E-3
+      REAL(KIND=RKIND), PARAMETER:: C5= .203154182E-5
+      REAL(KIND=RKIND), PARAMETER:: C6= .702620698E-8
+      REAL(KIND=RKIND), PARAMETER:: C7= .379534310E-11
+      REAL(KIND=RKIND), PARAMETER:: C8=-.321582393E-13
 
       X=MAX(-80.,T-273.16)
 
@@ -436,20 +436,20 @@ END FUNCTION RSLF
 ! THIS FUNCTION CALCULATES THE ICE SATURATION VAPOR MIXING RATIO AS A
 ! FUNCTION OF TEMPERATURE AND PRESSURE
 !
-      REAL FUNCTION RSIF(P,T)
+      REAL(KIND=RKIND) FUNCTION RSIF(P,T)
 
       IMPLICIT NONE
-      REAL, INTENT(IN):: P, T
-      REAL:: ESI,X
-      REAL, PARAMETER:: C0= .609868993E03
-      REAL, PARAMETER:: C1= .499320233E02
-      REAL, PARAMETER:: C2= .184672631E01
-      REAL, PARAMETER:: C3= .402737184E-1
-      REAL, PARAMETER:: C4= .565392987E-3
-      REAL, PARAMETER:: C5= .521693933E-5
-      REAL, PARAMETER:: C6= .307839583E-7
-      REAL, PARAMETER:: C7= .105785160E-9
-      REAL, PARAMETER:: C8= .161444444E-12
+      REAL(KIND=RKIND), INTENT(IN):: P, T
+      REAL(KIND=RKIND):: ESI,X
+      REAL(KIND=RKIND), PARAMETER:: C0= .609868993E03
+      REAL(KIND=RKIND), PARAMETER:: C1= .499320233E02
+      REAL(KIND=RKIND), PARAMETER:: C2= .184672631E01
+      REAL(KIND=RKIND), PARAMETER:: C3= .402737184E-1
+      REAL(KIND=RKIND), PARAMETER:: C4= .565392987E-3
+      REAL(KIND=RKIND), PARAMETER:: C5= .521693933E-5
+      REAL(KIND=RKIND), PARAMETER:: C6= .307839583E-7
+      REAL(KIND=RKIND), PARAMETER:: C7= .105785160E-9
+      REAL(KIND=RKIND), PARAMETER:: C8= .161444444E-12
 
       X=MAX(-80.,T-273.16)
       ESI=C0+X*(C1+X*(C2+X*(C3+X*(C4+X*(C5+X*(C6+X*(C7+X*C8)))))))
diff --git a/src/core_atmosphere/dynamics/Makefile b/src/core_atmosphere/dynamics/Makefile
index 97785deb4e..732c12926e 100644
--- a/src/core_atmosphere/dynamics/Makefile
+++ b/src/core_atmosphere/dynamics/Makefile
@@ -1,10 +1,14 @@
 .SUFFIXES: .F .o
 
-OBJS = mpas_atm_time_integration.o
+OBJS = mpas_atm_time_integration.o \
+       mpas_atm_boundaries.o
 
 all: $(OBJS)
 
-mpas_atm_time_integration.o: mpas_atm_iau.o
+mpas_atm_time_integration.o: mpas_atm_boundaries.o mpas_atm_iau.o
+
+mpas_atm_boundaries.o:
+
 
 clean:
 	$(RM) *.o *.mod *.f90
diff --git a/src/core_atmosphere/dynamics/mpas_atm_boundaries.F b/src/core_atmosphere/dynamics/mpas_atm_boundaries.F
new file mode 100644
index 0000000000..6ecff6f157
--- /dev/null
+++ b/src/core_atmosphere/dynamics/mpas_atm_boundaries.F
@@ -0,0 +1,643 @@
+! Copyright (c) 2016,  Los Alamos National Security, LLC (LANS)
+! and the University Corporation for Atmospheric Research (UCAR).
+!
+! Unless noted otherwise source code is licensed under the BSD license.
+! Additional copyright and license information can be found in the LICENSE file
+! distributed with this code, or at http://mpas-dev.github.com/license.html
+!
+module mpas_atm_boundaries
+
+    use mpas_derived_types, only : mpas_pool_type, mpas_clock_type, block_type, mpas_time_type, mpas_timeInterval_type, MPAS_NOW, &
+                                   MPAS_STREAM_LATEST_BEFORE, MPAS_STREAM_EARLIEST_STRICTLY_AFTER, &
+                                   MPAS_streamManager_type
+    use mpas_pool_routines, only : mpas_pool_get_array, mpas_pool_get_dimension, mpas_pool_get_subpool, mpas_pool_shift_time_levels
+    use mpas_kind_types, only : RKIND, StrKIND
+    use mpas_timekeeping, only : mpas_get_clock_time, mpas_get_timeInterval, mpas_set_time, operator(-)
+
+    ! Important note: At present, the code in mpas_atm_setup_bdy_masks for
+    ! deriving the nearestRelaxationCell field assumes that nSpecZone == 2
+    integer, parameter :: nSpecZone = 2
+    integer, parameter :: nRelaxZone = 5
+    integer, parameter :: nBdyZone = nSpecZone + nRelaxZone
+
+    public :: mpas_atm_update_bdy_tend, &
+              mpas_atm_get_bdy_tend, &
+              mpas_atm_get_bdy_state, &
+              mpas_atm_setup_bdy_masks, &
+              mpas_atm_bdy_checks
+
+    public :: nBdyZone, nSpecZone, nRelaxZone
+
+    private
+
+    type (MPAS_Time_Type) :: LBC_intv_end
+
+
+    contains
+
+
+    !***********************************************************************
+    !
+    !  routine mpas_atm_update_bdy_tend
+    !
+    !> \brief   Reads new boundary data and updates the LBC tendencies
+    !> \author  Michael Duda
+    !> \date    27 September 2016
+    !> \details 
+    !>  This routine reads from the 'lbc_in' stream all variables in the 'lbc'
+    !>  pool. When called with firstCall=.true., the latest time before the
+    !>  present is read into time level 2 of the lbc pool; otherwise, the
+    !>  contents of time level 2 are shifted to time level 1, the earliest
+    !>  time strictly later than the present is read into time level 2, and
+    !>  the tendencies for all fields in the lbc pool are computed and stored
+    !>  in time level 1.
+    !
+    !-----------------------------------------------------------------------
+    subroutine mpas_atm_update_bdy_tend(clock, streamManager, block, firstCall, ierr)
+
+        use mpas_constants, only : rvord
+        use mpas_stream_manager, only : mpas_stream_mgr_read
+        use mpas_log, only : mpas_log_write
+        use mpas_derived_types, only : MPAS_STREAM_MGR_NOERR, MPAS_LOG_ERR
+        use mpas_timekeeping, only : mpas_get_time
+
+        implicit none
+
+        type (mpas_clock_type), intent(in) :: clock
+        type (MPAS_streamManager_type), intent(inout) :: streamManager
+        type (block_type), intent(inout) :: block
+        logical, intent(in) :: firstCall
+        integer, intent(out) :: ierr
+
+        character(len=StrKIND) :: lbc_intv_start_string
+        character(len=StrKIND) :: lbc_intv_end_string
+
+        type (mpas_pool_type), pointer :: mesh
+        type (mpas_pool_type), pointer :: state
+        type (mpas_pool_type), pointer :: lbc
+        real (kind=RKIND) :: dt
+
+        integer, pointer :: nCells
+        integer, pointer :: nEdges
+        integer, pointer :: index_qv
+
+        real (kind=RKIND), dimension(:,:), pointer :: u
+        real (kind=RKIND), dimension(:,:), pointer :: ru
+        real (kind=RKIND), dimension(:,:), pointer :: rho_edge
+        real (kind=RKIND), dimension(:,:), pointer :: w
+        real (kind=RKIND), dimension(:,:), pointer :: theta
+        real (kind=RKIND), dimension(:,:), pointer :: rtheta_m
+        real (kind=RKIND), dimension(:,:), pointer :: rho_zz
+        real (kind=RKIND), dimension(:,:), pointer :: rho
+        real (kind=RKIND), dimension(:,:,:), pointer :: scalars
+        real (kind=RKIND), dimension(:,:), pointer :: lbc_tend_u
+        real (kind=RKIND), dimension(:,:), pointer :: lbc_tend_ru
+        real (kind=RKIND), dimension(:,:), pointer :: lbc_tend_rho_edge
+        real (kind=RKIND), dimension(:,:), pointer :: lbc_tend_w
+        real (kind=RKIND), dimension(:,:), pointer :: lbc_tend_theta
+        real (kind=RKIND), dimension(:,:), pointer :: lbc_tend_rtheta_m
+        real (kind=RKIND), dimension(:,:), pointer :: lbc_tend_rho_zz
+        real (kind=RKIND), dimension(:,:), pointer :: lbc_tend_rho
+        real (kind=RKIND), dimension(:,:,:), pointer :: lbc_tend_scalars
+
+        integer, dimension(:,:), pointer :: cellsOnEdge
+        real (kind=RKIND), dimension(:,:), pointer :: zz
+
+        integer :: dd_intv, s_intv, sn_intv, sd_intv
+        type (MPAS_Time_Type) :: currTime
+        type (MPAS_TimeInterval_Type) :: lbc_interval
+        character(len=StrKIND) :: read_time
+        integer :: iEdge
+        integer :: cell1, cell2
+
+
+        ierr = 0
+
+        call mpas_pool_get_subpool(block % structs, 'mesh', mesh)
+        call mpas_pool_get_subpool(block % structs, 'state', state)
+        call mpas_pool_get_subpool(block % structs, 'lbc', lbc)
+
+        if (firstCall) then
+            call MPAS_stream_mgr_read(streamManager, streamID='lbc_in', timeLevel=2, whence=MPAS_STREAM_LATEST_BEFORE, &
+                                      actualWhen=read_time, ierr=ierr)
+            if (ierr /= MPAS_STREAM_MGR_NOERR) then
+               call mpas_log_write('Could not read from ''lbc_in'' stream on or before the current date '// &
+                                   'to update lateral boundary tendencies', messageType=MPAS_LOG_ERR)
+               ierr = 1
+            end if
+        else
+            call mpas_pool_shift_time_levels(lbc)
+            call MPAS_stream_mgr_read(streamManager, streamID='lbc_in', timeLevel=2, whence=MPAS_STREAM_EARLIEST_STRICTLY_AFTER, &
+                                      actualWhen=read_time, ierr=ierr)
+            if (ierr /= MPAS_STREAM_MGR_NOERR) then
+               call mpas_log_write('Could not read from ''lbc_in'' stream after the current date '// &
+                                   'to update lateral boundary tendencies', messageType=MPAS_LOG_ERR)
+               ierr = 1
+            end if
+        end if
+        if (ierr /= 0) then
+           return
+        end if
+
+        call mpas_set_time(currTime, dateTimeString=trim(read_time))
+
+        !
+        ! Compute any derived fields from those that were read from the lbc_in stream
+        !
+        call mpas_pool_get_array(lbc, 'lbc_u', u, 2)
+        call mpas_pool_get_array(lbc, 'lbc_ru', ru, 2)
+        call mpas_pool_get_array(lbc, 'lbc_rho_edge', rho_edge, 2)
+        call mpas_pool_get_array(lbc, 'lbc_theta', theta, 2)
+        call mpas_pool_get_array(lbc, 'lbc_rtheta_m', rtheta_m, 2)
+        call mpas_pool_get_array(lbc, 'lbc_rho_zz', rho_zz, 2)
+        call mpas_pool_get_array(lbc, 'lbc_rho', rho, 2)
+        call mpas_pool_get_array(lbc, 'lbc_scalars', scalars, 2)
+
+        call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge)
+        call mpas_pool_get_dimension(mesh, 'nCells', nCells)
+        call mpas_pool_get_dimension(mesh, 'nEdges', nEdges)
+        call mpas_pool_get_dimension(lbc, 'index_qv', index_qv)
+        call mpas_pool_get_array(mesh, 'zz', zz)
+
+        ! Compute lbc_rho_zz
+        zz(:,nCells+1) = 1.0_RKIND          ! Avoid potential division by zero in the following line
+        rho_zz(:,:) = rho(:,:) / zz(:,:)
+
+        ! Average lbc_rho_zz to edges
+        do iEdge=1,nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+            if (cell1 > 0 .and. cell2 > 0) then
+                rho_edge(:,iEdge) = 0.5_RKIND * (rho_zz(:,cell1) + rho_zz(:,cell2))
+            end if
+        end do
+
+        ru(:,:) = u(:,:) * rho_edge(:,:)
+        rtheta_m(:,:) = theta(:,:) * rho_zz(:,:) * (1.0_RKIND + rvord * scalars(index_qv,:,:))
+
+        if (.not. firstCall) then
+            lbc_interval = currTime - LBC_intv_end
+            call mpas_get_timeInterval(interval=lbc_interval, DD=dd_intv, S=s_intv, S_n=sn_intv, S_d=sd_intv, ierr=ierr)
+            dt = 86400.0_RKIND * real(dd_intv, kind=RKIND) + real(s_intv, kind=RKIND) &
+                 + (real(sn_intv, kind=RKIND) / real(sd_intv, kind=RKIND))
+
+            call mpas_pool_get_array(lbc, 'lbc_u', u, 2)
+            call mpas_pool_get_array(lbc, 'lbc_ru', ru, 2)
+            call mpas_pool_get_array(lbc, 'lbc_rho_edge', rho_edge, 2)
+            call mpas_pool_get_array(lbc, 'lbc_w', w, 2)
+            call mpas_pool_get_array(lbc, 'lbc_theta', theta, 2)
+            call mpas_pool_get_array(lbc, 'lbc_rtheta_m', rtheta_m, 2)
+            call mpas_pool_get_array(lbc, 'lbc_rho_zz', rho_zz, 2)
+            call mpas_pool_get_array(lbc, 'lbc_rho', rho, 2)
+            call mpas_pool_get_array(lbc, 'lbc_scalars', scalars, 2)
+
+            call mpas_pool_get_array(lbc, 'lbc_u', lbc_tend_u, 1)
+            call mpas_pool_get_array(lbc, 'lbc_ru', lbc_tend_ru, 1)
+            call mpas_pool_get_array(lbc, 'lbc_rho_edge', lbc_tend_rho_edge, 1)
+            call mpas_pool_get_array(lbc, 'lbc_w', lbc_tend_w, 1)
+            call mpas_pool_get_array(lbc, 'lbc_theta', lbc_tend_theta, 1)
+            call mpas_pool_get_array(lbc, 'lbc_rtheta_m', lbc_tend_rtheta_m, 1)
+            call mpas_pool_get_array(lbc, 'lbc_rho_zz', lbc_tend_rho_zz, 1)
+            call mpas_pool_get_array(lbc, 'lbc_rho', lbc_tend_rho, 1)
+            call mpas_pool_get_array(lbc, 'lbc_scalars', lbc_tend_scalars, 1)
+
+
+            dt = 1.0_RKIND / dt
+            lbc_tend_u(:,:) = (u(:,:) - lbc_tend_u(:,:)) * dt
+            lbc_tend_ru(:,:) = (ru(:,:) - lbc_tend_ru(:,:)) * dt
+            lbc_tend_rho_edge(:,:) = (rho_edge(:,:) - lbc_tend_rho_edge(:,:)) * dt
+            lbc_tend_w(:,:) = (w(:,:) - lbc_tend_w(:,:)) * dt
+            lbc_tend_theta(:,:) = (theta(:,:) - lbc_tend_theta(:,:)) * dt
+            lbc_tend_rtheta_m(:,:) = (rtheta_m(:,:) - lbc_tend_rtheta_m(:,:)) * dt
+            lbc_tend_rho_zz(:,:) = (rho_zz(:,:) - lbc_tend_rho_zz(:,:)) * dt
+            lbc_tend_rho(:,:) = (rho(:,:) - lbc_tend_rho(:,:)) * dt
+            lbc_tend_scalars(:,:,:) = (scalars(:,:,:) - lbc_tend_scalars(:,:,:)) * dt
+
+            !
+            ! Logging the lbc start and end times appears to be backwards, but
+            ! until the end of this function, LBC_intv_end == the last interval
+            ! time and currTime == the next interval time.
+            !
+            call mpas_get_time(LBC_intv_end, dateTimeString=lbc_intv_start_string)
+            call mpas_get_time(currTime, dateTimeString=lbc_intv_end_string)
+            call mpas_log_write('----------------------------------------------------------------------')
+            call mpas_log_write('Updated lateral boundary conditions. LBCs are now valid')
+            call mpas_log_write('from '//trim(lbc_intv_start_string)//' to '//trim(lbc_intv_end_string))
+            call mpas_log_write('----------------------------------------------------------------------')
+
+        end if
+
+        LBC_intv_end = currTime
+
+    end subroutine mpas_atm_update_bdy_tend
+
+
+    !***********************************************************************
+    !
+    !  routine mpas_atm_get_bdy_tend
+    !
+    !> \brief   Returns LBC tendencies a specified delta-t in the future
+    !> \author  Michael Duda
+    !> \date    28 September 2016
+    !> \details 
+    !>  This function returns an array providing the tendency for the requested
+    !>  progostic variable delta_t in the future from the current time known
+    !>  by the simulation clock (which is typically the time at the start of
+    !>  the current timestep).
+    !>
+    !>  The vertDim and horizDim should match the nominal block dimensions of
+    !>  the field to be returned by the call; for example, a call to retrieve
+    !>  the tendency for the 'u' field would set vertDim=nVertLevels and 
+    !>  horizDim=nEdges. This function internally adds 1 to the horizontal
+    !>  dimension to account for the "garbage" element.
+    !>
+    !>  The field is identified by the 'field' argument, and this argument is
+    !>  prefixed with 'lbc_' before attempting to retrieve the field from
+    !>  the 'lbc' pool. For scalars, the field argument should give the name 
+    !>  of the constituent, e.g., 'qv'.
+    !>
+    !>  Example calls to this function:
+    !>  
+    !>   tend_u(:,:) = mpas_atm_get_bdy_tend(clock, domain % blocklist, nVertLevels, nEdges, 'u', 0.0_RKIND)
+    !>   tend_w(:,:) = mpas_atm_get_bdy_tend(clock, domain % blocklist, nVertLevels+1, nCells, 'w', 0.0_RKIND)
+    !>   tend_rho_zz(:,:) = mpas_atm_get_bdy_tend(clock, domain % blocklist, nVertLevels, nCells, 'rho_zz', 0.0_RKIND)
+    !>   tend_theta(:,:) = mpas_atm_get_bdy_tend(clock, domain % blocklist, nVertLevels, nCells, 'theta', 0.0_RKIND)
+    !>   tend_scalars(1,:,:) = mpas_atm_get_bdy_tend(clock, domain % blocklist, nVertLevels, nCells, 'qv', 0.0_RKIND)
+    !
+    !-----------------------------------------------------------------------
+    function mpas_atm_get_bdy_tend(clock, block, vertDim, horizDim, field, delta_t) result(return_tend)
+
+        implicit none
+
+        type (mpas_clock_type), intent(in) :: clock
+        type (block_type), intent(inout) :: block
+        integer, intent(in) :: vertDim, horizDim
+        character(len=*), intent(in) :: field
+        real (kind=RKIND), intent(in) :: delta_t
+
+        real (kind=RKIND), dimension(vertDim,horizDim+1) :: return_tend
+
+        type (mpas_pool_type), pointer :: lbc
+        integer, pointer :: idx
+        real (kind=RKIND), dimension(:,:), pointer :: tend
+        real (kind=RKIND), dimension(:,:,:), pointer :: tend_scalars
+        integer :: ierr
+
+
+        call mpas_pool_get_subpool(block % structs, 'lbc', lbc)
+
+        nullify(tend)
+        call mpas_pool_get_array(lbc, 'lbc_'//trim(field), tend, 1)
+
+        if (associated(tend)) then
+            return_tend(:,:) = tend(:,:)
+        else
+            call mpas_pool_get_array(lbc, 'lbc_scalars', tend_scalars, 1)
+            call mpas_pool_get_dimension(lbc, 'index_'//trim(field), idx)
+
+            return_tend(:,:) = tend_scalars(idx,:,:)
+        end if
+
+    end function mpas_atm_get_bdy_tend
+
+
+    !***********************************************************************
+    !
+    !  routine mpas_atm_get_bdy_state
+    !
+    !> \brief   Returns LBC state at a specified delta-t in the future
+    !> \author  Michael Duda
+    !> \date    28 September 2016
+    !> \details 
+    !>  This function returns an array providing the state for the requested
+    !>  progostic variable delta_t in the future from the current time known
+    !>  by the simulation clock (which is typically the time at the start of
+    !>  the current timestep).
+    !>
+    !>  The vertDim and horizDim should match the nominal block dimensions of
+    !>  the field to be returned by the call; for example, a call to retrieve
+    !>  the state of the 'u' field would set vertDim=nVertLevels and 
+    !>  horizDim=nEdges. This function internally adds 1 to the horizontal
+    !>  dimension to account for the "garbage" element.
+    !>
+    !>  The field is identified by the 'field' argument, and this argument is
+    !>  prefixed with 'lbc_' before attempting to retrieve the field from
+    !>  the 'lbc' pool. For scalars, the field argument should give the name 
+    !>  of the constituent, e.g., 'qv'.
+    !>
+    !>  Example calls to this function:
+    !>  
+    !>   u(:,:) = mpas_atm_get_bdy_state(clock, domain % blocklist, nVertLevels, nEdges, 'u', 0.0_RKIND)
+    !>   w(:,:) = mpas_atm_get_bdy_state(clock, domain % blocklist, nVertLevels+1, nCells, 'w', 0.0_RKIND)
+    !>   rho_zz(:,:) = mpas_atm_get_bdy_state(clock, domain % blocklist, nVertLevels, nCells, 'rho_zz', 0.0_RKIND)
+    !>   theta(:,:) = mpas_atm_get_bdy_state(clock, domain % blocklist, nVertLevels, nCells, 'theta', 0.0_RKIND)
+    !>   scalars(1,:,:) = mpas_atm_get_bdy_state(clock, domain % blocklist, nVertLevels, nCells, 'qv', 0.0_RKIND)
+    !
+    !-----------------------------------------------------------------------
+    function mpas_atm_get_bdy_state(clock, block, vertDim, horizDim, field, delta_t) result(return_state)
+
+        use mpas_pool_routines, only : mpas_pool_get_error_level, mpas_pool_set_error_level
+        use mpas_derived_types, only : MPAS_POOL_SILENT
+
+        implicit none
+
+        type (mpas_clock_type), intent(in) :: clock
+        type (block_type), intent(inout) :: block
+        integer, intent(in) :: vertDim, horizDim
+        character(len=*), intent(in) :: field
+        real (kind=RKIND), intent(in) :: delta_t
+
+        real (kind=RKIND), dimension(vertDim,horizDim+1) :: return_state
+
+        type (mpas_pool_type), pointer :: lbc
+        integer, pointer :: idx
+        real (kind=RKIND), dimension(:,:), pointer :: tend
+        real (kind=RKIND), dimension(:,:), pointer :: state
+        real (kind=RKIND), dimension(:,:,:), pointer :: tend_scalars
+        real (kind=RKIND), dimension(:,:,:), pointer :: state_scalars
+        type (MPAS_Time_Type) :: currTime
+        type (MPAS_TimeInterval_Type) :: lbc_interval
+        integer :: dd_intv, s_intv, sn_intv, sd_intv
+        real (kind=RKIND) :: dt
+        integer :: err_level
+        integer :: ierr
+
+
+        currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr)
+
+        lbc_interval = LBC_intv_end - currTime
+
+        call mpas_get_timeInterval(interval=lbc_interval, DD=dd_intv, S=s_intv, S_n=sn_intv, S_d=sd_intv, ierr=ierr)
+        dt = 86400.0_RKIND * real(dd_intv, kind=RKIND) + real(s_intv, kind=RKIND) &
+             + (real(sn_intv, kind=RKIND) / real(sd_intv, kind=RKIND))
+
+        dt = dt - delta_t
+
+        call mpas_pool_get_subpool(block % structs, 'lbc', lbc)
+
+        !
+        ! The first two calls to mpas_pool_get_array, below, may cause harmless warning
+        ! messages, which we can silence by setting the pool error level
+        !
+        err_level = mpas_pool_get_error_level()
+        call mpas_pool_set_error_level(MPAS_POOL_SILENT)
+
+        nullify(tend)
+        nullify(state)
+
+        call mpas_pool_get_array(lbc, 'lbc_'//trim(field), tend, 1)
+        call mpas_pool_get_array(lbc, 'lbc_'//trim(field), state, 2)
+
+        ! Reset the pool error level to its previous value
+        call mpas_pool_set_error_level(err_level)
+
+        !
+        ! If we have both a tendency and state for this boundary field from the tend and state
+        ! pools, then the requested field was not a scalar constituent; otherwise, we need to
+        ! query the field as a scalar constituent
+        !
+        if (associated(tend) .and. associated(state)) then
+            return_state(:,:) = state(:,:) - dt * tend(:,:)
+        else
+            call mpas_pool_get_array(lbc, 'lbc_scalars', tend_scalars, 1)
+            call mpas_pool_get_array(lbc, 'lbc_scalars', state_scalars, 2)
+            call mpas_pool_get_dimension(lbc, 'index_'//trim(field), idx)
+
+            return_state(:,:) = state_scalars(idx,:,:) - dt * tend_scalars(idx,:,:)
+        end if
+
+    end function mpas_atm_get_bdy_state
+
+
+    !***********************************************************************
+    !
+    !  routine mpas_atm_setup_bdy_masks
+    !
+    !> \brief   Prepares various fields for boundaries of limited-area
+    !> \author  Michael Duda
+    !> \date    28 September 2016
+    !> \details 
+    !>  This routine prepares (1) the mask field needed to distinguish cells in 
+    !>  the specified zone from those in the relaxation zone, and (2) a field
+    !>  of indices identifying the closest relaxation cell to each cell in 
+    !>  the specified zone..
+    !
+    !-----------------------------------------------------------------------
+    subroutine mpas_atm_setup_bdy_masks(mesh, configs)
+
+        implicit none
+
+        type (mpas_pool_type), intent(inout) :: mesh
+        type (mpas_pool_type), intent(in) :: configs
+
+        integer :: iCell, i, j, ii, jj
+        real (kind=RKIND) :: d, dmin
+
+        integer, pointer :: nCells
+        integer, dimension(:), pointer :: bdyMaskCell, bdyMaskEdge, bdyMaskVertex
+        integer, dimension(:), pointer :: nearestRelaxationCell
+        integer, dimension(:), pointer :: nEdgesOnCell
+        integer, dimension(:,:), pointer :: cellsOnCell
+        real (kind=RKIND), dimension(:), pointer :: specZoneMaskCell, specZoneMaskEdge, specZoneMaskVertex
+        real (kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell
+
+        call mpas_pool_get_dimension(mesh, 'nCells', nCells)
+
+        call mpas_pool_get_array(mesh, 'bdyMaskCell', bdyMaskCell)
+        call mpas_pool_get_array(mesh, 'bdyMaskEdge', bdyMaskEdge)
+        call mpas_pool_get_array(mesh, 'bdyMaskVertex', bdyMaskVertex)
+        call mpas_pool_get_array(mesh, 'specZoneMaskCell', specZoneMaskCell)
+        call mpas_pool_get_array(mesh, 'specZoneMaskEdge', specZoneMaskEdge)
+        call mpas_pool_get_array(mesh, 'specZoneMaskVertex', specZoneMaskVertex)
+        call mpas_pool_get_array(mesh, 'nearestRelaxationCell', nearestRelaxationCell)
+        call mpas_pool_get_array(mesh, 'nEdgesOnCell', nEdgesOnCell)
+        call mpas_pool_get_array(mesh, 'cellsOnCell', cellsOnCell)
+        call mpas_pool_get_array(mesh, 'xCell', xCell)
+        call mpas_pool_get_array(mesh, 'yCell', yCell)
+        call mpas_pool_get_array(mesh, 'zCell', zCell)
+
+        !
+        ! Setup mask identifying cells/edges/vertices in the specified zone
+        ! NB: The specZoneMask{Cell,Edge,Vertex} fields receive a default value of 0.0 from the Registry,
+        !     so no need to initialize them here
+        !
+        where (bdyMaskCell(:) > nRelaxZone) specZoneMaskCell(:) = 1.0_RKIND
+        where (bdyMaskEdge(:) > nRelaxZone) specZoneMaskEdge(:) = 1.0_RKIND
+        where (bdyMaskVertex(:) > nRelaxZone) specZoneMaskVertex(:) = 1.0_RKIND
+
+
+        nearestRelaxationCell(:) = nCells+1
+
+        !
+        ! For nearest relaxation cell to inner specified zone, just search
+        ! all cellsOnCell with bdyMaskCell == nRelaxZone
+        !
+        do iCell=1,nCells
+            if (bdyMaskCell(iCell) == (nRelaxZone+1)) then
+                dmin = 1.0e36
+                do j=1,nEdgesOnCell(iCell)
+                    i = cellsOnCell(j,iCell)
+                    if (bdyMaskCell(i) == nRelaxZone) then
+                        d = (xCell(i) - xCell(iCell))**2 + (yCell(i) - yCell(iCell))**2 + (zCell(i) - zCell(iCell))**2
+                        if (d < dmin) then
+                            dmin = d
+                            nearestRelaxationCell(iCell) = i
+                        end if
+                    end if
+                end do
+            end if
+        end do
+
+        !
+        ! For nearest relaxation cell to outer specified zone, search
+        ! all cellsOnCell of cellsOnCell
+        !
+        do iCell=1,nCells
+            if (bdyMaskCell(iCell) == (nRelaxZone+2)) then
+                dmin = 1.0e36
+                do j=1,nEdgesOnCell(iCell)
+                    i = cellsOnCell(j,iCell)
+                    if (bdyMaskCell(i) == (nRelaxZone+1)) then
+
+                        do jj=1,nEdgesOnCell(i)
+                            ii = cellsOnCell(jj,i)
+                            if (bdyMaskCell(ii) == nRelaxZone) then
+
+                                d = (xCell(ii) - xCell(iCell))**2 + (yCell(ii) - yCell(iCell))**2 + (zCell(ii) - zCell(iCell))**2
+                                if (d < dmin) then
+                                    dmin = d
+                                    nearestRelaxationCell(iCell) = ii
+                                end if
+
+                            end if
+                        end do
+
+                    end if
+                end do
+            end if
+        end do
+
+    end subroutine mpas_atm_setup_bdy_masks
+
+
+    !***********************************************************************
+    !
+    !  routine mpas_atm_bdy_checks
+    !
+    !> \brief   Checks compatibility of limited-area settings
+    !> \author  Michael Duda
+    !> \date    12 May 2019
+    !> \details 
+    !>  This routine checks that settings related to limited-area simulations
+    !>  are compatible. Specifically, the following are checked by this routine:
+    !>
+    !>  1) If config_apply_lbcs = true, the bdyMaskCell field must have non-zero elements
+    !>  2) If config_apply_lbcs = false, the bdyMaskCell field must not have non-zero elements
+    !>  3) If config_apply_lbcs = true, the lbc_in stream must have a valid input interval
+    !>
+    !>  If any of the above are not true, this routine prints an error message and
+    !>  returns a non-zero value in ierr; otherwise, a value of 0 is returned.
+    !
+    !-----------------------------------------------------------------------
+    subroutine mpas_atm_bdy_checks(dminfo, blockList, streamManager, ierr)
+
+        use mpas_log, only : mpas_log_write
+        use mpas_kind_types, only : StrKIND
+        use mpas_derived_types, only : dm_info, block_type, mpas_pool_type, MPAS_LOG_ERR, MPAS_STREAM_PROPERTY_RECORD_INTV, &
+                                       MPAS_STREAM_MGR_NOERR, MPAS_STREAM_INPUT
+        use mpas_stream_manager, only : mpas_stream_mgr_get_property
+        use mpas_pool_routines, only : mpas_pool_get_config, mpas_pool_get_dimension, mpas_pool_get_subpool, mpas_pool_get_array
+        use mpas_dmpar, only : mpas_dmpar_max_int
+
+        implicit none
+
+        type (dm_info), pointer :: dminfo
+        type (block_type), pointer :: blockList
+        type (MPAS_streamManager_type), pointer :: streamManager
+        integer, intent(out) :: ierr
+
+        character(len=StrKIND) :: input_interval
+        logical, pointer :: config_apply_lbcs => null()
+        integer, pointer :: nCellsSolve => null()
+        type (mpas_pool_type), pointer :: meshPool => null()
+        type (block_type), pointer :: block => null()
+        integer, dimension(:), pointer :: bdyMaskCell => null()
+        integer :: maxvar2d_local, maxvar2d_global
+
+
+        call mpas_pool_get_config(blocklist % configs, 'config_apply_lbcs', config_apply_lbcs)
+
+        call mpas_log_write('')
+        call mpas_log_write('Checking consistency of limited-area settings...')
+        call mpas_log_write(' - config_apply_lbcs = $l', logicArgs=(/config_apply_lbcs/))
+
+        !
+        ! Check whether any elements of bdyMaskCell have non-zero values
+        !
+        maxvar2d_local = -huge(maxvar2d_local)
+        block => blockList
+        do while (associated(block))
+            call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
+            call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+            call mpas_pool_get_array(meshPool, 'bdyMaskCell', bdyMaskCell)
+
+            maxvar2d_local = max(maxvar2d_local, maxval(bdyMaskCell(1:nCellsSolve)))
+
+            block => block % next
+        end do
+
+        call mpas_dmpar_max_int(dminfo, maxvar2d_local, maxvar2d_global)
+        call mpas_log_write(' - Maximum value in bdyMaskCell = $i', intArgs=(/maxvar2d_global/))
+
+        !
+        ! If there are boundary cells, config_apply_lbcs must be set to true
+        !
+        if (.not. config_apply_lbcs .and. maxvar2d_global > 0) then
+            call mpas_log_write('Boundary cells found in the bdyMaskCell field, but config_apply_lbcs = false.', &
+                                messageType=MPAS_LOG_ERR)
+            call mpas_log_write('Please ensure that config_apply_lbcs = true for limited-area simulations.', &
+                                messageType=MPAS_LOG_ERR)
+            ierr = 1
+            return
+        end if
+
+        !
+        ! If there are no boundary cells, config_apply_lbcs must be set to false
+        !
+        if (config_apply_lbcs .and. maxvar2d_global == 0) then
+            call mpas_log_write('config_apply_lbcs = true, but no boundary cells found in the bdyMaskCell field.', &
+                                messageType=MPAS_LOG_ERR)
+            call mpas_log_write('Please ensure that config_apply_lbcs = false for global simulations.', &
+                                messageType=MPAS_LOG_ERR)
+            ierr = 1
+            return
+        end if
+
+        !
+        ! If config_apply_lbcs = true, check that the 'lbc_in' stream has a valid input interval
+        !
+        if (config_apply_lbcs) then
+            call mpas_stream_mgr_get_property(streamManager, 'lbc_in', MPAS_STREAM_PROPERTY_RECORD_INTV, &
+                                              input_interval, MPAS_STREAM_INPUT, ierr)
+            if (ierr /= MPAS_STREAM_MGR_NOERR) then
+                call mpas_log_write('Unable to retrieve input interval for the ''lbc_in'' stream.', messageType=MPAS_LOG_ERR)
+                ierr = 1
+                return
+            end if
+
+            call mpas_log_write(' - Input interval for ''lbc_in'' stream = '''//trim(input_interval)//'''')
+            if (trim(input_interval) == 'none') then
+                call mpas_log_write('Input interval for the ''lbc_in'' stream must be a valid interval '// &
+                                    'when config_apply_lbcs = true.', messageType=MPAS_LOG_ERR)
+                ierr = 1
+                return
+            end if
+        end if
+
+        call mpas_log_write(' ----- done checking limited-area settings -----')
+        call mpas_log_write('')
+        ierr = 0
+
+    end subroutine mpas_atm_bdy_checks
+
+end module mpas_atm_boundaries
diff --git a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F
index 530fa86233..e286ee0f8f 100644
--- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F
+++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F
@@ -25,6 +25,8 @@ module atm_time_integration
    use mpas_atmphys_utilities
 #endif
 
+   use mpas_atm_boundaries, only : nSpecZone, nRelaxZone, nBdyZone, mpas_atm_get_bdy_state, mpas_atm_get_bdy_tend  ! regional_MPAS addition
+   
    use mpas_atm_iau  
 
    integer :: timerid, secs, u_secs
@@ -54,11 +56,31 @@ module atm_time_integration
    real (kind=RKIND), dimension(:,:), allocatable :: rho_zz_int
    real (kind=RKIND), dimension(:,:,:), allocatable :: scalar_tend_array
 
+   real (kind=RKIND), dimension(:,:,:), allocatable :: scalars_driving ! regional_MPAS addition 
+   real (kind=RKIND), dimension(:,:), allocatable :: ru_driving_tend ! regional_MPAS addition 
+   real (kind=RKIND), dimension(:,:), allocatable :: rt_driving_tend ! regional_MPAS addition 
+   real (kind=RKIND), dimension(:,:), allocatable :: rho_driving_tend ! regional_MPAS addition 
+   real (kind=RKIND), dimension(:,:), allocatable :: ru_driving_values ! regional_MPAS addition 
+   real (kind=RKIND), dimension(:,:), allocatable :: rt_driving_values ! regional_MPAS addition 
+   real (kind=RKIND), dimension(:,:), allocatable :: rho_driving_values ! regional_MPAS addition 
+   integer, dimension(:), pointer :: bdyMaskEdge ! regional_MPAS addition
+   logical, pointer :: config_apply_lbcs
+   
    ! Used in compute_solve_diagnostics
    real (kind=RKIND), allocatable, dimension(:,:) :: ke_vertex
    real (kind=RKIND), allocatable, dimension(:,:) :: ke_edge
 
-      
+   type (MPAS_Clock_type), pointer, private :: clock
+   type (block_type), pointer, private :: blocklist
+
+
+   ! Used for Rayleigh damping on u
+   ! NB: We do not necessarily want this to vary with calendar, as it is used to set
+   ! a timescale in seconds given a timescale in days, and it could be rather confusing
+   ! if damping in the model changed with the simulation calendar
+   real (kind=RKIND), parameter, private :: seconds_per_day = 86400.0_RKIND
+
+
    contains
 
 
@@ -89,7 +111,11 @@ subroutine atm_timestep(domain, dt, nowTime, itimestep)
       character (len=StrKIND), pointer :: config_time_integration
 
 
+      clock => domain % clock
+      blocklist => domain % blocklist
+
       call mpas_pool_get_config(domain % blocklist % configs, 'config_time_integration', config_time_integration)
+      call mpas_pool_get_config(domain % blocklist % configs, 'config_apply_lbcs', config_apply_lbcs)
 
       if (trim(config_time_integration) == 'SRK3') then
          call atm_srk3(domain, dt, itimestep)
@@ -168,6 +194,7 @@ subroutine atm_srk3(domain, dt, itimestep)
       character (len=StrKIND), pointer :: config_convection_scheme
 
       integer, pointer :: num_scalars, index_qv, nCells, nCellsSolve, nEdges, nEdgesSolve, nVertices, nVerticesSolve, nVertLevels
+      integer, pointer :: index_qc, index_qr, index_qi, index_qs, index_qg, index_nr, index_ni
 
       character(len=StrKIND), pointer :: config_IAU_option
 
@@ -177,6 +204,7 @@ subroutine atm_srk3(domain, dt, itimestep)
       type (mpas_pool_type), pointer :: mesh
       type (mpas_pool_type), pointer :: tend
       type (mpas_pool_type), pointer :: tend_physics
+      type (mpas_pool_type), pointer :: lbc  ! regional_MPAS addition
 
       type (field2DReal), pointer :: theta_m_field
       type (field3DReal), pointer :: scalars_field
@@ -199,6 +227,7 @@ subroutine atm_srk3(domain, dt, itimestep)
 
       real (kind=RKIND), dimension(:,:), pointer :: rqvdynten
 
+      real (kind=RKIND)  :: time_dyn_step
       logical, parameter :: debug = .false.
 
 
@@ -418,6 +447,13 @@ subroutine atm_srk3(domain, dt, itimestep)
          block => block % next
       end do
       call mpas_timer_stop('physics_get_tend')
+#else
+      !
+      ! If no physics are being used, simply zero-out the physics tendency fields
+      !
+      tend_ru_physics(:,:) = 0.0_RKIND
+      tend_rtheta_physics(:,:) = 0.0_RKIND
+      tend_rho_physics(:,:) = 0.0_RKIND
 #endif
 
       !
@@ -641,6 +677,110 @@ subroutine atm_srk3(domain, dt, itimestep)
             end do
             call mpas_timer_stop('small_step_prep')
 
+          
+!------------------------------------------------------------------------------------------------------------------------
+
+            if (config_apply_lbcs) then  ! adjust boundary tendencies for regional_MPAS dry dynamics in the specified zone
+
+               block => domain % blocklist
+               do while (associated(block))
+
+                  call mpas_pool_get_subpool(block % structs, 'mesh', mesh)
+                  call mpas_pool_get_subpool(block % structs, 'tend', tend)
+   
+                  call mpas_pool_get_dimension(mesh, 'nCells', nCells)
+                  call mpas_pool_get_dimension(mesh, 'nEdges', nEdges)
+                  call mpas_pool_get_dimension(mesh, 'nVertLevels', nVertLevels)
+                  call mpas_pool_get_dimension(block % dimensions, 'nThreads', nThreads)
+
+                  call mpas_pool_get_dimension(block % dimensions, 'cellThreadStart', cellThreadStart)
+                  call mpas_pool_get_dimension(block % dimensions, 'cellThreadEnd', cellThreadEnd)
+                  call mpas_pool_get_dimension(block % dimensions, 'cellSolveThreadStart', cellSolveThreadStart)
+                  call mpas_pool_get_dimension(block % dimensions, 'cellSolveThreadEnd', cellSolveThreadEnd)
+
+                  call mpas_pool_get_dimension(block % dimensions, 'edgeThreadStart', edgeThreadStart)
+                  call mpas_pool_get_dimension(block % dimensions, 'edgeThreadEnd', edgeThreadEnd)
+                  call mpas_pool_get_dimension(block % dimensions, 'edgeSolveThreadStart', edgeSolveThreadStart)
+                  call mpas_pool_get_dimension(block % dimensions, 'edgeSolveThreadEnd', edgeSolveThreadEnd)
+
+                  allocate(ru_driving_tend(nVertLevels,nEdges+1))
+                  allocate(rt_driving_tend(nVertLevels,nCells+1))
+                  allocate(rho_driving_tend(nVertLevels,nCells+1))
+                  ru_driving_tend(1:nVertLevels,1:nEdges+1) =  mpas_atm_get_bdy_tend( clock, domain % blocklist, nVertLevels, nEdges, 'ru', 0.0_RKIND )
+                  rt_driving_tend(1:nVertLevels,1:nCells+1) =  mpas_atm_get_bdy_tend( clock, domain % blocklist, nVertLevels, nCells, 'rtheta_m', 0.0_RKIND )
+                  rho_driving_tend(1:nVertLevels,1:nCells+1) =  mpas_atm_get_bdy_tend( clock, domain % blocklist, nVertLevels, nCells, 'rho_zz', 0.0_RKIND )
+!$OMP PARALLEL DO
+                  do thread=1,nThreads
+                     call atm_bdy_adjust_dynamics_speczone_tend( tend, mesh, block % configs, nVertLevels,                 &
+                                                                 ru_driving_tend, rt_driving_tend, rho_driving_tend,       &
+                                                                 cellThreadStart(thread), cellThreadEnd(thread),           &
+                                                                 edgeThreadStart(thread), edgeThreadEnd(thread),           &
+                                                                 cellSolveThreadStart(thread), cellSolveThreadEnd(thread), &
+                                                                 edgeSolveThreadStart(thread), edgeSolveThreadEnd(thread) )
+                  end do
+!$OMP END PARALLEL DO
+
+                  deallocate(ru_driving_tend)
+                  deallocate(rt_driving_tend)
+                  deallocate(rho_driving_tend)
+                  block => block % next
+               end do
+
+! -------- next, add in the tendencies for the horizontal filters and Rayleigh damping.  We will keep the spec zone and relax zone adjustments separate for now...
+               
+               block => domain % blocklist
+               do while (associated(block))
+                  call mpas_pool_get_subpool(block % structs, 'state', state)
+                  call mpas_pool_get_subpool(block % structs, 'diag', diag)
+                  call mpas_pool_get_subpool(block % structs, 'mesh', mesh)
+                  call mpas_pool_get_subpool(block % structs, 'tend', tend)
+   
+                  call mpas_pool_get_dimension(mesh, 'nCells', nCells)
+                  call mpas_pool_get_dimension(mesh, 'nEdges', nEdges)
+                  call mpas_pool_get_dimension(mesh, 'nVertLevels', nVertLevels)
+                  call mpas_pool_get_dimension(block % dimensions, 'nThreads', nThreads)
+
+                  call mpas_pool_get_dimension(block % dimensions, 'cellThreadStart', cellThreadStart)
+                  call mpas_pool_get_dimension(block % dimensions, 'cellThreadEnd', cellThreadEnd)
+                  call mpas_pool_get_dimension(block % dimensions, 'cellSolveThreadStart', cellSolveThreadStart)
+                  call mpas_pool_get_dimension(block % dimensions, 'cellSolveThreadEnd', cellSolveThreadEnd)
+
+                  call mpas_pool_get_dimension(block % dimensions, 'edgeThreadStart', edgeThreadStart)
+                  call mpas_pool_get_dimension(block % dimensions, 'edgeThreadEnd', edgeThreadEnd)
+                  call mpas_pool_get_dimension(block % dimensions, 'edgeSolveThreadStart', edgeSolveThreadStart)
+                  call mpas_pool_get_dimension(block % dimensions, 'edgeSolveThreadEnd', edgeSolveThreadEnd)
+
+                  allocate(ru_driving_values(nVertLevels,nEdges+1))
+                  allocate(rt_driving_values(nVertLevels,nCells+1))
+                  allocate(rho_driving_values(nVertLevels,nCells+1))
+
+                  time_dyn_step = dt_dynamics*real(dynamics_substep-1) + rk_timestep(rk_step)
+                  ru_driving_values(1:nVertLevels,1:nEdges+1) =  mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nEdges, 'ru', time_dyn_step )
+                  rt_driving_values(1:nVertLevels,1:nCells+1) =  mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'rtheta_m', time_dyn_step )
+                  rho_driving_values(1:nVertLevels,1:nCells+1) =  mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'rho_zz', time_dyn_step )
+
+!$OMP PARALLEL DO
+                  do thread=1,nThreads
+                     call atm_bdy_adjust_dynamics_relaxzone_tend( tend, state, diag, mesh, nVertLevels, dt,                   &
+                                                                  ru_driving_values, rt_driving_values, rho_driving_values,   &
+                                                                  cellThreadStart(thread), cellThreadEnd(thread),             &
+                                                                  edgeThreadStart(thread), edgeThreadEnd(thread),             &
+                                                                  cellSolveThreadStart(thread), cellSolveThreadEnd(thread),   &
+                                                                  edgeSolveThreadStart(thread), edgeSolveThreadEnd(thread) )
+                  end do
+!$OMP END PARALLEL DO
+
+                  deallocate(ru_driving_values)
+                  deallocate(rt_driving_values)
+                  deallocate(rho_driving_values)
+                  block => block % next
+               end do
+
+
+            end if  ! regional_MPAS addition
+
+!------------------------------------------------------------------------------------------------------------------------
+
             !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
             ! begin acoustic steps loop
             !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -789,6 +929,58 @@ subroutine atm_srk3(domain, dt, itimestep)
             end do
             call mpas_timer_stop('atm_recover_large_step_variables')
 
+!-------------------------------------------------------------------
+
+            if (config_apply_lbcs) then
+
+               ! First, (re)set the value of u and ru in the specified zone at the outermost edge (we will reset all for now).
+               ! atm_recover_large_step_variables will not have set outermost edge velocities correctly.
+               
+               block => domain % blocklist
+               do while (associated(block))
+
+                  call mpas_pool_get_subpool(block % structs, 'state', state)
+                  call mpas_pool_get_subpool(block % structs, 'mesh', mesh)
+                  call mpas_pool_get_subpool(block % structs, 'diag', diag)
+                  call mpas_pool_get_dimension(mesh, 'nEdges', nEdges)
+                  call mpas_pool_get_dimension(state, 'nEdgesSolve', nEdgesSolve)
+                  call mpas_pool_get_dimension(mesh, 'nVertLevels', nVertLevels)
+                  call mpas_pool_get_array(state, 'u', u, 2)
+                  call mpas_pool_get_array(mesh, 'bdyMaskEdge', bdyMaskEdge)
+
+                  allocate(ru_driving_values(nVertLevels,nEdges+1))
+
+                  time_dyn_step = dt_dynamics*real(dynamics_substep-1) + rk_timestep(rk_step)
+
+                  ru_driving_values(1:nVertLevels,1:nEdges+1) =  mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nEdges, 'u', time_dyn_step )
+                  ! do this inline at present - it is simple enough
+                  do iEdge = 1, nEdgesSolve
+                     if(bdyMaskEdge(iEdge) > nRelaxZone) then
+                        do k = 1, nVertLevels
+                           u(k,iEdge) = ru_driving_values(k,iEdge)
+                        end do
+                     end if
+                  end do
+
+                  ru_driving_values(1:nVertLevels,1:nEdges+1) =  mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nEdges, 'ru', time_dyn_step )
+                  call mpas_pool_get_array(diag, 'ru', u)
+                  ! do this inline at present - it is simple enough
+                  do iEdge = 1, nEdges
+                     if(bdyMaskEdge(iEdge) > nRelaxZone) then
+                        do k = 1, nVertLevels
+                           u(k,iEdge) = ru_driving_values(k,iEdge)
+                        end do
+                     end if
+                  end do
+                  
+                  block => block % next
+               end do
+               deallocate(ru_driving_values)
+
+            end if  ! regional_MPAS addition
+
+!-------------------------------------------------------------------
+            
             ! u
             !CR: SMALLER STENCIL?: call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % u, (/ 3 /))
             call mpas_pool_get_subpool(domain % blocklist % structs, 'state', state)
@@ -914,6 +1106,82 @@ subroutine atm_srk3(domain, dt, itimestep)
                   call mpas_timer_stop('atm_advance_scalars_mono')
                end if
 
+               if (config_apply_lbcs) then  ! adjust boundary tendencies for regional_MPAS scalar transport
+
+                  call mpas_pool_get_field(state, 'scalars', scalars_field, 2)  ! need to fill halo for horizontal filter
+                  call mpas_dmpar_exch_halo_field(scalars_field)
+
+                  block => domain % blocklist
+                  do while (associated(block))
+
+                     call mpas_pool_get_subpool(block % structs, 'state', state)
+                     call mpas_pool_get_subpool(block % structs, 'diag', diag)
+                     call mpas_pool_get_subpool(block % structs, 'mesh', mesh)
+   
+                     call mpas_pool_get_dimension(mesh, 'nVertLevels', nVertLevels)
+                     call mpas_pool_get_dimension(mesh, 'nCells', nCells)
+                     call mpas_pool_get_dimension(state, 'num_scalars', num_scalars)
+                     allocate(scalars_driving(num_scalars,nVertLevels,nCells+1))
+
+
+                     !  get the scalar values driving the regional boundary conditions
+                     !
+                     call mpas_pool_get_dimension(state, 'index_qv', index_qv)
+                     call mpas_pool_get_dimension(state, 'index_qc', index_qc)
+                     call mpas_pool_get_dimension(state, 'index_qr', index_qr)
+                     call mpas_pool_get_dimension(state, 'index_qi', index_qi)
+                     call mpas_pool_get_dimension(state, 'index_qs', index_qs)
+                     call mpas_pool_get_dimension(state, 'index_qg', index_qg)  
+                     call mpas_pool_get_dimension(state, 'index_nr', index_nr)
+                     call mpas_pool_get_dimension(state, 'index_ni', index_ni)
+
+                     call mpas_pool_get_dimension(block % dimensions, 'nThreads', nThreads)
+
+                     call mpas_pool_get_dimension(block % dimensions, 'cellThreadStart', cellThreadStart)
+                     call mpas_pool_get_dimension(block % dimensions, 'cellThreadEnd', cellThreadEnd)
+                     call mpas_pool_get_dimension(block % dimensions, 'cellSolveThreadStart', cellSolveThreadStart)
+                     call mpas_pool_get_dimension(block % dimensions, 'cellSolveThreadEnd', cellSolveThreadEnd)
+
+                     if (index_qv > 0) then
+                        scalars_driving(index_qv,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qv', rk_timestep(rk_step) )
+                     end if
+                     if (index_qc > 0) then
+                        scalars_driving(index_qc,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qc', rk_timestep(rk_step) )
+                     end if
+                     if (index_qr > 0) then
+                        scalars_driving(index_qr,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qr', rk_timestep(rk_step) )
+                     end if
+                     if (index_qi > 0) then
+                        scalars_driving(index_qi,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qi', rk_timestep(rk_step) )
+                     end if
+                     if (index_qs > 0) then
+                        scalars_driving(index_qs,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qs', rk_timestep(rk_step) )
+                     end if
+                     if (index_qg > 0) then
+                        scalars_driving(index_qg,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qg', rk_timestep(rk_step) )
+                     end if
+                     if (index_nr > 0) then
+                        scalars_driving(index_nr,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'nr', rk_timestep(rk_step) )
+                     end if
+                     if (index_ni > 0) then
+                        scalars_driving(index_ni,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'ni', rk_timestep(rk_step) )
+                     end if
+                  
+                     !$OMP PARALLEL DO
+                     do thread=1,nThreads
+                        call atm_bdy_adjust_scalars( state, diag, mesh, block % configs, scalars_driving, nVertLevels, dt, rk_timestep(rk_step), &
+                                                     cellThreadStart(thread), cellThreadEnd(thread), &
+                                                     cellSolveThreadStart(thread), cellSolveThreadEnd(thread) )
+                     end do
+                     !$OMP END PARALLEL DO
+
+                     deallocate(scalars_driving)
+
+                     block => block % next
+                  end do
+
+               end if  ! regional_MPAS addition
+
             end if
 
             call mpas_timer_start('atm_compute_solve_diagnostics')
@@ -980,6 +1248,35 @@ subroutine atm_srk3(domain, dt, itimestep)
                call mpas_dmpar_exch_halo_field(scalars_field)
             end if
 
+            ! set the zero-gradient condition on w for regional_MPAS
+            
+            if ( config_apply_lbcs ) then  ! regional_MPAS addition
+              block => domain % blocklist
+              do while (associated(block))
+
+                call mpas_pool_get_subpool(block % structs, 'mesh', mesh)
+                call mpas_pool_get_subpool(block % structs, 'state', state)
+                call mpas_pool_get_dimension(block % dimensions, 'nThreads', nThreads)
+
+                call mpas_pool_get_dimension(block % dimensions, 'cellSolveThreadStart', cellSolveThreadStart)
+                call mpas_pool_get_dimension(block % dimensions, 'cellSolveThreadEnd', cellSolveThreadEnd)
+!$OMP PARALLEL DO
+                do thread=1,nThreads
+                   call atm_zero_gradient_w_bdy( state, mesh, &
+                                                 cellSolveThreadStart(thread), cellSolveThreadEnd(thread) )
+                end do
+!$OMP END PARALLEL DO
+
+                block => block % next
+              end do
+
+              ! w halo values needs resetting after regional boundary update
+              call mpas_pool_get_subpool(domain % blocklist % structs, 'state', state)
+              call mpas_pool_get_field(state, 'w', w_field, 2)
+              call mpas_dmpar_exch_halo_field(w_field)
+
+            end if ! end of regional_MPAS addition 
+
          end do RK3_DYNAMICS
 
          if (dynamics_substep < dynamics_split) then
@@ -1189,6 +1486,86 @@ subroutine atm_srk3(domain, dt, itimestep)
                call mpas_timer_stop('atm_advance_scalars_mono')
             end if
 
+!------------------------------------------------------------------------------------------------------------------------
+
+            if (config_apply_lbcs) then  ! adjust boundary tendencies for regional_MPAS scalar transport
+
+               call mpas_pool_get_field(state, 'scalars', scalars_field, 2)  ! need to fill halo for horizontal filter
+               call mpas_dmpar_exch_halo_field(scalars_field)
+
+               block => domain % blocklist
+               do while (associated(block))
+
+                  call mpas_pool_get_subpool(block % structs, 'state', state)
+                  call mpas_pool_get_subpool(block % structs, 'diag', diag)
+                  call mpas_pool_get_subpool(block % structs, 'mesh', mesh)
+   
+                  call mpas_pool_get_dimension(mesh, 'nVertLevels', nVertLevels)
+                  call mpas_pool_get_dimension(mesh, 'nCells', nCells)
+                  call mpas_pool_get_dimension(state, 'num_scalars', num_scalars)
+                  allocate(scalars_driving(num_scalars,nVertLevels,nCells+1))
+
+
+                  !  get the scalar values driving the regional boundary conditions
+                  !
+                  call mpas_pool_get_dimension(state, 'index_qv', index_qv)
+                  call mpas_pool_get_dimension(state, 'index_qc', index_qc)
+                  call mpas_pool_get_dimension(state, 'index_qr', index_qr)
+                  call mpas_pool_get_dimension(state, 'index_qi', index_qi)
+                  call mpas_pool_get_dimension(state, 'index_qs', index_qs)
+                  call mpas_pool_get_dimension(state, 'index_qg', index_qg)  
+                  call mpas_pool_get_dimension(state, 'index_nr', index_nr)
+                  call mpas_pool_get_dimension(state, 'index_ni', index_ni)
+
+                  call mpas_pool_get_dimension(block % dimensions, 'nThreads', nThreads)
+
+                  call mpas_pool_get_dimension(block % dimensions, 'cellThreadStart', cellThreadStart)
+                  call mpas_pool_get_dimension(block % dimensions, 'cellThreadEnd', cellThreadEnd)
+                  call mpas_pool_get_dimension(block % dimensions, 'cellSolveThreadStart', cellSolveThreadStart)
+                  call mpas_pool_get_dimension(block % dimensions, 'cellSolveThreadEnd', cellSolveThreadEnd)
+
+                  if (index_qv > 0) then
+                     scalars_driving(index_qv,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qv', rk_timestep(rk_step) )
+                  end if
+                  if (index_qc > 0) then
+                     scalars_driving(index_qc,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qc', rk_timestep(rk_step) )
+                  end if
+                  if (index_qr > 0) then
+                     scalars_driving(index_qr,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qr', rk_timestep(rk_step) )
+                  end if
+                  if (index_qi > 0) then
+                     scalars_driving(index_qi,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qi', rk_timestep(rk_step) )
+                  end if
+                  if (index_qs > 0) then
+                     scalars_driving(index_qs,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qs', rk_timestep(rk_step) )
+                  end if
+                  if (index_qg > 0) then
+                     scalars_driving(index_qg,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qg', rk_timestep(rk_step) )
+                  end if
+                  if (index_nr > 0) then
+                     scalars_driving(index_nr,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'nr', rk_timestep(rk_step) )
+                  end if
+                  if (index_ni > 0) then
+                     scalars_driving(index_ni,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'ni', rk_timestep(rk_step) )
+                  end if
+                  
+!$OMP PARALLEL DO
+                  do thread=1,nThreads
+                     call atm_bdy_adjust_scalars( state, diag, mesh, block % configs, scalars_driving, nVertLevels, dt, rk_timestep(rk_step), &
+                                                  cellThreadStart(thread), cellThreadEnd(thread), &
+                                                  cellSolveThreadStart(thread), cellSolveThreadEnd(thread) )
+                  end do
+!$OMP END PARALLEL DO
+
+                  deallocate(scalars_driving)
+
+                  block => block % next
+               end do
+
+            end if  ! regional_MPAS addition
+
+!------------------------------------------------------------------------------------------------------------------------
+
             if (rk_step < 3) then
                call mpas_pool_get_field(state, 'scalars', scalars_field, 2)
                call mpas_dmpar_exch_halo_field(scalars_field)
@@ -1292,6 +1669,128 @@ subroutine atm_srk3(domain, dt, itimestep)
       !
 #endif
 
+      if (config_apply_lbcs) then  ! reset boundary values of rtheta in the specified zone - microphysics has messed with them
+
+         block => domain % blocklist
+         do while (associated(block))
+            call mpas_pool_get_subpool(block % structs, 'state', state)
+            call mpas_pool_get_subpool(block % structs, 'diag', diag)
+            call mpas_pool_get_subpool(block % structs, 'mesh', mesh)
+
+            call mpas_pool_get_dimension(mesh, 'nCells', nCells)
+            call mpas_pool_get_dimension(mesh, 'nVertLevels', nVertLevels)
+            call mpas_pool_get_dimension(block % dimensions, 'nThreads', nThreads)
+
+            call mpas_pool_get_dimension(block % dimensions, 'cellThreadStart', cellThreadStart)
+            call mpas_pool_get_dimension(block % dimensions, 'cellThreadEnd', cellThreadEnd)
+            call mpas_pool_get_dimension(block % dimensions, 'cellSolveThreadStart', cellSolveThreadStart)
+            call mpas_pool_get_dimension(block % dimensions, 'cellSolveThreadEnd', cellSolveThreadEnd)
+
+            allocate(rt_driving_values(nVertLevels,nCells+1))
+            allocate(rho_driving_values(nVertLevels,nCells+1))
+            time_dyn_step = dt  ! end of full timestep values
+
+            rt_driving_values(1:nVertLevels,1:nCells+1) =  mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'rtheta_m', time_dyn_step )
+            rho_driving_values(1:nVertLevels,1:nCells+1) =  mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'rho_zz', time_dyn_step )
+
+!$OMP PARALLEL DO
+            do thread=1,nThreads
+               call atm_bdy_reset_speczone_values( state, diag, mesh, nVertLevels, &
+                                                   rt_driving_values, rho_driving_values,                        &
+                                                   cellThreadStart(thread), cellThreadEnd(thread),               &
+                                                   cellSolveThreadStart(thread), cellSolveThreadEnd(thread) )
+            end do
+!$OMP END PARALLEL DO
+
+            deallocate(rt_driving_values)
+            deallocate(rho_driving_values)
+            block => block % next
+
+         end do
+
+      end if  ! regional_MPAS addition
+
+
+      if (config_apply_lbcs) then  ! adjust boundary values for regional_MPAS scalar transport
+
+         call mpas_pool_get_field(state, 'scalars', scalars_field, 2)  ! need to fill halo for horizontal filter
+         call mpas_dmpar_exch_halo_field(scalars_field)
+
+         block => domain % blocklist
+         do while (associated(block))
+
+            call mpas_pool_get_subpool(block % structs, 'state', state)
+            call mpas_pool_get_subpool(block % structs, 'mesh', mesh)
+   
+            call mpas_pool_get_dimension(mesh, 'nVertLevels', nVertLevels)
+            call mpas_pool_get_dimension(mesh, 'nCells', nCells)
+            call mpas_pool_get_dimension(state, 'num_scalars', num_scalars)
+            allocate(scalars_driving(num_scalars,nVertLevels,nCells+1))
+
+
+            !  get the scalar values driving the regional boundary conditions
+            !
+            call mpas_pool_get_dimension(state, 'index_qv', index_qv)
+            call mpas_pool_get_dimension(state, 'index_qc', index_qc)
+            call mpas_pool_get_dimension(state, 'index_qr', index_qr)
+            call mpas_pool_get_dimension(state, 'index_qi', index_qi)
+            call mpas_pool_get_dimension(state, 'index_qs', index_qs)
+            call mpas_pool_get_dimension(state, 'index_qg', index_qg)  
+            call mpas_pool_get_dimension(state, 'index_nr', index_nr)
+            call mpas_pool_get_dimension(state, 'index_ni', index_ni)
+
+            call mpas_pool_get_dimension(block % dimensions, 'nThreads', nThreads)
+
+            call mpas_pool_get_dimension(block % dimensions, 'cellThreadStart', cellThreadStart)
+            call mpas_pool_get_dimension(block % dimensions, 'cellThreadEnd', cellThreadEnd)
+            call mpas_pool_get_dimension(block % dimensions, 'cellSolveThreadStart', cellSolveThreadStart)
+            call mpas_pool_get_dimension(block % dimensions, 'cellSolveThreadEnd', cellSolveThreadEnd)
+
+            call mpas_pool_get_dimension(block % dimensions, 'vertexThreadStart', vertexThreadStart)
+            call mpas_pool_get_dimension(block % dimensions, 'vertexThreadEnd', vertexThreadEnd)
+            call mpas_pool_get_dimension(block % dimensions, 'vertexSolveThreadStart', vertexSolveThreadStart)
+            call mpas_pool_get_dimension(block % dimensions, 'vertexSolveThreadEnd', vertexSolveThreadEnd)
+
+            if (index_qv > 0) then
+               scalars_driving(index_qv,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qv', dt )
+            end if
+            if (index_qc > 0) then
+               scalars_driving(index_qc,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qc', dt )
+            end if
+            if (index_qr > 0) then
+               scalars_driving(index_qr,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qr', dt )
+            end if
+            if (index_qi > 0) then
+               scalars_driving(index_qi,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qi', dt )
+            end if
+            if (index_qs > 0) then
+               scalars_driving(index_qs,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qs', dt )
+            end if
+            if (index_qg > 0) then
+               scalars_driving(index_qg,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'qg', dt )
+            end if
+            if (index_nr > 0) then
+               scalars_driving(index_nr,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'nr', dt )
+            end if
+            if (index_ni > 0) then
+               scalars_driving(index_ni,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, domain % blocklist, nVertLevels, nCells, 'ni', dt )
+            end if
+      
+!$OMP PARALLEL DO
+            do thread=1,nThreads
+               call atm_bdy_set_scalars( state, mesh, scalars_driving, nVertLevels, &
+                                         cellThreadStart(thread), cellThreadEnd(thread), &
+                                         cellSolveThreadStart(thread), cellSolveThreadEnd(thread) )
+            end do
+!$OMP END PARALLEL DO
+
+            deallocate(scalars_driving)
+
+            block => block % next
+         end do
+
+      end if  ! regional_MPAS addition
+
       call summarize_timestep(domain)
 
    end subroutine atm_srk3
@@ -1665,11 +2164,15 @@ subroutine atm_set_smlstep_pert_variables( tend, diag, mesh, configs, &
       real (kind=RKIND), dimension(:,:), pointer :: rw_p, rw_save, rw
       real (kind=RKIND), dimension(:,:), pointer :: edgesOnCell_sign
 
+      integer, dimension(:), pointer :: bdyMaskCell  ! regional_MPAS
 
       call mpas_pool_get_dimension(mesh, 'nCells', nCells)
       call mpas_pool_get_dimension(mesh, 'nCellsSolve', nCellsSolve)
       call mpas_pool_get_dimension(mesh, 'nEdges', nEdges)
 
+! regional_MPAS: get specified zone cell mask
+      call mpas_pool_get_array(mesh, 'bdyMaskCell', bdyMaskCell)
+
       call mpas_pool_get_array(mesh, 'zz', zz)
       call mpas_pool_get_array(mesh, 'zb', zb)
       call mpas_pool_get_array(mesh, 'zb3', zb3)
@@ -1708,7 +2211,9 @@ subroutine atm_set_smlstep_pert_variables( tend, diag, mesh, configs, &
       call atm_set_smlstep_pert_variables_work(nCells, nEdges, nCellsSolve, &
                                    nEdgesOnCell, cellsOnEdge, edgesOnCell, fzm, fzp, ruAvg, wwAvg, zb, zb3, zb_cell, zb3_cell, &
                                    zz, w_tend, u_tend, rho_pp, rho_p_save, rho_p, ru_p, ru, ru_save, &
-                                   rtheta_pp, rtheta_p_save, rtheta_p, rtheta_pp_old, rw_p, rw_save, rw, edgesOnCell_sign, &
+                                   rtheta_pp, rtheta_p_save, rtheta_p, rtheta_pp_old, rw_p, rw_save, rw, &
+                                   bdyMaskCell, &  ! added for regional_MPAS
+                                   edgesOnCell_sign, &
                                    cellStart, cellEnd, edgeStart, edgeEnd, &
                                    cellSolveStart, cellSolveEnd, edgeSolveStart, edgeSolveEnd)
 
@@ -1719,7 +2224,9 @@ end subroutine atm_set_smlstep_pert_variables
    subroutine atm_set_smlstep_pert_variables_work(nCells, nEdges, nCellsSolve, &
                                    nEdgesOnCell, cellsOnEdge, edgesOnCell, fzm, fzp, ruAvg, wwAvg, zb, zb3, zb_cell, zb3_cell, &
                                    zz, w_tend, u_tend, rho_pp, rho_p_save, rho_p, ru_p, ru, ru_save, &
-                                   rtheta_pp, rtheta_p_save, rtheta_p, rtheta_pp_old, rw_p, rw_save, rw, edgesOnCell_sign, &
+                                   rtheta_pp, rtheta_p_save, rtheta_p, rtheta_pp_old, rw_p, rw_save, rw, &
+                                   bdyMaskCell, &  ! added for regional_MPAS
+                                   edgesOnCell_sign, &
                                    cellStart, cellEnd, edgeStart, edgeEnd, &
                                    cellSolveStart, cellSolveEnd, edgeSolveStart, edgeSolveEnd)
 
@@ -1765,6 +2272,8 @@ subroutine atm_set_smlstep_pert_variables_work(nCells, nEdges, nCellsSolve, &
       real (kind=RKIND), dimension(nVertLevels+1,nCells+1) :: rw
       real (kind=RKIND), dimension(maxEdges,nCells+1) :: edgesOnCell_sign
 
+      integer, dimension(nCells+1), intent(in) :: bdyMaskCell  !  added for regional_MPAS
+
       !
       ! Local variables
       !
@@ -1779,6 +2288,8 @@ subroutine atm_set_smlstep_pert_variables_work(nCells, nEdges, nCellsSolve, &
 
 !!      do iCell=cellStart,cellEnd
       do iCell=cellSolveStart,cellSolveEnd
+
+         if (bdyMaskCell(iCell) <= nRelaxZone) then  !  no conversion in specified zone, regional_MPAS
          do i=1,nEdgesOnCell(iCell)
             iEdge = edgesOnCell(i,iCell)
 !DIR$ IVDEP
@@ -1792,6 +2303,7 @@ subroutine atm_set_smlstep_pert_variables_work(nCells, nEdges, nCellsSolve, &
          do k = 2, nVertLevels
             w_tend(k,iCell) = ( fzm(k) * zz(k,iCell) + fzp(k) * zz(k-1,iCell)   ) * w_tend(k,iCell)
          end do
+         end if ! no conversion in specified zone
       end do
 
    end subroutine atm_set_smlstep_pert_variables_work
@@ -1842,6 +2354,7 @@ subroutine atm_advance_acoustic_step( state, diag, tend, mesh, configs, nCells,
       real (kind=RKIND), dimension(:), pointer :: fzm, fzp, rdzw, dcEdge, invDcEdge, invAreaCell, cofrz, dvEdge
 
       integer, dimension(:), pointer :: nEdgesOnCell
+      real (kind=RKIND), dimension(:), pointer :: specZoneMaskCell, specZoneMaskEdge
       integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell
       real (kind=RKIND), dimension(:,:), pointer :: edgesOnCell_sign
 
@@ -1855,6 +2368,8 @@ subroutine atm_advance_acoustic_step( state, diag, tend, mesh, configs, nCells,
       call mpas_pool_get_array(mesh, 'edgesOnCell', edgesOnCell)
       call mpas_pool_get_array(mesh, 'nEdgesOnCell', nEdgesOnCell)
       call mpas_pool_get_array(mesh, 'edgesOnCell_sign', edgesOnCell_sign)
+      call mpas_pool_get_array(mesh, 'specZoneMaskEdge', specZoneMaskEdge)
+      call mpas_pool_get_array(mesh, 'specZoneMaskCell', specZoneMaskCell)
 
       call mpas_pool_get_array(state, 'rho_zz', rho_zz, 2)
 !      call mpas_pool_get_array(state, 'theta_m', theta_m, 2)
@@ -1922,7 +2437,8 @@ subroutine atm_advance_acoustic_step( state, diag, tend, mesh, configs, nCells,
                                    rho_pp, cofwt, coftz, zxu, a_tri, alpha_tri, gamma_tri, dss, tend_ru, tend_rho, tend_rt, &
                                    tend_rw, zgrid, cofwr, cofwz, w, ru, ru_save, rw, rw_save, fzm, fzp, rdzw, dcEdge, invDcEdge, &
                                    invAreaCell, cofrz, dvEdge, nEdgesOnCell, cellsOnEdge, edgesOnCell, edgesOnCell_sign, &
-                                   dts, small_step, epssm, cf1, cf2, cf3 &
+                                   dts, small_step, epssm, cf1, cf2, cf3, &
+                                   specZoneMaskEdge, specZoneMaskCell &
                                    )
 
    end subroutine atm_advance_acoustic_step
@@ -1934,7 +2450,8 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart
                                    rho_pp, cofwt, coftz, zxu, a_tri, alpha_tri, gamma_tri, dss, tend_ru, tend_rho, tend_rt, &
                                    tend_rw, zgrid, cofwr, cofwz, w, ru, ru_save, rw, rw_save, fzm, fzp, rdzw, dcEdge, invDcEdge, &
                                    invAreaCell, cofrz, dvEdge, nEdgesOnCell, cellsOnEdge, edgesOnCell, edgesOnCell_sign, &
-                                   dts, small_step, epssm, cf1, cf2, cf3 &
+                                   dts, small_step, epssm, cf1, cf2, cf3, &
+                                   specZoneMaskEdge, specZoneMaskCell &
                                    )
 
       use mpas_atm_dimensions
@@ -1998,6 +2515,10 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart
       integer, dimension(maxEdges,nCells+1) :: edgesOnCell
       real (kind=RKIND), dimension(maxEdges,nCells+1) :: edgesOnCell_sign
 
+      real (kind=RKIND), dimension(nCells+1) :: specZoneMaskCell
+      real (kind=RKIND), dimension(nEdges+1) :: specZoneMaskEdge
+      
+
       integer, intent(in) :: small_step
       real (kind=RKIND), intent(in) :: dts, epssm,cf1, cf2, cf3
       real (kind=RKIND), dimension(nVertLevels) :: ts, rs
@@ -2041,7 +2562,7 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart
                  pgrad = ((rtheta_pp(k,cell2)-rtheta_pp(k,cell1))*invDcEdge(iEdge) )/(.5*(zz(k,cell2)+zz(k,cell1)))
                  pgrad = cqu(k,iEdge)*0.5*c2*(exner(k,cell1)+exner(k,cell2))*pgrad
                  pgrad = pgrad + 0.5*zxu(k,iEdge)*gravity*(rho_pp(k,cell1)+rho_pp(k,cell2))
-                 ru_p(k,iEdge) = ru_p(k,iEdge) + dts*(tend_ru(k,iEdge) - pgrad) 
+                 ru_p(k,iEdge) = ru_p(k,iEdge) + dts*(tend_ru(k,iEdge) - (1.0_RKIND - specZoneMaskEdge(iEdge))*pgrad)
               end do
 
               ! accumulate ru_p for use later in scalar transport
@@ -2074,6 +2595,7 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart
               end do
 
            end if ! end test for block-owned cells
+
         end do ! end loop over edges
 
       end if ! test for first acoustic step
@@ -2092,9 +2614,6 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart
 
       do iCell=cellSolveStart,cellSolveEnd  ! loop over all owned cells to solve
 
-         ts(:) = 0.0
-         rs(:) = 0.0
-
          if(small_step == 1) then  ! initialize here on first small timestep.
             wwAvg(1:nVertLevels+1,iCell) = 0.0            
             rho_pp(1:nVertLevels,iCell) = 0.0            
@@ -2102,6 +2621,11 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart
             rw_p(:,iCell) = 0.0
          end if
             
+         if(specZoneMaskCell(iCell) == 0.0) then  ! not specified zone, compute...
+
+         ts(:) = 0.0
+         rs(:) = 0.0
+
          do i=1,nEdgesOnCell(iCell) 
             iEdge = edgesOnCell(i,iCell)
             cell1 = cellsOnEdge(1,iEdge)
@@ -2183,6 +2707,17 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart
                                -coftz(k  ,iCell)*rw_p(k  ,iCell))
          end do
 
+         else ! specifed zone in regional_MPAS
+
+            do k=1,nVertLevels
+               rho_pp(k,iCell) = rho_pp(k,iCell) + dts*tend_rho(k,iCell)
+               rtheta_pp(k,iCell) = rtheta_pp(k,iCell) + dts*tend_rt(k,iCell)
+               rw_p(k,iCell) = rw_p(k,iCell) + dts*tend_rw(k,iCell)
+               wwAvg(k,iCell) = wwAvg(k,iCell) + 0.5*(1.0+epssm)*rw_p(k,iCell)
+            end do
+
+         end if
+
       end do !  end of loop over cells
 
    end subroutine atm_advance_acoustic_step_work
@@ -2204,6 +2739,7 @@ subroutine atm_divergence_damping_3d( state, diag, mesh, configs, dts, edgeStart
       real (kind=RKIND), dimension(:,:), pointer :: theta_m, ru_p, rtheta_pp, rtheta_pp_old
 !      real (kind=RKIND), dimension(:), pointer :: dcEdge
       real (kind=RKIND), pointer :: smdiv, config_len_disp
+      real (kind=RKIND), dimension(:), pointer :: specZoneMaskEdge
 
       integer, dimension(:,:), pointer :: cellsOnEdge
       integer, pointer :: nCellsSolve
@@ -2213,6 +2749,7 @@ subroutine atm_divergence_damping_3d( state, diag, mesh, configs, dts, edgeStart
       integer :: cell1, cell2, iEdge, k
 
       call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge)
+      call mpas_pool_get_array(mesh, 'specZoneMaskEdge', specZoneMaskEdge)
 !      call mpas_pool_get_array(mesh, 'dcEdge', dcEdge)
       call mpas_pool_get_array(state, 'theta_m', theta_m, 1)
       call mpas_pool_get_array(diag, 'rtheta_pp', rtheta_pp)
@@ -2248,7 +2785,7 @@ subroutine atm_divergence_damping_3d( state, diag, mesh, configs, dts, edgeStart
 !!  scaled 3d divergence damping
                divCell1 = -(rtheta_pp(k,cell1)-rtheta_pp_old(k,cell1))
                divCell2 = -(rtheta_pp(k,cell2)-rtheta_pp_old(k,cell2))
-               ru_p(k,iEdge) = ru_p(k,iEdge) + coef_divdamp*(divCell2-divCell1) &
+               ru_p(k,iEdge) = ru_p(k,iEdge) + coef_divdamp*(divCell2-divCell1)*(1.0_RKIND - specZoneMaskEdge(iEdge)) &
                                                       /(theta_m(k,cell1)+theta_m(k,cell2))
 
             end do
@@ -2297,6 +2834,7 @@ subroutine atm_recover_large_step_variables( state, diag, tend, mesh, configs, d
       real (kind=RKIND) :: invNs, rcv, p0, flux
       real (kind=RKIND), pointer :: cf1, cf2, cf3
 
+      integer, dimension(:), pointer :: bdyMaskCell  ! MPAS_regional addition
 
       call mpas_pool_get_array(diag, 'wwAvg', wwAvg)
       call mpas_pool_get_array(diag, 'rw_save', rw_save)
@@ -2330,6 +2868,8 @@ subroutine atm_recover_large_step_variables( state, diag, tend, mesh, configs, d
       call mpas_pool_get_array(diag, 'pressure_p', pressure_p)
       call mpas_pool_get_array(diag, 'pressure_base', pressure_b)
 
+      call mpas_pool_get_array(mesh, 'bdyMaskCell', bdyMaskCell)  ! addition for regional_MPAS
+
       call mpas_pool_get_array(mesh, 'zz', zz)
       call mpas_pool_get_array(mesh, 'zb', zb)
       call mpas_pool_get_array(mesh, 'zb3', zb3)
@@ -2359,6 +2899,7 @@ subroutine atm_recover_large_step_variables( state, diag, tend, mesh, configs, d
                              rtheta_base, pressure_p, zz, theta_m, pressure_b, scalars, fzm, fzp, &
                              zb, zb3, zb_cell, zb3_cell, edgesOnCell_sign, cellsOnEdge, edgesOnCell, nEdgesOnCell, &
                              cf1, cf2, cf3, &
+                             bdyMaskCell, &  !  addition for regional_MPAS
                              cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd, &
                              cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd)
 
@@ -2371,6 +2912,7 @@ subroutine atm_recover_large_step_variables_work(nCells, nEdges, nCellsSolve, nE
                              rtheta_base, pressure_p, zz, theta_m, pressure_b, scalars, fzm, fzp, &
                              zb, zb3, zb_cell, zb3_cell, edgesOnCell_sign, cellsOnEdge, edgesOnCell, nEdgesOnCell, &
                              cf1, cf2, cf3, &
+                             bdyMaskCell, &  ! addition for regional_MPAS
                              cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd, &
                              cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd)
 
@@ -2386,6 +2928,8 @@ subroutine atm_recover_large_step_variables_work(nCells, nEdges, nCellsSolve, nE
       integer, intent(in) :: ns, rk_step
       real (kind=RKIND), intent(in) :: dt
 
+      integer, dimension(nCells+1), intent(in) :: bdyMaskCell
+      
       real (kind=RKIND), dimension(nVertLevels+1,nCells+1) :: wwAvg
       real (kind=RKIND), dimension(nVertLevels+1,nCells+1) :: rw_save
       real (kind=RKIND), dimension(nVertLevels+1,nCells+1) :: w
@@ -2522,6 +3066,8 @@ subroutine atm_recover_large_step_variables_work(nCells, nEdges, nCellsSolve, nE
          !  to use the same flux-divergence operator as is used for the horizontal theta transport
          !  (See Klemp et al 2003).
 
+         if (bdyMaskCell(iCell) <= nRelaxZone) then  ! addition for regional_MPAS, no spec zone update
+
          do i=1,nEdgesOnCell(iCell)
             iEdge=edgesOnCell(i,iCell)
 
@@ -2539,11 +3085,15 @@ subroutine atm_recover_large_step_variables_work(nCells, nEdges, nCellsSolve, nE
          end do
 
          w(1,iCell) = w(1,iCell)/(cf1*rho_zz(1,iCell)+cf2*rho_zz(2,iCell)+cf3*rho_zz(3,iCell))
-!DIR$ IVDEP
+
+
+         !DIR$ IVDEP
          do k = 2, nVertLevels
            w(k,iCell) = w(k,iCell)/(fzm(k)*rho_zz(k,iCell)+fzp(k)*rho_zz(k-1,iCell))
          end do
 
+         end if ! addition for regional_MPAS, no spec zone update
+
       end do
 
    end subroutine atm_recover_large_step_variables_work
@@ -2603,6 +3153,8 @@ subroutine atm_advance_scalars( tend, state, diag, mesh, configs, num_scalars, n
       real (kind=RKIND), dimension(:), pointer :: fnm, fnp, rdnw, meshScalingDel2, meshScalingDel4
       real (kind=RKIND), pointer :: coef_3rd_order
 
+      integer, dimension(:), pointer :: bdyMaskCell, bdyMaskEdge    ! regional_MPAS addition
+
       logical :: local_advance_density
 
       if (present(advance_density)) then
@@ -2631,6 +3183,8 @@ subroutine atm_advance_scalars( tend, state, diag, mesh, configs, num_scalars, n
       call mpas_pool_get_array(mesh, 'invAreaCell', invAreaCell)
       call mpas_pool_get_array(tend, 'scalars_tend', scalar_tend_save)
 
+      call mpas_pool_get_array(tend, 'scalars_tend', scalar_tend_save)  ! regional_MPAS addition
+      
       call mpas_pool_get_array(mesh, 'fzm', fnm)
       call mpas_pool_get_array(mesh, 'fzp', fnp)
       call mpas_pool_get_array(mesh, 'rdzw', rdnw)
@@ -2649,45 +3203,30 @@ subroutine atm_advance_scalars( tend, state, diag, mesh, configs, num_scalars, n
       call mpas_pool_get_dimension(mesh, 'nCellsSolve', nCellsSolve)
       call mpas_pool_get_dimension(mesh, 'nEdges', nEdges)
 
+      call mpas_pool_get_array(mesh, 'bdyMaskCell', bdyMaskCell)
+      call mpas_pool_get_array(mesh, 'bdyMaskEdge', bdyMaskEdge)
+
       if (local_advance_density) then
-!      call atm_advance_scalars_work(num_scalars, nCells, nVertLevels, dt, &
-!             cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd, &
-!             cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd, &
-!             coef_3rd_order, scalar_old, scalar_new, rho_zz_old, rho_zz_new, kdiff, &
-!             uhAvg, wwAvg, deriv_two, dvEdge, &
-!             cellsOnEdge, edgesOnCell, nEdgesOnCell, edgesOnCell_sign, invAreaCell, &
-!             scalar_tend_save, fnm, fnp, rdnw, meshScalingDel2, meshScalingDel4, &
-!             nAdvCellsForEdge, advCellsForEdge, adv_coefs, adv_coefs_3rd, rho_edge, qv_init, zgrid, &
-!             nCellsSolve, nEdges, horiz_flux_arr, &
-!             local_advance_density, scalar_tend, rho_zz_int)
-      call atm_advance_scalars_work_new(num_scalars, nCells, nVertLevels, dt, &
+      call atm_advance_scalars_work(num_scalars, nCells, nVertLevels, dt, &
              cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd, &
              cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd, &
              coef_3rd_order, scalar_old, scalar_new, rho_zz_old, rho_zz_new, kdiff, &
              uhAvg, wwAvg, deriv_two, dvEdge, &
              cellsOnEdge, edgesOnCell, nEdgesOnCell, edgesOnCell_sign, invAreaCell, &
              scalar_tend_save, fnm, fnp, rdnw, meshScalingDel2, meshScalingDel4, &
+             bdyMaskCell, bdyMaskEdge, &
              nAdvCellsForEdge, advCellsForEdge, adv_coefs, adv_coefs_3rd, rho_edge, qv_init, zgrid, &
              nCellsSolve, nEdges, horiz_flux_arr, rk_step, config_time_integration_order, &
              local_advance_density, scalar_tend, rho_zz_int)
       else
-!      call atm_advance_scalars_work(num_scalars, nCells, nVertLevels, dt, &
-!             cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd, &
-!             cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd, &
-!             coef_3rd_order, scalar_old, scalar_new, rho_zz_old, rho_zz_new, kdiff, &
-!             uhAvg, wwAvg, deriv_two, dvEdge, &
-!             cellsOnEdge, edgesOnCell, nEdgesOnCell, edgesOnCell_sign, invAreaCell, &
-!             scalar_tend_save, fnm, fnp, rdnw, meshScalingDel2, meshScalingDel4, &
-!             nAdvCellsForEdge, advCellsForEdge, adv_coefs, adv_coefs_3rd, rho_edge, qv_init, zgrid, &
-!             nCellsSolve, nEdges, horiz_flux_arr, &
-!             local_advance_density)
-      call atm_advance_scalars_work_new(num_scalars, nCells, nVertLevels, dt, &
+      call atm_advance_scalars_work(num_scalars, nCells, nVertLevels, dt, &
              cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd, &
              cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd, &
              coef_3rd_order, scalar_old, scalar_new, rho_zz_old, rho_zz_new, kdiff, &
              uhAvg, wwAvg, deriv_two, dvEdge, &
              cellsOnEdge, edgesOnCell, nEdgesOnCell, edgesOnCell_sign, invAreaCell, &
              scalar_tend_save, fnm, fnp, rdnw, meshScalingDel2, meshScalingDel4, &
+             bdyMaskCell, bdyMaskEdge, &
              nAdvCellsForEdge, advCellsForEdge, adv_coefs, adv_coefs_3rd, rho_edge, qv_init, zgrid, &
              nCellsSolve, nEdges, horiz_flux_arr, rk_step, config_time_integration_order, &
              local_advance_density)
@@ -2703,8 +3242,9 @@ subroutine atm_advance_scalars_work( num_scalars_dummy, nCells, nVertLevels_dumm
              uhAvg, wwAvg, deriv_two, dvEdge, &
              cellsOnEdge, edgesOnCell, nEdgesOnCell, edgesOnCell_sign, invAreaCell, &
              scalar_tend_save, fnm, fnp, rdnw, meshScalingDel2, meshScalingDel4, &
+             bdyMaskCell, bdyMaskEdge, &
              nAdvCellsForEdge, advCellsForEdge, adv_coefs, adv_coefs_3rd, rho_edge, qv_init, zgrid, &
-             nCellsSolve, nEdges, horiz_flux_arr, &
+             nCellsSolve, nEdges, horiz_flux_arr, rk_step, config_time_integration_order, &
              advance_density, scalar_tend, rho_zz_int)
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    !
@@ -2742,6 +3282,7 @@ subroutine atm_advance_scalars_work( num_scalars_dummy, nCells, nVertLevels_dumm
       real (kind=RKIND), intent(in) :: dt
       integer, intent(in) :: cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd
       integer, intent(in) :: cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd
+      integer, intent(in) :: rk_step, config_time_integration_order
       logical, intent(in) :: advance_density
       real (kind=RKIND), dimension(:,:,:), intent(in) :: scalar_old
       real (kind=RKIND), dimension(:,:,:), intent(inout) :: scalar_new
@@ -2760,6 +3301,7 @@ subroutine atm_advance_scalars_work( num_scalars_dummy, nCells, nVertLevels_dumm
       real (kind=RKIND), dimension(num_scalars,nVertLevels,nCells+1), intent(inout), optional :: scalar_tend
       real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(inout), optional :: rho_zz_int
       real (kind=RKIND), dimension(:), intent(in) :: invAreaCell
+      integer, dimension(:), intent(in) :: bdyMaskCell, bdyMaskEdge ! regional_MPAS addition
       integer, intent(in) :: nCellsSolve, nEdges
 
       integer :: i, j, iCell, iAdvCell, iEdge, k, iScalar, cell1, cell2
@@ -2777,6 +3319,10 @@ subroutine atm_advance_scalars_work( num_scalars_dummy, nCells, nVertLevels_dumm
 
       logical :: local_advance_density
 
+      real (kind=RKIND) :: weight_time_old, weight_time_new
+      real (kind=RKIND), dimension(num_scalars,nVertLevels) :: scalar_tend_column  ! local storage to accumulate tendency
+      real (kind=RKIND) :: u_direction, u_positive, u_negative
+
       flux4(q_im2, q_im1, q_i, q_ip1, ua) =                     &
           ua*( 7.*(q_i + q_im1) - (q_ip1 + q_im2) )/12.0
 
@@ -2795,8 +3341,23 @@ subroutine atm_advance_scalars_work( num_scalars_dummy, nCells, nVertLevels_dumm
       !  horiz_flux_arr stores the value of the scalar at the edge.
       !  a better name perhaps would be scalarEdge
 
+      !  weights for the time interpolation of the input density
+      !
+      if (.not. advance_density ) then
+         weight_time_new = 1.
+      else
+         if((rk_step == 1) .and. config_time_integration_order == 3) weight_time_new = 1./3
+         if((rk_step == 1) .and. config_time_integration_order == 2) weight_time_new = 1./2
+         if(rk_step == 2) weight_time_new = 1./2
+         if(rk_step == 3) weight_time_new = 1.
+      end if
+      weight_time_old = 1. - weight_time_new
+
+
       do iEdge=edgeStart,edgeEnd
 
+         if( (.not.config_apply_lbcs) .or. (bdyMaskEdge(iEdge) .lt. nRelaxZone-1) )  then  ! full flux calculation
+
          select case(nAdvCellsForEdge(iEdge))
 
          case(10)
@@ -2844,52 +3405,39 @@ subroutine atm_advance_scalars_work( num_scalars_dummy, nCells, nVertLevels_dumm
             end do
 
          end select
-      end do
-
-!$OMP BARRIER
-
-      if (local_advance_density) then
-         if ((.not.present(scalar_tend)) .or. (.not.present(rho_zz_int))) then
-            call mpas_log_write('Error: rho_zz_int or scalar_tend not supplied to atm_advance_scalars( ) when advance_density=.true.', messageType=MPAS_LOG_CRIT)
-         end if
-
-         do iCell=cellSolveStart,cellSolveEnd
-            scalar_tend(:,:,iCell) = scalar_tend_save(:,:,iCell)
-#ifndef DO_PHYSICS
-            scalar_tend(:,:,iCell) = 0.0  !  testing purposes - we have no sources or sinks
-#endif
 
-            rho_zz_int(:,iCell) = 0.0
-
-            do i=1,nEdgesOnCell(iCell)
-               iEdge = edgesOnCell(i,iCell)
-   
-               ! here we add the horizontal flux divergence into the scalar tendency.
-               ! note that the scalar tendency is modified.
+         else if(config_apply_lbcs .and. (bdyMaskEdge(iEdge) .ge. nRelaxZone-1) .and. (bdyMaskEdge(iEdge) .le. nRelaxZone) ) then
+          !  upwind flux evaluation for outermost 2 edges in specified zone
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
 !DIR$ IVDEP
-               do k=1,nVertLevels
-                  rho_zz_int(k,iCell) = rho_zz_int(k,iCell) - edgesOnCell_sign(i,iCell) * uhAvg(k,iEdge)*dvEdge(iEdge) * invAreaCell(iCell)
+            do k=1,nVertLevels
+               u_direction = sign(0.5_RKIND,uhAvg(k,iEdge))
+               u_positive = dvEdge(iEdge)*abs(u_direction + 0.5_RKIND)
+               u_negative = dvEdge(iEdge)*abs(u_direction - 0.5_RKIND)
 !DIR$ IVDEP
-                  do iScalar=1,num_scalars
-                        scalar_tend(iScalar,k,iCell) = scalar_tend(iScalar,k,iCell) &
-                               - edgesOnCell_sign(i,iCell) * uhAvg(k,iEdge)*horiz_flux_arr(iScalar,k,iEdge) * invAreaCell(iCell)
-                  end do
+               do iScalar=1,num_scalars
+                  horiz_flux_arr(iScalar,k,iEdge) = u_positive*scalar_new(iScalar,k,cell1) + u_negative*scalar_new(iScalar,k,cell2)
                end do
-               
             end do
 
-!DIR$ IVDEP
-            do k=1,nVertLevels
-               rho_zz_int(k,iCell) = rho_zz_old(k,iCell) + dt*( rho_zz_int(k,iCell) - rdnw(k)*(wwAvg(k+1,iCell)-wwAvg(k,iCell)) )
-            end do
-         end do
+          end if ! end of regional MPAS test
 
-      else
+      end do
+
+!$OMP BARRIER
+
+!  scalar update, for each column sum fluxes over horizontal edges, add physics tendency, and add vertical flux divergence in update.
+
+      
+      do iCell=cellSolveStart,cellSolveEnd
+
+         if(bdyMaskCell(iCell) <= nRelaxZone) then  ! specified zone for regional_MPAS is not updated in this routine
 
-         do iCell=cellSolveStart,cellSolveEnd
 #ifndef DO_PHYSICS
             scalar_tend_save(:,:,iCell) = 0.0  !  testing purposes - we have no sources or sinks
 #endif
+            scalar_tend_column(1:num_scalars,1:nVertlevels) = 0.
 
             do i=1,nEdgesOnCell(iCell)
                iEdge = edgesOnCell(i,iCell)
@@ -2900,26 +3448,27 @@ subroutine atm_advance_scalars_work( num_scalars_dummy, nCells, nVertLevels_dumm
                do k=1,nVertLevels
 !DIR$ IVDEP
                   do iScalar=1,num_scalars
-                        scalar_tend_save(iScalar,k,iCell) = scalar_tend_save(iScalar,k,iCell) &
-                               - edgesOnCell_sign(i,iCell) * uhAvg(k,iEdge)*horiz_flux_arr(iScalar,k,iEdge) * invAreaCell(iCell)
+                        scalar_tend_column(iScalar,k) = scalar_tend_column(iScalar,k) &
+                               - edgesOnCell_sign(i,iCell) * uhAvg(k,iEdge)*horiz_flux_arr(iScalar,k,iEdge)
                   end do
                end do
                
             end do
-         end do
 
-      end if
+!DIR$ IVDEP
+            do k=1,nVertLevels
+!DIR$ IVDEP
+               do iScalar=1,num_scalars
+                     scalar_tend_column(iScalar,k) = scalar_tend_column(iScalar,k) * invAreaCell(iCell) + scalar_tend_save(iScalar,k,iCell)
+               end do
+            end do
+ 
 
       !
       !  vertical flux divergence and update of the scalars
       !
-
-      ! zero fluxes at top and bottom
-      wdtn(:,1) = 0.0
-      wdtn(:,nVertLevels+1) = 0.0
-
-
-      do iCell=cellSolveStart,cellSolveEnd
+         wdtn(:,1) = 0.0
+         wdtn(:,nVertLevels+1) = 0.0
 
          k = 2
          do iScalar=1,num_scalars
@@ -2940,66 +3489,33 @@ subroutine atm_advance_scalars_work( num_scalars_dummy, nCells, nVertLevels_dumm
             wdtn(iScalar,k) = wwAvg(k,iCell)*(fnm(k)*scalar_new(iScalar,k,iCell)+fnp(k)*scalar_new(iScalar,k-1,iCell))
          end do
 
-      if (local_advance_density) then
-!DIR$ IVDEP
-         do k=1,nVertLevels
-            rho_zz_new_inv = 1.0_RKIND / rho_zz_int(k,iCell)
-!DIR$ IVDEP
-            do iScalar=1,num_scalars
-               scalar_new(iScalar,k,iCell) = (   scalar_old(iScalar,k,iCell)*rho_zz_old(k,iCell) &
-                     + dt*( scalar_tend(iScalar,k,iCell) -rdnw(k)*(wdtn(iScalar,k+1)-wdtn(iScalar,k)) ) ) * rho_zz_new_inv
-            end do
-         end do
-      else
 !DIR$ IVDEP
          do k=1,nVertLevels
-            rho_zz_new_inv = 1.0_RKIND / rho_zz_new(k,iCell)
+            rho_zz_new_inv = 1.0_RKIND / (weight_time_old*rho_zz_old(k,iCell) + weight_time_new*rho_zz_new(k,iCell))
 !DIR$ IVDEP
             do iScalar=1,num_scalars
                scalar_new(iScalar,k,iCell) = (   scalar_old(iScalar,k,iCell)*rho_zz_old(k,iCell) &
-                     + dt*( scalar_tend_save(iScalar,k,iCell) -rdnw(k)*(wdtn(iScalar,k+1)-wdtn(iScalar,k)) ) ) * rho_zz_new_inv
+                     + dt*( scalar_tend_column(iScalar,k) -rdnw(k)*(wdtn(iScalar,k+1)-wdtn(iScalar,k)) ) ) * rho_zz_new_inv
             end do
          end do
-      end if
+
+        end if ! specified zone regional_MPAS test
 
       end do
 
    end subroutine atm_advance_scalars_work
 
 
-   subroutine atm_advance_scalars_work_new( num_scalars_dummy, nCells, nVertLevels_dummy, dt, &
-             cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd, &
-             cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd, &
-             coef_3rd_order, scalar_old, scalar_new, rho_zz_old, rho_zz_new, kdiff, &
-             uhAvg, wwAvg, deriv_two, dvEdge, &
-             cellsOnEdge, edgesOnCell, nEdgesOnCell, edgesOnCell_sign, invAreaCell, &
-             scalar_tend_save, fnm, fnp, rdnw, meshScalingDel2, meshScalingDel4, &
-             nAdvCellsForEdge, advCellsForEdge, adv_coefs, adv_coefs_3rd, rho_edge, qv_init, zgrid, &
-             nCellsSolve, nEdges, horiz_flux_arr, rk_step, config_time_integration_order, &
-             advance_density, scalar_tend, rho_zz_int)
+   subroutine atm_advance_scalars_mono(block, tend, state, diag, mesh, configs, nCells, nEdges, nVertLevels_dummy, dt, &
+                                   cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd, &
+                                   cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd, &
+                                   scalar_old, scalar_new, s_max, s_min, wdtn, scale_arr, flux_arr, &
+                                   flux_upwind_tmp, flux_tmp, advance_density, rho_zz_int)
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    !
-   ! Integrate scalar equations - explicit transport plus other tendencies
-   !
-   !  this transport routine is similar to the original atm_advance_scalars, except it also advances
-   !  (re-integrates) the density.  This re-integration allows the scalar transport routine to use a different 
-   !  timestep than the dry dynamics, and also makes possible a spatial splitting of the scalar transport integration
-   !  (and density integration).  The current integration is, however, not spatially split.
-   !
-   !  WCS 18 November 2014
-   !-----------------------
-   ! Input: s - current model state, 
-   !            including tendencies from sources other than resolved transport.
-   !        grid - grid metadata
-   !
-   ! input scalars in state are uncoupled (i.e. not mulitplied by density)
-   ! 
-   ! Output: updated uncoupled scalars (scalars in state).
-   ! Note: scalar tendencies are also modified by this routine.
-   !
-   ! This routine DOES NOT apply any positive definite or monotonic renormalizations.
+   ! Integrate scalar equations - transport plus other tendencies
    !
-   ! The transport scheme is from Skamarock and Gassmann MWR 2011.
+   !  wrapper routine for atm_advance_scalars_mono_work
    !
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
 
@@ -3007,292 +3523,77 @@ subroutine atm_advance_scalars_work_new( num_scalars_dummy, nCells, nVertLevels_
 
       implicit none
 
-      integer, intent(in) :: num_scalars_dummy ! for allocating stack variables
-      integer, intent(in) :: nCells           ! for allocating stack variables
-      integer, intent(in) :: nVertLevels_dummy ! for allocating stack variables
-      real (kind=RKIND), intent(in) :: dt
+      type (block_type), intent(inout), target :: block
+      type (mpas_pool_type), intent(in)    :: tend
+      type (mpas_pool_type), intent(inout) :: state
+      type (mpas_pool_type), intent(in)    :: diag
+      type (mpas_pool_type), intent(in)    :: mesh
+      type (mpas_pool_type), intent(in)    :: configs
+      integer, intent(in)                  :: nCells           ! for allocating stack variables
+      integer, intent(in)                  :: nEdges           ! for allocating stack variables
+      integer, intent(in)                  :: nVertLevels_dummy      ! for allocating stack variables
+      real (kind=RKIND), intent(in)        :: dt
       integer, intent(in) :: cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd
       integer, intent(in) :: cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd
-      integer, intent(in) :: rk_step, config_time_integration_order
-      logical, intent(in) :: advance_density
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: scalar_old
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: scalar_new
-      real (kind=RKIND), dimension(num_scalars,nVertLevels,nCells+1), intent(inout) :: scalar_tend_save
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: deriv_two
-      real (kind=RKIND), dimension(:,:), intent(in) :: rho_zz_old
-      real (kind=RKIND), dimension(:,:), intent(in) :: uhAvg, wwAvg, rho_edge, zgrid, rho_zz_new, kdiff
-      real (kind=RKIND), dimension(:), intent(in) :: dvEdge, qv_init
-      integer, dimension(:,:), intent(in) :: cellsOnEdge
-      integer, dimension(:,:), intent(in) :: advCellsForEdge, edgesOnCell
-      integer, dimension(:), intent(in) :: nAdvCellsForEdge, nEdgesOnCell
-      real (kind=RKIND), dimension(:,:), intent(in) :: adv_coefs, adv_coefs_3rd, edgesOnCell_sign
-      real (kind=RKIND), dimension(:), intent(in) :: fnm, fnp, rdnw, meshScalingDel2, meshScalingDel4
-      real (kind=RKIND), intent(in) :: coef_3rd_order
-      real (kind=RKIND), dimension(num_scalars,nVertLevels,nEdges+1), intent(inout) :: horiz_flux_arr
-      real (kind=RKIND), dimension(num_scalars,nVertLevels,nCells+1), intent(inout), optional :: scalar_tend
+      real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(inout) :: scalar_old, scalar_new
+      real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(inout) :: s_max, s_min
+      real (kind=RKIND), dimension(nVertLevels+1,nCells+1), intent(inout) :: wdtn
+      real (kind=RKIND), dimension(nVertLevels,2,nCells+1), intent(inout) :: scale_arr
+      real (kind=RKIND), dimension(nVertLevels,nEdges+1), intent(inout) :: flux_arr
+      real (kind=RKIND), dimension(nVertLevels,nEdges+1), intent(inout) :: flux_upwind_tmp, flux_tmp
+      logical, intent(in), optional :: advance_density
       real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(inout), optional :: rho_zz_int
-      real (kind=RKIND), dimension(:), intent(in) :: invAreaCell
-      integer, intent(in) :: nCellsSolve, nEdges
-
-      integer :: i, j, iCell, iAdvCell, iEdge, k, iScalar, cell1, cell2
-      real (kind=RKIND) :: rho_zz_new_inv
 
-      real (kind=RKIND) :: scalar_weight
+      real (kind=RKIND), dimension(:,:,:), pointer :: scalar_tend
+      real (kind=RKIND), dimension(:,:), pointer :: uhAvg, rho_zz_old, rho_zz_new, wwAvg
+      real (kind=RKIND), dimension(:), pointer :: dvEdge, invAreaCell
+      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnCell, edgesOnCell
+      real (kind=RKIND), dimension(:,:), pointer :: edgesOnCell_sign
 
-      real (kind=RKIND), dimension( num_scalars, nVertLevels + 1 ) :: wdtn
+      integer, dimension(:,:), pointer :: advCellsForEdge
+      integer, dimension(:), pointer :: nAdvCellsForEdge
+      real (kind=RKIND), dimension(:,:), pointer :: adv_coefs, adv_coefs_3rd
+      real (kind=RKIND), dimension(:,:,:), pointer :: scalars_old, scalars_new
 
-      real (kind=RKIND), dimension(nVertLevels,10) :: scalar_weight2
-      integer, dimension(10) :: ica
+      integer, dimension(:), pointer :: bdyMaskCell, bdyMaskEdge  ! regional_MPAS addition
 
-      real (kind=RKIND) :: flux3, flux4
-      real (kind=RKIND) :: q_im2, q_im1, q_i, q_ip1, ua, coef3
+      integer, pointer :: nCellsSolve
 
-      logical :: local_advance_density
+      real (kind=RKIND), dimension(:), pointer :: fnm, fnp, rdnw
+      integer, dimension(:), pointer :: nEdgesOnCell
+      real (kind=RKIND), pointer :: coef_3rd_order
 
-      real (kind=RKIND) :: weight_time_old, weight_time_new
-      real (kind=RKIND), dimension(num_scalars,nVertLevels) :: scalar_tend_column  ! local storage to accumulate tendency
+      call mpas_pool_get_config(configs, 'config_coef_3rd_order', coef_3rd_order)
 
-      flux4(q_im2, q_im1, q_i, q_ip1, ua) =                     &
-          ua*( 7.*(q_i + q_im1) - (q_ip1 + q_im2) )/12.0
+      call mpas_pool_get_dimension(mesh, 'nCellsSolve', nCellsSolve)
 
-      flux3(q_im2, q_im1, q_i, q_ip1, ua, coef3) =              &
-                flux4(q_im2, q_im1, q_i, q_ip1, ua) +           &
-                coef3*abs(ua)*((q_ip1 - q_im2)-3.*(q_i-q_im1))/12.0
+      call mpas_pool_get_array(diag, 'ruAvg', uhAvg)
+      call mpas_pool_get_array(diag, 'wwAvg', wwAvg)
 
-      local_advance_density = advance_density
+      call mpas_pool_get_array(tend, 'scalars_tend', scalar_tend)
 
-      !
-      ! Runge Kutta integration, so we compute fluxes from scalar_new values, update starts from scalar_old
-      !
-      !  horizontal flux divergence, accumulate in scalar_tend
+      call mpas_pool_get_array(state, 'rho_zz', rho_zz_old, 1)
+      call mpas_pool_get_array(state, 'rho_zz', rho_zz_new, 2)
+      call mpas_pool_get_array(state, 'scalars', scalars_old, 1)
+      call mpas_pool_get_array(state, 'scalars', scalars_new, 2)
 
+      call mpas_pool_get_array(mesh, 'invAreaCell', invAreaCell)
+      call mpas_pool_get_array(mesh, 'dvEdge', dvEdge)
+      call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge)
+      call mpas_pool_get_array(mesh, 'cellsOnCell', cellsOnCell)
+      call mpas_pool_get_array(mesh, 'edgesOnCell', edgesOnCell)
+      call mpas_pool_get_array(mesh, 'edgesOnCell_sign', edgesOnCell_sign)
+      call mpas_pool_get_array(mesh, 'nEdgesOnCell', nEdgesOnCell)
+      call mpas_pool_get_array(mesh, 'fzm', fnm)
+      call mpas_pool_get_array(mesh, 'fzp', fnp)
+      call mpas_pool_get_array(mesh, 'rdzw', rdnw)
+      call mpas_pool_get_array(mesh, 'nAdvCellsForEdge', nAdvCellsForEdge)
+      call mpas_pool_get_array(mesh, 'advCellsForEdge', advCellsForEdge)
+      call mpas_pool_get_array(mesh, 'adv_coefs', adv_coefs)
+      call mpas_pool_get_array(mesh, 'adv_coefs_3rd', adv_coefs_3rd)
 
-      !  horiz_flux_arr stores the value of the scalar at the edge.
-      !  a better name perhaps would be scalarEdge
-
-      !  weights for the time interpolation of the input density
-      !
-      if (.not. advance_density ) then
-         weight_time_new = 1.
-      else
-         if((rk_step == 1) .and. config_time_integration_order == 3) weight_time_new = 1./3
-         if((rk_step == 1) .and. config_time_integration_order == 2) weight_time_new = 1./2
-         if(rk_step == 2) weight_time_new = 1./2
-         if(rk_step == 3) weight_time_new = 1.
-      end if
-      weight_time_old = 1. - weight_time_new
-
-
-      do iEdge=edgeStart,edgeEnd
-
-         select case(nAdvCellsForEdge(iEdge))
-
-         case(10)
-
-            do j=1,10
-!DIR$ IVDEP
-               do k=1,nVertLevels
-                  scalar_weight2(k,j) = adv_coefs(j,iEdge) + sign(1.0_RKIND,uhAvg(k,iEdge))*adv_coefs_3rd(j,iEdge)
-               end do
-            end do
-            do j=1,10
-               ica(j) = advCellsForEdge(j,iEdge)
-            end do
-!DIR$ IVDEP
-            do k = 1,nVertLevels
-!DIR$ IVDEP
-               do iScalar = 1,num_scalars
-                  horiz_flux_arr(iScalar,k,iEdge) = &
-                       scalar_weight2(k,1)  * scalar_new(iScalar,k,ica(1)) + &
-                       scalar_weight2(k,2)  * scalar_new(iScalar,k,ica(2)) + &
-                       scalar_weight2(k,3)  * scalar_new(iScalar,k,ica(3)) + &
-                       scalar_weight2(k,4)  * scalar_new(iScalar,k,ica(4)) + &
-                       scalar_weight2(k,5)  * scalar_new(iScalar,k,ica(5)) + &
-                       scalar_weight2(k,6)  * scalar_new(iScalar,k,ica(6)) + &
-                       scalar_weight2(k,7)  * scalar_new(iScalar,k,ica(7)) + &
-                       scalar_weight2(k,8)  * scalar_new(iScalar,k,ica(8)) + &
-                       scalar_weight2(k,9)  * scalar_new(iScalar,k,ica(9)) + &
-                       scalar_weight2(k,10) * scalar_new(iScalar,k,ica(10))
-               end do
-            end do
-
-         case default
-
-            horiz_flux_arr(:,:,iEdge) = 0.0
-            do j=1,nAdvCellsForEdge(iEdge)
-               iAdvCell = advCellsForEdge(j,iEdge)
-!DIR$ IVDEP
-               do k=1,nVertLevels
-                  scalar_weight = adv_coefs(j,iEdge) + sign(1.0_RKIND,uhAvg(k,iEdge))*adv_coefs_3rd(j,iEdge)
-!DIR$ IVDEP
-                  do iScalar=1,num_scalars
-                     horiz_flux_arr(iScalar,k,iEdge) = horiz_flux_arr(iScalar,k,iEdge) + scalar_weight * scalar_new(iScalar,k,iAdvCell)
-                  end do
-               end do
-            end do
-
-         end select
-      end do
-
-!$OMP BARRIER
-
-!  scalar update, for each column sum fluxes over horizontal edges, add physics tendency, and add vertical flux divergence in update.
-
-      
-      do iCell=cellSolveStart,cellSolveEnd
-#ifndef DO_PHYSICS
-            scalar_tend_save(:,:,iCell) = 0.0  !  testing purposes - we have no sources or sinks
-#endif
-            scalar_tend_column(1:num_scalars,1:nVertlevels) = 0.
-
-            do i=1,nEdgesOnCell(iCell)
-               iEdge = edgesOnCell(i,iCell)
-
-               ! here we add the horizontal flux divergence into the scalar tendency.
-               ! note that the scalar tendency is modified.
-!DIR$ IVDEP
-               do k=1,nVertLevels
-!DIR$ IVDEP
-                  do iScalar=1,num_scalars
-                        scalar_tend_column(iScalar,k) = scalar_tend_column(iScalar,k) &
-                               - edgesOnCell_sign(i,iCell) * uhAvg(k,iEdge)*horiz_flux_arr(iScalar,k,iEdge)
-                  end do
-               end do
-               
-            end do
-
-!DIR$ IVDEP
-            do k=1,nVertLevels
-!DIR$ IVDEP
-               do iScalar=1,num_scalars
-                     scalar_tend_column(iScalar,k) = scalar_tend_column(iScalar,k) * invAreaCell(iCell) + scalar_tend_save(iScalar,k,iCell)
-               end do
-            end do
- 
-
-      !
-      !  vertical flux divergence and update of the scalars
-      !
-         wdtn(:,1) = 0.0
-         wdtn(:,nVertLevels+1) = 0.0
-
-         k = 2
-         do iScalar=1,num_scalars
-            wdtn(iScalar,k) = wwAvg(k,iCell)*(fnm(k)*scalar_new(iScalar,k,iCell)+fnp(k)*scalar_new(iScalar,k-1,iCell))
-         end do
-          
-!DIR$ IVDEP
-         do k=3,nVertLevels-1
-!DIR$ IVDEP
-            do iScalar=1,num_scalars
-               wdtn(iScalar,k) = flux3( scalar_new(iScalar,k-2,iCell),scalar_new(iScalar,k-1,iCell),  &
-                                        scalar_new(iScalar,k  ,iCell),scalar_new(iScalar,k+1,iCell),  &
-                                        wwAvg(k,iCell), coef_3rd_order )
-            end do
-         end do
-         k = nVertLevels
-         do iScalar=1,num_scalars
-            wdtn(iScalar,k) = wwAvg(k,iCell)*(fnm(k)*scalar_new(iScalar,k,iCell)+fnp(k)*scalar_new(iScalar,k-1,iCell))
-         end do
-
-!DIR$ IVDEP
-         do k=1,nVertLevels
-            rho_zz_new_inv = 1.0_RKIND / (weight_time_old*rho_zz_old(k,iCell) + weight_time_new*rho_zz_new(k,iCell))
-!DIR$ IVDEP
-            do iScalar=1,num_scalars
-               scalar_new(iScalar,k,iCell) = (   scalar_old(iScalar,k,iCell)*rho_zz_old(k,iCell) &
-                     + dt*( scalar_tend_column(iScalar,k) -rdnw(k)*(wdtn(iScalar,k+1)-wdtn(iScalar,k)) ) ) * rho_zz_new_inv
-            end do
-         end do
-
-      end do
-
-   end subroutine atm_advance_scalars_work_new
-
-
-   subroutine atm_advance_scalars_mono(block, tend, state, diag, mesh, configs, nCells, nEdges, nVertLevels_dummy, dt, &
-                                   cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd, &
-                                   cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd, &
-                                   scalar_old, scalar_new, s_max, s_min, wdtn, scale_arr, flux_arr, &
-                                   flux_upwind_tmp, flux_tmp, advance_density, rho_zz_int)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   !
-   ! Integrate scalar equations - transport plus other tendencies
-   !
-   !  wrapper routine for atm_advance_scalars_mono_work
-   !
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      use mpas_atm_dimensions
-
-      implicit none
-
-      type (block_type), intent(inout), target :: block
-      type (mpas_pool_type), intent(in)    :: tend
-      type (mpas_pool_type), intent(inout) :: state
-      type (mpas_pool_type), intent(in)    :: diag
-      type (mpas_pool_type), intent(in)    :: mesh
-      type (mpas_pool_type), intent(in)    :: configs
-      integer, intent(in)                  :: nCells           ! for allocating stack variables
-      integer, intent(in)                  :: nEdges           ! for allocating stack variables
-      integer, intent(in)                  :: nVertLevels_dummy      ! for allocating stack variables
-      real (kind=RKIND), intent(in)        :: dt
-      integer, intent(in) :: cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd
-      integer, intent(in) :: cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd
-      real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(inout) :: scalar_old, scalar_new
-      real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(inout) :: s_max, s_min
-      real (kind=RKIND), dimension(nVertLevels+1,nCells+1), intent(inout) :: wdtn
-      real (kind=RKIND), dimension(nVertLevels,2,nCells+1), intent(inout) :: scale_arr
-      real (kind=RKIND), dimension(nVertLevels,nEdges+1), intent(inout) :: flux_arr
-      real (kind=RKIND), dimension(nVertLevels,nEdges+1), intent(inout) :: flux_upwind_tmp, flux_tmp
-      logical, intent(in), optional :: advance_density
-      real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(inout), optional :: rho_zz_int
-
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalar_tend
-      real (kind=RKIND), dimension(:,:), pointer :: uhAvg, rho_zz_old, rho_zz_new, wwAvg
-      real (kind=RKIND), dimension(:), pointer :: dvEdge, invAreaCell
-      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnCell, edgesOnCell
-      real (kind=RKIND), dimension(:,:), pointer :: edgesOnCell_sign
-
-      integer, dimension(:,:), pointer :: advCellsForEdge
-      integer, dimension(:), pointer :: nAdvCellsForEdge
-      real (kind=RKIND), dimension(:,:), pointer :: adv_coefs, adv_coefs_3rd
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalars_old, scalars_new
-
-      integer, pointer :: nCellsSolve
-
-      real (kind=RKIND), dimension(:), pointer :: fnm, fnp, rdnw
-      integer, dimension(:), pointer :: nEdgesOnCell
-      real (kind=RKIND), pointer :: coef_3rd_order
-
-      call mpas_pool_get_config(configs, 'config_coef_3rd_order', coef_3rd_order)
-
-      call mpas_pool_get_dimension(mesh, 'nCellsSolve', nCellsSolve)
-
-      call mpas_pool_get_array(diag, 'ruAvg', uhAvg)
-      call mpas_pool_get_array(diag, 'wwAvg', wwAvg)
-
-      call mpas_pool_get_array(tend, 'scalars_tend', scalar_tend)
-
-      call mpas_pool_get_array(state, 'rho_zz', rho_zz_old, 1)
-      call mpas_pool_get_array(state, 'rho_zz', rho_zz_new, 2)
-      call mpas_pool_get_array(state, 'scalars', scalars_old, 1)
-      call mpas_pool_get_array(state, 'scalars', scalars_new, 2)
-
-      call mpas_pool_get_array(mesh, 'invAreaCell', invAreaCell)
-      call mpas_pool_get_array(mesh, 'dvEdge', dvEdge)
-      call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge)
-      call mpas_pool_get_array(mesh, 'cellsOnCell', cellsOnCell)
-      call mpas_pool_get_array(mesh, 'edgesOnCell', edgesOnCell)
-      call mpas_pool_get_array(mesh, 'edgesOnCell_sign', edgesOnCell_sign)
-      call mpas_pool_get_array(mesh, 'nEdgesOnCell', nEdgesOnCell)
-      call mpas_pool_get_array(mesh, 'fzm', fnm)
-      call mpas_pool_get_array(mesh, 'fzp', fnp)
-      call mpas_pool_get_array(mesh, 'rdzw', rdnw)
-      call mpas_pool_get_array(mesh, 'nAdvCellsForEdge', nAdvCellsForEdge)
-      call mpas_pool_get_array(mesh, 'advCellsForEdge', advCellsForEdge)
-      call mpas_pool_get_array(mesh, 'adv_coefs', adv_coefs)
-      call mpas_pool_get_array(mesh, 'adv_coefs_3rd', adv_coefs_3rd)
+      call mpas_pool_get_array(mesh, 'bdyMaskCell', bdyMaskCell)  ! MPAS_regional addition
+      call mpas_pool_get_array(mesh, 'bdyMaskEdge', bdyMaskEdge)  ! MPAS_regional addition
 
       call atm_advance_scalars_mono_work(block, state, nCells, nEdges, nVertLevels, dt, &
                                    cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd, &
@@ -3302,6 +3603,7 @@ subroutine atm_advance_scalars_mono(block, tend, state, diag, mesh, configs, nCe
                                    edgesOnCell, edgesOnCell_sign, nEdgesOnCell, fnm, fnp, rdnw, nAdvCellsForEdge, &
                                    advCellsForEdge, adv_coefs, adv_coefs_3rd, scalar_old, scalar_new, s_max, s_min, &
                                    wdtn, scale_arr, flux_arr, flux_upwind_tmp, flux_tmp, &
+                                   bdyMaskCell, bdyMaskEdge, &
                                    advance_density, rho_zz_int)
 
    end subroutine atm_advance_scalars_mono
@@ -3315,6 +3617,7 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, nVertLeve
                                    edgesOnCell, edgesOnCell_sign, nEdgesOnCell, fnm, fnp, rdnw, nAdvCellsForEdge, &
                                    advCellsForEdge, adv_coefs, adv_coefs_3rd, scalar_old, scalar_new, s_max, s_min, &
                                    wdtn, scale_arr, flux_arr, flux_upwind_tmp, flux_tmp, &
+                                   bdyMaskCell, bdyMaskEdge, &
                                    advance_density, rho_zz_int)
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    !
@@ -3373,6 +3676,7 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, nVertLeve
       real (kind=RKIND), dimension(nVertLevels+1,nCells+1), intent(in) :: wwAvg
       real (kind=RKIND), dimension(:), intent(in) :: dvEdge, invAreaCell
       integer, dimension(:,:), intent(in) :: cellsOnEdge, cellsOnCell, edgesOnCell
+      integer, dimension(:) :: bdyMaskCell, bdyMaskEdge
       real (kind=RKIND), dimension(:,:), intent(in) :: edgesOnCell_sign
 
       integer, dimension(:,:), intent(in) :: advCellsForEdge
@@ -3454,6 +3758,7 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, nVertLeve
 !$OMP END MASTER
 !$OMP BARRIER
 
+
       !
       ! Runge Kutta integration, so we compute fluxes from scalar_new values, update starts from scalar_old
       !
@@ -3500,6 +3805,13 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, nVertLeve
             end do
          end do
 
+! ***** TEMPORARY TEST ******* WCS 20161012
+            do k=1,nVertLevels
+               scalar_old(k,nCells+1) = 0.
+               scalar_new(k,nCells+1) = 0.
+            end do
+
+
 !$OMP BARRIER
 
 #ifdef DEBUG_TRANSPORT
@@ -3701,6 +4013,12 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, nVertLeve
                       (max(0.0_RKIND,uhAvg(k,iEdge))*scalar_old(k,cell1) + min(0.0_RKIND,uhAvg(k,iEdge))*scalar_old(k,cell2))
                flux_tmp(k,iEdge) = dt * flux_arr(k,iEdge) - flux_upwind_tmp(k,iEdge)
             end do
+
+            if( config_apply_lbcs .and. (bdyMaskEdge(iEdge) == nRelaxZone) .or. (bdyMaskEdge(iEdge) == nRelaxZone-1) ) then
+               flux_tmp(:,iEdge) = 0.
+               flux_arr(:,iEdge) = flux_upwind_tmp(:,iEdge)
+            end if
+
          end do
 !$OMP BARRIER
          do iCell=cellSolveStart,cellSolveEnd
@@ -3791,6 +4109,11 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, nVertLeve
                          (max(0.0_RKIND,uhAvg(k,iEdge))*scalar_old(k,cell1) + min(0.0_RKIND,uhAvg(k,iEdge))*scalar_old(k,cell2))
                   flux_arr(k,iEdge) = dt*flux_arr(k,iEdge) - flux_upwind
                end do
+
+               if( config_apply_lbcs .and. (bdyMaskEdge(iEdge) == nRelaxZone) .or. (bdyMaskEdge(iEdge) == nRelaxZone-1) ) then
+                  flux_arr(:,iEdge) = 0.
+               end if
+
             end if
          end do
 
@@ -3879,9 +4202,11 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, nVertLeve
 !$OMP BARRIER
 
          do iCell=cellStart,cellEnd
-            do k=1, nVertLevels
-               scalars_new(iScalar,k,iCell) = max(0.0_RKIND,scalar_new(k,iCell))
-            end do
+            if(bdyMaskCell(iCell) <= nSpecZone) then ! regional_MPAS does spec zone update after transport.
+               do k=1, nVertLevels
+                  scalars_new(iScalar,k,iCell) = max(0.0_RKIND,scalar_new(k,iCell))
+               end do
+            end if
          end do
 
       end do !  loop over scalars
@@ -3952,7 +4277,7 @@ subroutine atm_compute_dyn_tend(tend, tend_physics, state, diag, mesh, configs,
       real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
       integer, dimension(:,:), pointer :: cellsOnEdge, verticesOnEdge, edgesOnCell, edgesOnEdge, cellsOnCell, edgesOnVertex
       integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
-      real (kind=RKIND), dimension(:), pointer :: latCell, latEdge, angleEdge, u_init
+      real (kind=RKIND), dimension(:), pointer :: latCell, latEdge, angleEdge, u_init, v_init
 
       integer, dimension(:,:), pointer :: advCellsForEdge
       integer, dimension(:), pointer :: nAdvCellsForEdge
@@ -3981,6 +4306,11 @@ subroutine atm_compute_dyn_tend(tend, tend_physics, state, diag, mesh, configs,
       real (kind=RKIND), pointer :: config_h_mom_eddy_visc2, config_v_mom_eddy_visc2
       real (kind=RKIND), pointer :: config_h_theta_eddy_visc2, config_v_theta_eddy_visc2
 
+      real (kind=RKIND), pointer :: config_mpas_cam_coef
+      logical, pointer :: config_rayleigh_damp_u
+      real (kind=RKIND), pointer :: config_rayleigh_damp_u_timescale_days
+      integer, pointer :: config_number_rayleigh_damp_u_levels
+
       logical :: inactive_rthdynten
 
 
@@ -3998,6 +4328,10 @@ subroutine atm_compute_dyn_tend(tend, tend_physics, state, diag, mesh, configs,
       call mpas_pool_get_config(configs, 'config_visc4_2dsmag', config_visc4_2dsmag)
       call mpas_pool_get_config(configs, 'config_len_disp', config_len_disp)
       call mpas_pool_get_config(configs, 'config_smagorinsky_coef', c_s)
+      call mpas_pool_get_config(configs, 'config_mpas_cam_coef', config_mpas_cam_coef)
+      call mpas_pool_get_config(configs, 'config_rayleigh_damp_u', config_rayleigh_damp_u)
+      call mpas_pool_get_config(configs, 'config_rayleigh_damp_u_timescale_days', config_rayleigh_damp_u_timescale_days)
+      call mpas_pool_get_config(configs, 'config_number_rayleigh_damp_u_levels', config_number_rayleigh_damp_u_levels)
 
       call mpas_pool_get_array(state, 'rho_zz', rho_zz, 2)
       call mpas_pool_get_array(state, 'u', u, 2)
@@ -4058,6 +4392,7 @@ subroutine atm_compute_dyn_tend(tend, tend_physics, state, diag, mesh, configs,
       call mpas_pool_get_array(mesh, 'meshScalingDel2', meshScalingDel2)
       call mpas_pool_get_array(mesh, 'meshScalingDel4', meshScalingDel4)
       call mpas_pool_get_array(mesh, 'u_init', u_init)
+      call mpas_pool_get_array(mesh, 'v_init', v_init)
       call mpas_pool_get_array(mesh, 't_init', t_init)
       call mpas_pool_get_array(mesh, 'qv_init', qv_init)
 
@@ -4125,11 +4460,13 @@ subroutine atm_compute_dyn_tend(tend, tend_physics, state, diag, mesh, configs,
          h_divergence, kdiff, edgesOnCell_sign, edgesOnVertex_sign, rw_save, ru_save, &
          theta_m_save, exner, rr_save, scalars, tend_u_euler, tend_w_euler, tend_theta_euler, deriv_two, &
          cellsOnEdge, verticesOnEdge, edgesOnCell, edgesOnEdge, cellsOnCell, edgesOnVertex, nEdgesOnCell, nEdgesOnEdge, &
-         latCell, latEdge, angleEdge, u_init, advCellsForEdge, nAdvCellsForEdge, adv_coefs, adv_coefs_3rd, &
+         latCell, latEdge, angleEdge, u_init, v_init, advCellsForEdge, nAdvCellsForEdge, adv_coefs, adv_coefs_3rd, &
          rdzu, rdzw, fzm, fzp, qv_init, t_init, cf1, cf2, cf3, r_earth, ur_cell, vr_cell, defc_a, defc_b, &
          tend_w_pgf, tend_w_buoy, coef_3rd_order, c_s, config_mix_full, config_horiz_mixing, config_del4u_div_factor, &
          config_h_mom_eddy_visc2, config_v_mom_eddy_visc2, config_h_theta_eddy_visc2, config_v_theta_eddy_visc2, &
          config_h_theta_eddy_visc4, config_h_mom_eddy_visc4, config_visc4_2dsmag, config_len_disp, rk_step, dt, &
+         config_mpas_cam_coef, &
+         config_rayleigh_damp_u, config_rayleigh_damp_u_timescale_days, config_number_rayleigh_damp_u_levels, &
          tend_rtheta_adv, rthdynten, &
          cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd, &
          cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd)
@@ -4150,11 +4487,13 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm
       h_divergence, kdiff, edgesOnCell_sign, edgesOnVertex_sign, rw_save, ru_save, &
       theta_m_save, exner, rr_save, scalars, tend_u_euler, tend_w_euler, tend_theta_euler, deriv_two, &
       cellsOnEdge, verticesOnEdge, edgesOnCell, edgesOnEdge, cellsOnCell, edgesOnVertex, nEdgesOnCell, nEdgesOnEdge, &
-      latCell, latEdge, angleEdge, u_init, advCellsForEdge, nAdvCellsForEdge, adv_coefs, adv_coefs_3rd, &
+      latCell, latEdge, angleEdge, u_init, v_init, advCellsForEdge, nAdvCellsForEdge, adv_coefs, adv_coefs_3rd, &
       rdzu, rdzw, fzm, fzp, qv_init, t_init, cf1, cf2, cf3, r_earth, ur_cell, vr_cell, defc_a, defc_b, &
       tend_w_pgf, tend_w_buoy, coef_3rd_order, c_s, config_mix_full, config_horiz_mixing, config_del4u_div_factor, &
       config_h_mom_eddy_visc2, config_v_mom_eddy_visc2, config_h_theta_eddy_visc2, config_v_theta_eddy_visc2, &
       config_h_theta_eddy_visc4, config_h_mom_eddy_visc4, config_visc4_2dsmag, config_len_disp, rk_step, dt, &
+      config_mpas_cam_coef, &
+      config_rayleigh_damp_u, config_rayleigh_damp_u_timescale_days, config_number_rayleigh_damp_u_levels, &
       tend_rtheta_adv, rthdynten, &
       cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd, &
       cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd)
@@ -4234,7 +4573,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm
       real (kind=RKIND), dimension(nCells+1) :: latCell
       real (kind=RKIND), dimension(nEdges+1) :: latEdge
       real (kind=RKIND), dimension(nEdges+1) :: angleEdge
-      real (kind=RKIND), dimension(nVertLevels) :: u_init
+      real (kind=RKIND), dimension(nVertLevels) :: u_init, v_init
 
       integer, dimension(15,nEdges+1) :: advCellsForEdge
       integer, dimension(nEdges+1) :: nAdvCellsForEdge
@@ -4274,6 +4613,12 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm
       integer, intent(in) :: rk_step
       real (kind=RKIND), intent(in) :: dt
 
+      real (kind=RKIND) :: config_mpas_cam_coef
+
+      logical, intent(in) :: config_rayleigh_damp_u
+      real (kind=RKIND), intent(in) :: config_rayleigh_damp_u_timescale_days
+      integer, intent(in) :: config_number_rayleigh_damp_u_levels
+
       real (kind=RKIND), dimension(nVertLevels,nCells+1) :: tend_rtheta_adv
       real (kind=RKIND), dimension(nVertLevels,nCells+1) :: rthdynten
 
@@ -4300,9 +4645,9 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm
       real (kind=RKIND) :: h_theta_eddy_visc4, v_theta_eddy_visc2
       real (kind=RKIND) :: u_diffusion
 
-      real (kind=RKIND) :: kdiffu, z1, z2, z3, z4, zm, z0, zp
+      real (kind=RKIND) :: kdiffu, z1, z2, z3, z4, zm, z0, zp, rayleigh_coef_inverse
 
-      
+      real (kind=RKIND), dimension( nVertLevels ) :: rayleigh_damp_coef
 
       real (kind=RKIND) :: flux3, flux4
       real (kind=RKIND) :: q_im2, q_im1, q_i, q_ip1, ua, coef3
@@ -4359,6 +4704,20 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm
             h_theta_eddy_visc4 = config_h_theta_eddy_visc4
 
          end if
+
+         if (config_mpas_cam_coef > 0.0) then
+
+            do iCell = cellStart,cellEnd
+               !
+               ! 2nd-order filter for top absorbing layer as in CAM-SE :  WCS 10 May 2017
+               ! From MPAS-CAM V4.0 code, with addition to config-specified coefficient (V4.0_coef = 0.2; SE_coef = 1.0)
+               !
+               kdiff(nVertLevels-2,iCell) = max(kdiff(nVertLevels-2,iCell),    2.0833*config_len_disp*config_mpas_cam_coef)
+               kdiff(nVertLevels-1,iCell) = max(kdiff(nVertLevels-1,iCell),2.0*2.0833*config_len_disp*config_mpas_cam_coef)
+               kdiff(nVertLevels  ,iCell) = max(kdiff(nVertLevels  ,iCell),4.0*2.0833*config_len_disp*config_mpas_cam_coef)
+            end do
+
+         end if
             
       end if
 
@@ -4550,6 +4909,9 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm
                end do
             end do
 
+
+
+         
 !$OMP BARRIER
 
             do iEdge=edgeSolveStart,edgeSolveEnd
@@ -4618,11 +4980,8 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm
                   cell2 = cellsOnEdge(2,iEdge)
 
                   do k=1,nVertLevels
-#ifdef ROTATED_GRID
-                     u_mix(k) = u(k,iEdge) - u_init(k) * sin( angleEdge(iEdge) )
-#else
-                     u_mix(k) = u(k,iEdge) - u_init(k) * cos( angleEdge(iEdge) )
-#endif
+                     u_mix(k) = u(k,iEdge) - u_init(k) * cos( angleEdge(iEdge) ) &
+                                           - v_init(k) * sin( angleEdge(iEdge) )
                   end do
 
                   do k=2,nVertLevels-1
@@ -4650,9 +5009,25 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm
 
 !$OMP BARRIER
 
-!  add in mixing for u
+!  add in mixing and physics tendency for u
 
-      do iEdge=edgeSolveStart,edgeSolveEnd
+!  Rayleigh damping on u
+      if (config_rayleigh_damp_u) then
+         rayleigh_coef_inverse = 1.0 / ( real(config_number_rayleigh_damp_u_levels) &
+                                         * (config_rayleigh_damp_u_timescale_days*seconds_per_day) )
+         do k=nVertLevels-config_number_rayleigh_damp_u_levels+1,nVertLevels
+            rayleigh_damp_coef(k) = real(k - (nVertLevels-config_number_rayleigh_damp_u_levels))*rayleigh_coef_inverse
+         end do
+
+         do iEdge=edgeSolveStart,edgeSolveEnd
+!DIR$ IVDEP
+            do k=nVertlevels-config_number_rayleigh_damp_u_levels+1,nVertLevels
+               tend_u(k,iEdge) = tend_u(k,iEdge) - rho_edge(k,iEdge)*u(k,iEdge)*rayleigh_damp_coef(k)
+            end do
+         end do
+      end if
+
+      do iEdge=edgeSolveStart,edgeSolveEnd
 !DIR$ IVDEP
          do k=1,nVertLevels
 !            tend_u(k,iEdge) = tend_u(k,iEdge) + tend_u_euler(k,iEdge)
@@ -5706,6 +6081,597 @@ subroutine atm_rk_dynamics_substep_finish( state, diag, dynamics_substep, dynami
    end subroutine atm_rk_dynamics_substep_finish
 
 
+!-------------------------------------------------------------------------
+!
+! these next 2 routines set an approximate zero gradient boundary condition for w for regional_MPAS
+!   
+   subroutine atm_zero_gradient_w_bdy( state, mesh, cellSolveStart, cellSolveEnd )
+
+      ! reconstitute state variables from acoustic-step perturbation variables 
+      ! after the acoustic steps.  The perturbation variables were originally set in
+      ! subroutine atm_set_smlstep_pert_variables prior to their acoustic-steps update.
+      ! we are also computing a few other state-derived variables here.
+
+      implicit none
+
+      type (mpas_pool_type), intent(inout) :: state
+      type (mpas_pool_type), intent(inout) :: mesh
+      integer, intent(in) :: cellSolveStart, cellSolveEnd
+
+      real (kind=RKIND), dimension(:,:), pointer :: w
+
+      integer, dimension(:), pointer :: bdyMaskCell, nearestRelaxationCell
+      integer, pointer :: nCells
+
+      call mpas_pool_get_array(state, 'w', w, 2)
+      call mpas_pool_get_array(mesh, 'bdyMaskCell', bdyMaskCell)
+      call mpas_pool_get_array(mesh, 'nearestRelaxationCell', nearestRelaxationCell)
+      call mpas_pool_get_dimension(mesh, 'nCells', nCells)
+      
+      call atm_zero_gradient_w_bdy_work( w, bdyMaskCell, nearestRelaxationCell, nCells, cellSolveStart, cellSolveEnd )
+
+   end subroutine atm_zero_gradient_w_bdy
+
+!-------------------------------------------------------------------------
+
+   subroutine atm_zero_gradient_w_bdy_work( w, bdyMaskCell, nearestRelaxationCell, nCells, cellSolveStart, cellSolveEnd )
+
+      use mpas_atm_dimensions
+
+      implicit none
+
+      !
+      ! Dummy arguments
+      !
+      integer, intent(in) :: cellSolveStart, cellSolveEnd, nCells
+      integer, dimension(nCells+1), intent(in) :: bdyMaskCell, nearestRelaxationCell
+      real (kind=RKIND), dimension(nVertLevels+1,nCells+1), intent(inout) :: w
+
+      ! local variables
+
+      integer :: iCell, k
+
+      do iCell=cellSolveStart,cellSolveEnd
+         if (bdyMaskCell(iCell) > nRelaxZone) then
+!DIR$ IVDEP
+            do k = 2, nVertLevels
+              w(k,iCell) = w(k,nearestRelaxationCell(iCell))
+            end do
+         end if  
+      end do
+
+   end subroutine atm_zero_gradient_w_bdy_work
+
+!-------------------------------------------------------------------------
+
+   subroutine atm_bdy_adjust_dynamics_speczone_tend( tend, mesh, config, nVertLevels,               &
+                                                     ru_driving_tend, rt_driving_tend, rho_driving_tend,         &
+                                                     cellStart, cellEnd, edgeStart, edgeEnd,                     &
+                                                     cellSolveStart, cellSolveEnd, edgeSolveStart, edgeSolveEnd )
+
+      implicit none
+
+      !  this routine resets the dry dynamics variables at the end of an rk3 substep for the case
+      !  where the dry dynamics is split from the scalar transport (i.e. where the dry dynamics is
+      !  using a different, usually smaller, timestep.
+      !
+      !  WCS Fall 2016
+
+      type (mpas_pool_type), intent(inout) :: tend
+      type (mpas_pool_type), intent(in) :: mesh
+      type (mpas_pool_type), intent(in) :: config
+      integer, intent(in) :: nVertLevels
+      integer, intent(in) :: cellStart, cellEnd, edgeStart, edgeEnd
+      integer, intent(in) :: cellSolveStart, cellSolveEnd, edgeSolveStart, edgeSolveEnd
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: ru_driving_tend, rt_driving_tend, rho_driving_tend
+      real (kind=RKIND), dimension(:,:), pointer :: tend_ru, tend_rt, tend_rho, tend_rw, rt_diabatic_tend
+      integer, dimension(:), pointer :: bdyMaskCell, bdyMaskEdge
+
+      integer :: iCell, iEdge, k
+
+      call mpas_pool_get_array(tend, 'u', tend_ru)
+      call mpas_pool_get_array(tend, 'rho_zz', tend_rho)
+      call mpas_pool_get_array(tend, 'theta_m', tend_rt)
+      call mpas_pool_get_array(tend, 'w', tend_rw)
+      call mpas_pool_get_array(mesh, 'bdyMaskCell', bdyMaskCell)
+      call mpas_pool_get_array(mesh, 'bdyMaskEdge', bdyMaskEdge)
+      call mpas_pool_get_array(tend, 'rt_diabatic_tend', rt_diabatic_tend)
+      
+      do iCell = cellSolveStart, cellSolveEnd
+         if(bdyMaskCell(iCell) > nRelaxZone) then
+            do k=1, nVertLevels
+               tend_rho(k,iCell) = rho_driving_tend(k,iCell)
+               tend_rt(k,iCell) = rt_driving_tend(k,iCell)
+               tend_rw(k,iCell) = 0.
+               rt_diabatic_tend(k,iCell) = 0.
+            end do
+         end if
+      end do
+
+      do iEdge = edgeSolveStart, edgeSolveEnd
+         if(bdyMaskEdge(iEdge) > nRelaxZone) then
+            do k=1, nVertLevels
+               tend_ru(k,iEdge) = ru_driving_tend(k,iEdge)
+            end do
+         end if
+      end do
+      
+    end subroutine atm_bdy_adjust_dynamics_speczone_tend
+
+!-------------------------------------------------------------------------
+
+   subroutine atm_bdy_adjust_dynamics_relaxzone_tend( tend, state, diag, mesh, nVertLevels, dt,                                             &
+                                                      ru_driving_values, rt_driving_values, rho_driving_values,                                     &
+                                                      cellStart, cellEnd, edgeStart, edgeEnd,                               &
+                                                      cellSolveStart, cellSolveEnd, edgeSolveStart, edgeSolveEnd )
+
+      implicit none
+
+      !  this routine resets the dry dynamics variables at the end of an rk3 substep for the case
+      !  where the dry dynamics is split from the scalar transport (i.e. where the dry dynamics is
+      !  using a different, usually smaller, timestep.
+      !
+      !  WCS Fall 2016
+
+      type (mpas_pool_type), intent(in) :: state
+      type (mpas_pool_type), intent(inout) :: tend
+      type (mpas_pool_type), intent(in) :: diag
+      type (mpas_pool_type), intent(in) :: mesh
+      integer, intent(in) :: nVertLevels
+      integer, intent(in) :: cellStart, cellEnd, edgeStart, edgeEnd
+      integer, intent(in) :: cellSolveStart, cellSolveEnd, edgeSolveStart, edgeSolveEnd
+
+      real (kind=RKIND), intent(in) :: dt
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: ru_driving_values, rt_driving_values, rho_driving_values
+
+      real (kind=RKIND), dimension(:,:), pointer :: tend_ru, tend_rt, tend_rho, tend_rw, ru, theta_m, rho_zz
+      real (kind=RKIND), dimension(:), pointer :: dcEdge, dvEdge, invDcEdge, invDvEdge, invAreaCell, invAreaTriangle
+      real (kind=RKIND), dimension(:,:), pointer :: edgesOnCell_sign, edgesOnVertex_sign
+      integer, dimension(:), pointer :: bdyMaskCell, bdyMaskEdge, nEdgesOnCell
+      integer, dimension(:,:), pointer :: cellsOnEdge, verticesOnEdge, edgesOnCell, edgesOnVertex
+      integer, pointer :: vertexDegree
+      
+
+      real (kind=RKIND) :: edge_sign, laplacian_filter_coef, rayleigh_damping_coef, r_dc, r_dv, invArea
+      real (kind=RKIND), dimension(nVertLevels) :: divergence1, divergence2, vorticity1, vorticity2      
+      integer :: iCell, iEdge, i, k, cell1, cell2, iEdge_vort, iEdge_div
+      integer :: vertex1, vertex2, iVertex
+
+      real (kind=RKIND), dimension(:), pointer :: meshScalingRegionalCell, meshScalingRegionalEdge
+
+      call mpas_pool_get_array(tend, 'u', tend_ru)
+      call mpas_pool_get_array(tend, 'rho_zz', tend_rho)
+      call mpas_pool_get_array(tend, 'theta_m', tend_rt)
+      call mpas_pool_get_array(tend, 'w', tend_rw)
+      call mpas_pool_get_array(mesh, 'bdyMaskCell', bdyMaskCell)
+      call mpas_pool_get_array(mesh, 'bdyMaskEdge', bdyMaskEdge)
+
+      call mpas_pool_get_array(mesh, 'meshScalingRegionalCell', meshScalingRegionalCell)
+      call mpas_pool_get_array(mesh, 'meshScalingRegionalEdge', meshScalingRegionalEdge)
+
+      call mpas_pool_get_array(diag, 'ru', ru)
+      call mpas_pool_get_array(state, 'theta_m', theta_m, 2)
+      call mpas_pool_get_array(state, 'rho_zz', rho_zz, 2)
+
+      call mpas_pool_get_dimension(mesh, 'vertexDegree', vertexDegree)
+      call mpas_pool_get_array(mesh, 'dcEdge', dcEdge)
+      call mpas_pool_get_array(mesh, 'dvEdge', dvEdge)
+      call mpas_pool_get_array(mesh, 'invDcEdge', invDcEdge)
+      call mpas_pool_get_array(mesh, 'invDvEdge', invDvEdge)
+      call mpas_pool_get_array(mesh, 'invAreaCell', invAreaCell)
+      call mpas_pool_get_array(mesh, 'invAreaTriangle', invAreaTriangle)
+      call mpas_pool_get_array(mesh, 'edgesOnCell_sign', edgesOnCell_sign)
+      call mpas_pool_get_array(mesh, 'edgesOnVertex_sign', edgesOnVertex_sign)
+      call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge)
+      call mpas_pool_get_array(mesh, 'edgesOnCell', edgesOnCell)
+      call mpas_pool_get_array(mesh, 'edgesOnVertex', edgesOnVertex)
+      call mpas_pool_get_array(mesh, 'nEdgesOnCell',nEdgesOnCell)
+      call mpas_pool_get_array(mesh, 'verticesOnEdge', verticesOnEdge)
+      
+      !  First, Rayleigh damping terms for ru, rtheta_m and rho_zz
+
+      do iCell = cellSolveStart, cellSolveEnd
+         if( (bdyMaskCell(iCell) > 1) .and. (bdyMaskCell(iCell) <= nRelaxZone) ) then
+            rayleigh_damping_coef = (real(bdyMaskCell(iCell)) - 1.)/real(nRelaxZone)/(50.*dt*meshScalingRegionalCell(iCell))
+            do k=1, nVertLevels
+               tend_rho(k,iCell) = tend_rho(k,iCell) - rayleigh_damping_coef * (rho_zz(k,iCell) - rho_driving_values(k,iCell))
+               tend_rt(k,iCell)  = tend_rt(k,iCell)  - rayleigh_damping_coef * (rho_zz(k,iCell)*theta_m(k,iCell) - rt_driving_values(k,iCell))
+            end do
+         end if
+      end do
+
+      do iEdge = edgeStart, edgeEnd
+         if( (bdyMaskEdge(iEdge) > 1) .and. (bdyMaskEdge(iEdge) <= nRelaxZone) ) then
+            rayleigh_damping_coef = (real(bdyMaskEdge(iEdge)) - 1.)/real(nRelaxZone)/(50.*dt*meshScalingRegionalEdge(iEdge))
+            do k=1, nVertLevels
+               tend_ru(k,iEdge) = tend_ru(k,iEdge) - rayleigh_damping_coef * (ru(k,iEdge) - ru_driving_values(k,iEdge))
+            end do
+         end if
+      end do
+      
+      !  Second, the horizontal filter for rtheta_m and rho_zz
+
+      do iCell = cellSolveStart, cellSolveEnd ! threaded over cells
+
+         if ( (bdyMaskCell(iCell) > 1) .and. (bdyMaskCell(iCell) <= nRelaxZone) ) then ! relaxation zone
+
+            laplacian_filter_coef = (real(bdyMaskCell(iCell)) - 1.)/real(nRelaxZone)/(10.*dt*meshScalingRegionalCell(iCell))
+            !
+            do i=1,nEdgesOnCell(iCell)
+               iEdge = edgesOnCell(i,iCell)
+               !  edge_sign = r_areaCell*edgesOnCell_sign(i,iCell) * dvEdge(iEdge) * invDcEdge(iEdge) * laplacian_filter_coef
+               ! this is a dimensionless laplacian, so we leave out the r_areaCell
+               edge_sign = edgesOnCell_sign(i,iCell) * dvEdge(iEdge) * invDcEdge(iEdge) * laplacian_filter_coef
+               cell1 = cellsOnEdge(1,iEdge)
+               cell2 = cellsOnEdge(2,iEdge)
+!DIR$ IVDEP
+               do k=1,nVertLevels
+                  tend_rt(k,iCell)  = tend_rt(k,iCell)  + edge_sign*(   (rho_zz(k,cell2)*theta_m(k,cell2)-rt_driving_values(k,cell2)) &
+                                                                    - (rho_zz(k,cell1)*theta_m(k,cell1)-rt_driving_values(k,cell1)) )
+                  tend_rho(k,iCell) = tend_rho(k,iCell) + edge_sign*(   (rho_zz(k,cell2)-rho_driving_values(k,cell2)) &
+                                                                    - (rho_zz(k,cell1)-rho_driving_values(k,cell1)) )
+               end do
+            end do
+
+         end if
+
+      end do
+
+      !  Third (and last), the horizontal filter for ru
+
+      do iEdge = edgeStart, edgeEnd
+
+         if ( (bdyMaskEdge(iEdge) > 1) .and. (bdyMaskEdge(iEdge) <= nRelaxZone) ) then ! relaxation zone
+
+            laplacian_filter_coef = dcEdge(iEdge)**2 * (real(bdyMaskEdge(iEdge)) - 1.)/   &
+                                                real(nRelaxZone)/(10.*dt*meshScalingRegionalEdge(iEdge))
+
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+            vertex1 = verticesOnEdge(1,iEdge)
+            vertex2 = verticesOnEdge(2,iEdge)
+            r_dc = invDcEdge(iEdge)
+            r_dv = min(invDvEdge(iEdge), 4*invDcEdge(iEdge))
+
+            iCell = cell1
+            invArea = invAreaCell(iCell)
+            divergence1(1:nVertLevels) = 0.
+            do i=1,nEdgesOnCell(iCell)
+               iEdge_div = edgesOnCell(i,iCell)
+               edge_sign = invArea * dvEdge(iEdge_div) * edgesOnCell_sign(i,iCell)
+               do k=1,nVertLevels
+                  divergence1(k) = divergence1(k) + edge_sign * (ru(k,iEdge_div) - ru_driving_values(k,iEdge_div))
+               end do
+            end do
+
+            iCell = cell2
+            invArea = invAreaCell(iCell)
+            divergence2(1:nVertLevels) = 0.
+            do i=1,nEdgesOnCell(iCell)
+               iEdge_div = edgesOnCell(i,iCell)
+               edge_sign = invArea * dvEdge(iEdge_div) * edgesOnCell_sign(i,iCell)
+               do k=1,nVertLevels
+                  divergence2(k) = divergence2(k) + edge_sign * (ru(k,iEdge_div) - ru_driving_values(k,iEdge_div))
+               end do
+            end do
+            
+            iVertex = vertex1
+            vorticity1(1:nVertLevels) = 0.
+            do i=1,vertexDegree
+               iEdge_vort = edgesOnVertex(i,iVertex)
+               edge_sign = invAreaTriangle(iVertex) * dcEdge(iEdge_vort) * edgesOnVertex_sign(i,iVertex)
+               do k=1,nVertLevels
+                  vorticity1(k) = vorticity1(k) + edge_sign * (ru(k,iEdge_vort) - ru_driving_values(k,iEdge_vort))
+               end do
+            end do
+
+            iVertex = vertex2
+            vorticity2(1:nVertLevels) = 0.
+            do i=1,vertexDegree
+               iEdge_vort = edgesOnVertex(i,iVertex)
+               edge_sign = invAreaTriangle(iVertex) * dcEdge(iEdge_vort) * edgesOnVertex_sign(i,iVertex)
+               do k=1,nVertLevels
+                  vorticity2(k) = vorticity2(k) + edge_sign * (ru(k,iEdge_vort) - ru_driving_values(k,iEdge_vort))
+               end do
+            end do
+
+            ! Compute diffusion, computed as \nabla divergence - k \times \nabla vorticity
+            !
+             do k=1,nVertLevels
+                tend_ru(k,iEdge) = tend_ru(k,iEdge) + laplacian_filter_coef * (  ( divergence2(k) - divergence1(k) ) * r_dc  &
+                                                                                -( vorticity2(k)  - vorticity1(k)  ) * r_dv )
+             end do
+
+          end if  !  end test for relaxation-zone edge
+
+       end do  !  end of loop over edges
+       
+   end subroutine atm_bdy_adjust_dynamics_relaxzone_tend
+      
+
+   subroutine atm_bdy_reset_speczone_values( state, diag, mesh, nVertLevels, &
+                                             rt_driving_values, rho_driving_values, &
+                                             cellStart, cellEnd, &
+                                             cellSolveStart, cellSolveEnd )
+
+      implicit none
+
+      !  this routine resets theta_m and rtheta_m after the microphysics, i.e. at the very end of the timestep
+      !
+      !  WCS 24 February 2017
+
+      type (mpas_pool_type), intent(in) :: state
+      type (mpas_pool_type), intent(in) :: diag
+      type (mpas_pool_type), intent(in) :: mesh
+      integer, intent(in) :: nVertLevels
+      integer, intent(in) :: cellStart, cellEnd
+      integer, intent(in) :: cellSolveStart, cellSolveEnd
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: rt_driving_values, rho_driving_values
+
+      real (kind=RKIND), dimension(:,:), pointer :: theta_m, rtheta_p, rtheta_base
+      integer, dimension(:), pointer :: bdyMaskCell
+      
+      integer :: iCell, k
+
+      call mpas_pool_get_array(mesh, 'bdyMaskCell', bdyMaskCell)
+      call mpas_pool_get_array(state, 'theta_m', theta_m, 2)
+      call mpas_pool_get_array(diag, 'rtheta_p', rtheta_p)
+      call mpas_pool_get_array(diag, 'rtheta_base', rtheta_base)
+      
+      do iCell = cellSolveStart, cellSolveEnd
+         if( bdyMaskCell(iCell) > nRelaxZone) then
+            do k=1, nVertLevels
+              theta_m(k,iCell) = rt_driving_values(k,iCell)/rho_driving_values(k,iCell)
+              rtheta_p(k,iCell) = rt_driving_values(k,iCell) - rtheta_base(k,iCell)
+            end do
+         end if
+      end do
+
+   end subroutine atm_bdy_reset_speczone_values
+
+!-------------------------------------------------------------------------
+   subroutine atm_bdy_adjust_scalars( state, diag, mesh, config, scalars_driving, nVertLevels, dt, dt_rk, &
+                                       cellStart, cellEnd, &
+                                       cellSolveStart, cellSolveEnd )
+
+      implicit none
+
+      !  this routine resets the dry dynamics variables at the end of an rk3 substep for the case
+      !  where the dry dynamics is split from the scalar transport (i.e. where the dry dynamics is
+      !  using a different, usually smaller, timestep.
+      !
+      !  WCS 24 February 2017
+
+      type (mpas_pool_type), intent(inout) :: state
+      type (mpas_pool_type), intent(in) :: diag
+      type (mpas_pool_type), intent(in) :: mesh
+      type (mpas_pool_type), intent(in) :: config
+      integer, intent(in) :: nVertLevels
+      integer, intent(in) :: cellStart, cellEnd
+      integer, intent(in) :: cellSolveStart, cellSolveEnd
+
+      real (kind=RKIND), intent(in) :: dt, dt_rk
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: scalars_driving
+      real (kind=RKIND), dimension(:,:,:), pointer :: scalars_new
+      real (kind=RKIND), dimension(:,:), pointer :: edgesOnCell_sign
+
+      real (kind=RKIND), dimension(:), pointer :: invDcEdge, dvEdge, meshScalingRegionalCell
+      integer, dimension(:), pointer :: nEdgesOnCell
+      integer, dimension(:,:), pointer :: edgesOnCell, cellsOnEdge
+      integer, pointer :: nCells, maxEdges, num_scalars
+      integer, dimension(:), pointer :: bdyMaskCell
+
+      call mpas_pool_get_array(state, 'scalars', scalars_new, 2)
+
+      call mpas_pool_get_array(mesh, 'invDcEdge', invDcEdge )
+      call mpas_pool_get_array(mesh, 'dvEdge', dvEdge )
+      call mpas_pool_get_array(mesh, 'edgesOnCell', edgesOnCell)
+      call mpas_pool_get_array(mesh, 'nEdgesOnCell', nEdgesOnCell)
+      call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge)
+      call mpas_pool_get_array(mesh, 'bdyMaskCell', bdyMaskCell)
+      call mpas_pool_get_array(mesh, 'meshScalingRegionalCell', meshScalingRegionalCell)
+      call mpas_pool_get_array(mesh, 'edgesOnCell_sign', edgesOnCell_sign)
+
+      call mpas_pool_get_dimension(mesh, 'nCells', nCells)
+      call mpas_pool_get_dimension(mesh, 'maxEdges', maxEdges)
+
+      call mpas_pool_get_dimension(state, 'num_scalars', num_scalars)
+
+      call atm_bdy_adjust_scalars_work( scalars_new, scalars_driving, dt, dt_rk, &
+                                        nVertLevels, nCells, num_scalars, &
+                                        nEdgesOnCell, edgesOnCell, EdgesOnCell_sign, cellsOnEdge, dvEdge, invDcEdge, bdyMaskCell, &
+                                        meshScalingRegionalCell,  &
+                                        cellStart, cellEnd, &
+                                        cellSolveStart, cellSolveEnd )
+
+   end subroutine atm_bdy_adjust_scalars
+
+!-------------------------------------------------------------------------
+
+   subroutine atm_bdy_adjust_scalars_work( scalars_new, scalars_driving, dt, dt_rk, &
+                                           nVertLevels, nCells, num_scalars, &
+                                           nEdgesOnCell, edgesOnCell, EdgesOnCell_sign, cellsOnEdge, dvEdge, invDcEdge, bdyMaskCell, &
+                                           meshScalingRegionalCell,  &
+                                           cellStart, cellEnd, &
+                                           cellSolveStart, cellSolveEnd )
+
+      implicit none
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: scalars_driving
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: scalars_new
+      real (kind=RKIND), dimension(:,:), intent(in) :: edgesOnCell_sign
+      integer, intent(in) :: nVertLevels, nCells, num_scalars
+      integer, intent(in) :: cellStart, cellEnd
+      integer, intent(in) :: cellSolveStart, cellSolveEnd
+      integer, dimension(:), intent(in) :: nEdgesOnCell, bdyMaskCell
+      integer, dimension(:,:), intent(in) :: edgesOnCell, cellsOnEdge
+      real (kind=RKIND), dimension(:), intent(in) :: dvEdge, invDcEdge, meshScalingRegionalCell
+      real (kind=RKIND), intent(in) :: dt, dt_rk
+
+      ! local variables
+
+      real (kind=RKIND), dimension(1:num_scalars,1:nVertLevels, cellSolveStart:cellSolveEnd) :: scalars_tmp
+      real (kind=RKIND) :: edge_sign, laplacian_filter_coef, rayleigh_damping_coef, filter_flux
+      integer :: iCell, iEdge, iScalar, i, k, cell1, cell2
+
+      !---
+
+      do iCell = cellSolveStart, cellSolveEnd ! threaded over cells
+
+         if ( (bdyMaskCell(iCell) > 1) .and. (bdyMaskCell(iCell) <= nRelaxZone) ) then ! relaxation zone
+
+            laplacian_filter_coef = dt_rk*(real(bdyMaskCell(iCell)) - 1.)/real(nRelaxZone)/(10.*dt*meshScalingRegionalCell(iCell))
+            rayleigh_damping_coef = laplacian_filter_coef/5.0
+            scalars_tmp(1:num_scalars,1:nVertLevels,iCell) = scalars_new(1:num_scalars,1:nVertLevels,iCell)
+
+            !  first, we compute the 2nd-order laplacian filter
+            !
+            do i=1,nEdgesOnCell(iCell)
+               iEdge = edgesOnCell(i,iCell)
+               !  edge_sign = r_areaCell*edgesOnCell_sign(i,iCell) * dvEdge(iEdge) * invDcEdge(iEdge) * laplacian_filter_coef
+               ! this is a dimensionless laplacian, so we leave out the r_areaCell
+               edge_sign = edgesOnCell_sign(i,iCell) * dvEdge(iEdge) * invDcEdge(iEdge) * laplacian_filter_coef
+               cell1 = cellsOnEdge(1,iEdge)
+               cell2 = cellsOnEdge(2,iEdge)
+!DIR$ IVDEP
+               do k=1,nVertLevels
+                  do iScalar = 1, num_scalars
+                     filter_flux = edge_sign*(   (scalars_new(iScalar,k,cell2)-scalars_driving(iScalar,k,cell2)) &
+                                               - (scalars_new(iScalar,k,cell1)-scalars_driving(iScalar,k,cell1)) )
+                     scalars_tmp(iScalar,k,iCell) = scalars_tmp(iScalar,k,iCell) + filter_flux
+                  end do
+               end do
+            end do
+
+            !  second, we compute the Rayleigh damping component
+            !
+!DIR$ IVDEP
+            do k=1,nVertLevels
+               do iScalar = 1, num_scalars
+                  scalars_tmp(iScalar,k,iCell) =scalars_tmp(iScalar,k,iCell) - rayleigh_damping_coef * (scalars_new(iScalar,k,iCell)-scalars_driving(iScalar,k,iCell))
+               end do
+            end do
+
+         else  if ( bdyMaskCell(iCell) > nRelaxZone) then ! specified zone
+            
+            !  update the specified-zone values
+            !
+!DIR$ IVDEP
+            do k=1,nVertLevels
+               do iScalar = 1, num_scalars
+                  scalars_tmp(iScalar,k,iCell) = scalars_driving(iScalar,k,iCell)
+               end do
+            end do
+
+         end if
+
+      end do  ! updates now in temp storage
+            
+!$OMP BARRIER
+
+      do iCell = cellSolveStart, cellSolveEnd ! threaded over cells
+         if (bdyMaskCell(iCell) > 1) then ! update values
+!DIR$ IVDEP
+            do k=1,nVertLevels
+               do iScalar = 1, num_scalars
+                  scalars_new(iScalar,k,iCell) = scalars_tmp(iScalar,k,iCell)
+               end do
+            end do
+         end if
+      end do
+
+   end subroutine atm_bdy_adjust_scalars_work
+
+!-------------------------------------------------------------------------
+
+   subroutine atm_bdy_set_scalars( state, mesh, scalars_driving, nVertLevels, &
+                                   cellStart, cellEnd, &
+                                   cellSolveStart, cellSolveEnd )
+
+      implicit none
+
+      !  this routine resets the dry dynamics variables at the end of an rk3 substep for the case
+      !  where the dry dynamics is split from the scalar transport (i.e. where the dry dynamics is
+      !  using a different, usually smaller, timestep.
+      !
+      !  WCS 24 February 2017
+
+      type (mpas_pool_type), intent(inout) :: state
+      type (mpas_pool_type), intent(in) :: mesh
+      integer, intent(in) :: nVertLevels
+      integer, intent(in) :: cellStart, cellEnd
+      integer, intent(in) :: cellSolveStart, cellSolveEnd
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: scalars_driving
+
+      real (kind=RKIND), dimension(:,:,:), pointer :: scalars_new
+      integer, pointer :: nCells, num_scalars
+      integer, dimension(:), pointer :: bdyMaskCell
+
+      call mpas_pool_get_array(mesh, 'bdyMaskCell', bdyMaskCell)
+
+      call mpas_pool_get_dimension(mesh, 'nCells', nCells)
+
+      call mpas_pool_get_dimension(state, 'num_scalars', num_scalars)
+
+      call mpas_pool_get_array(state, 'scalars', scalars_new, 2)
+
+      call atm_bdy_set_scalars_work( scalars_driving, scalars_new, &
+                                        nVertLevels, nCells, num_scalars, &
+                                        bdyMaskCell, &
+                                        cellStart, cellEnd, &
+                                        cellSolveStart, cellSolveEnd )
+
+   end subroutine atm_bdy_set_scalars
+
+!-------------------------------------------------------------------------
+
+   subroutine atm_bdy_set_scalars_work( scalars_driving, scalars_new, &
+                                           nVertLevels, nCells, num_scalars, &
+                                           bdyMaskCell, &
+                                           cellStart, cellEnd, &
+                                           cellSolveStart, cellSolveEnd )
+
+      implicit none
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: scalars_driving
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: scalars_new
+      integer, intent(in) :: nVertLevels, nCells, num_scalars
+      integer, intent(in) :: cellStart, cellEnd
+      integer, intent(in) :: cellSolveStart, cellSolveEnd
+      integer, dimension(:), intent(in) :: bdyMaskCell
+
+      ! local variables
+
+      real (kind=RKIND) :: laplacian_filter_coef, rayleigh_damping_coef, filter_flux
+      integer :: iCell, iScalar, i, k, cell1, cell2
+
+      !---
+
+      do iCell = cellSolveStart, cellSolveEnd ! threaded over cells
+
+         if ( bdyMaskCell(iCell) > nRelaxZone) then ! specified zone
+            
+            !  update the specified-zone values
+            !
+!DIR$ IVDEP
+            do k=1,nVertLevels
+               do iScalar = 1, num_scalars
+                  scalars_new(iScalar,k,iCell) = scalars_driving(iScalar,k,iCell)
+               end do
+            end do
+
+         end if
+
+      end do  ! updates now in temp storage
+            
+   end subroutine atm_bdy_set_scalars_work
+
+!-------------------------------------------------------------------------
+
    subroutine summarize_timestep(domain)
 
        use ieee_arithmetic, only : ieee_is_nan
diff --git a/src/core_atmosphere/mpas_atm_core.F b/src/core_atmosphere/mpas_atm_core.F
index 52eb418edd..5b56d653a8 100644
--- a/src/core_atmosphere/mpas_atm_core.F
+++ b/src/core_atmosphere/mpas_atm_core.F
@@ -10,7 +10,7 @@ module atm_core
    use mpas_derived_types
    use mpas_pool_routines
    use mpas_dmpar
-   use mpas_log, only : mpas_log_write
+   use mpas_log, only : mpas_log_write, mpas_log_info
 
    type (MPAS_Clock_type), pointer :: clock
 
@@ -75,6 +75,7 @@ function atm_core_init(domain, startTimeStamp) result(ierr)
       ! Set "local" clock to point to the clock contained in the domain type
       !
       clock => domain % clock
+      mpas_log_info => domain % logInfo
 
 
       call mpas_pool_get_config(domain % blocklist % configs, 'config_do_restart', config_do_restart)
@@ -143,6 +144,17 @@ function atm_core_init(domain, startTimeStamp) result(ierr)
       call mpas_pool_get_field(state, 'u', u_field, 1)
       call mpas_dmpar_exch_halo_field(u_field)
 
+
+      !
+      ! Perform basic compatibility checks among the fields that were read and the run-time options that were selected
+      !
+      call mpas_atm_run_compatibility(domain % dminfo, domain % blocklist, domain % streamManager, ierr)
+      if (ierr /= 0) then
+          call mpas_log_write('Please correct issues with the model input fields and/or namelist.', messageType=MPAS_LOG_ERR)
+          return
+      end if
+
+
       block => domain % blocklist
       do while (associated(block))
          call mpas_pool_get_subpool(block % structs, 'mesh', mesh)
@@ -249,6 +261,7 @@ subroutine atm_mpas_init_block(dminfo, stream_manager, block, mesh, dt)
       use mpas_rbf_interpolation
       use mpas_vector_reconstruction
       use mpas_stream_manager
+      use mpas_atm_boundaries, only : mpas_atm_setup_bdy_masks
 #ifdef DO_PHYSICS
 !     use mpas_atmphys_aquaplanet
       use mpas_atmphys_control
@@ -275,6 +288,7 @@ subroutine atm_mpas_init_block(dminfo, stream_manager, block, mesh, dt)
       
       real (kind=RKIND), dimension(:,:), pointer :: u, uReconstructX, uReconstructY, uReconstructZ, uReconstructZonal, uReconstructMeridional
       real (kind=RKIND), dimension(:), pointer :: meshScalingDel2, meshScalingDel4
+      real (kind=RKIND), dimension(:), pointer :: meshScalingRegionalCell, meshScalingRegionalEdge
       real (kind=RKIND), dimension(:), pointer :: areaCell, invAreaCell
       real (kind=RKIND), dimension(:), pointer :: dvEdge, invDvEdge
       real (kind=RKIND), dimension(:), pointer :: dcEdge, invDcEdge
@@ -443,6 +457,11 @@ subroutine atm_mpas_init_block(dminfo, stream_manager, block, mesh, dt)
 
       call atm_compute_damping_coefs(mesh, block % configs)
 
+      !
+      ! Set up mask fields used in limited-area simulations
+      !
+      call mpas_atm_setup_bdy_masks(mesh, block % configs)
+
       call mpas_pool_get_dimension(mesh, 'nEdgesSolve', nEdgesSolve)
       call mpas_pool_get_array(mesh, 'meshScalingDel2', meshScalingDel2)
       call mpas_pool_get_array(mesh, 'meshScalingDel4', meshScalingDel4)
@@ -462,6 +481,7 @@ function atm_core_run(domain) result(ierr)
       use mpas_stream_manager
       use mpas_derived_types, only : MPAS_STREAM_LATEST_BEFORE, MPAS_STREAM_INPUT, MPAS_STREAM_INPUT_OUTPUT
       use mpas_timer
+      use mpas_atm_boundaries, only : mpas_atm_update_bdy_tend
       use mpas_atm_diagnostics_manager, only : mpas_atm_diag_update, mpas_atm_diag_compute, mpas_atm_diag_reset
    
       implicit none
@@ -471,6 +491,7 @@ function atm_core_run(domain) result(ierr)
    
       real (kind=RKIND), pointer :: dt
       logical, pointer :: config_do_restart
+      logical, pointer :: config_apply_lbcs
       type (block_type), pointer :: block_ptr
 
       type (MPAS_Time_Type) :: currTime
@@ -493,6 +514,9 @@ function atm_core_run(domain) result(ierr)
       real (kind=R8KIND) :: output_start_time, output_stop_time
       
       ierr = 0
+
+      clock => domain % clock
+      mpas_log_info => domain % logInfo
       
       ! Eventually, dt should be domain specific
       call mpas_pool_get_config(domain % blocklist % configs, 'config_dt', dt)
@@ -553,6 +577,27 @@ function atm_core_run(domain) result(ierr)
       call mpas_pool_get_subpool(block_ptr % structs, 'diag', diag)
       call mpas_pool_get_subpool(block_ptr % structs, 'diag_physics', diag_physics)
 
+      call mpas_pool_get_config(domain % blocklist % configs, 'config_apply_lbcs', config_apply_lbcs)
+
+      !
+      ! Read initial boundary state
+      !
+      if (config_apply_lbcs .and. &
+          MPAS_stream_mgr_ringing_alarms(domain % streamManager, streamID='lbc_in', direction=MPAS_STREAM_INPUT, ierr=ierr)) then
+         block_ptr => domain % blocklist
+         do while (associated(block_ptr))
+            call mpas_atm_update_bdy_tend(clock, domain % streamManager, block_ptr, .true., ierr)
+            if (ierr /= 0) then
+               currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr)
+               call mpas_get_time(curr_time=currTime, dateTimeString=timeStamp)
+               call mpas_log_write('Failed to process LBC data on or before '//trim(timeStamp), messageType=MPAS_LOG_ERR)
+               return
+            end if
+
+            block_ptr => block_ptr % next
+         end do
+      end if
+
       ! 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 = 1
@@ -564,6 +609,28 @@ function atm_core_run(domain) result(ierr)
          call mpas_log_write('')
          call mpas_log_write('Begin timestep '//trim(timeStamp))
 
+         !
+         ! Read future boundary state and compute boundary tendencies
+         !
+         if (config_apply_lbcs .and. &
+             MPAS_stream_mgr_ringing_alarms(domain % streamManager, streamID='lbc_in', direction=MPAS_STREAM_INPUT, ierr=ierr)) then
+            block_ptr => domain % blocklist
+            do while (associated(block_ptr))
+               call mpas_atm_update_bdy_tend(clock, domain % streamManager, block_ptr, .false., ierr)
+               if (ierr /= 0) then
+                  call mpas_log_write('Failed to process LBC data at next time after '//trim(timeStamp), messageType=MPAS_LOG_ERR)
+                  return
+               end if
+
+               block_ptr => block_ptr % next
+            end do
+         end if
+
+         ! Regardless of whether boundary tendencies were updated, above, we do not want to read the 'lbc_in' stream
+         ! as a general input stream, below.
+         call MPAS_stream_mgr_reset_alarms(domain % streamManager, streamID='lbc_in', direction=MPAS_STREAM_INPUT, ierr=ierr)
+
+
          !
          ! Read external field updates
          !
@@ -632,20 +699,6 @@ function atm_core_run(domain) result(ierr)
 
          call mpas_atm_diag_update()
          call mpas_atm_diag_compute()
-
-         if (MPAS_stream_mgr_ringing_alarms(domain % streamManager, streamID='restart', direction=MPAS_STREAM_OUTPUT, ierr=ierr)) then
-            block_ptr => domain % blocklist
-            do while (associated(block_ptr))
-
-               call mpas_pool_get_subpool(block_ptr % structs, 'state', state)
-               call mpas_pool_get_subpool(block_ptr % structs, 'diag', diag)
-               call mpas_pool_get_subpool(block_ptr % structs, 'diag_physics', diag_physics)
-               call mpas_pool_get_subpool(block_ptr % structs, 'mesh', mesh)
-               call atm_compute_restart_diagnostics(state, 1, diag, mesh)
-
-               block_ptr => block_ptr % next
-            end do
-         end if
          call mpas_dmpar_get_time(diag_stop_time)
 
          call mpas_dmpar_get_time(output_start_time)
@@ -692,15 +745,10 @@ function atm_core_run(domain) result(ierr)
 
          call mpas_stream_mgr_reset_alarms(domain % streamManager, direction=MPAS_STREAM_OUTPUT, ierr=ierr)
 
-         block_ptr => domain % blocklist
-         call mpas_pool_get_subpool(block_ptr % structs, 'mesh', mesh)
-         call mpas_pool_get_subpool(block_ptr % structs, 'state', state)
-         call mpas_pool_get_subpool(block_ptr % structs, 'diag', diag)
-         call mpas_pool_get_subpool(block_ptr % structs, 'diag_physics', diag_physics)
-
       end do
    
    end function atm_core_run
+
    
    subroutine atm_compute_output_diagnostics(state, time_lev, diag, mesh)
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -754,52 +802,6 @@ subroutine atm_compute_output_diagnostics(state, time_lev, diag, mesh)
    end subroutine atm_compute_output_diagnostics
    
    
-   subroutine atm_compute_restart_diagnostics(state, time_lev, diag, mesh)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Compute diagnostic fields for a domain to be written to restart files
-   !
-   ! Input: state - contains model prognostic fields
-   !        mesh  - contains grid metadata
-   !
-   ! Output: state - upon returning, diagnostic fields will have be computed
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   
-      use mpas_constants
-   
-      implicit none
-   
-      type (mpas_pool_type), intent(inout) :: state
-      integer, intent(in) :: time_lev                 ! which time level to use from state
-      type (mpas_pool_type), intent(inout) :: diag
-      type (mpas_pool_type), intent(in) :: mesh
-   
-      integer :: iCell, k
-      integer, pointer :: nCells, nVertLevels, index_qv
-      real (kind=RKIND), dimension(:,:), pointer :: theta, rho, theta_m, rho_zz, zz
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalars
-
-      call mpas_pool_get_dimension(mesh, 'nCells', nCells)
-      call mpas_pool_get_dimension(mesh, 'nVertLevels', nVertLevels)
-      call mpas_pool_get_dimension(state, 'index_qv', index_qv)
-
-      call mpas_pool_get_array(state, 'theta_m', theta_m, time_lev)
-      call mpas_pool_get_array(state, 'rho_zz', rho_zz, time_lev)
-      call mpas_pool_get_array(state, 'scalars', scalars, time_lev)
-
-      call mpas_pool_get_array(diag, 'theta', theta)
-      call mpas_pool_get_array(diag, 'rho', rho)
-
-      call mpas_pool_get_array(mesh, 'zz', zz)
-
-      do iCell=1,nCells
-         do k=1,nVertLevels
-            theta(k,iCell) = theta_m(k,iCell) / (1.0_RKIND + rvord * scalars(index_qv,k,iCell))
-            rho(k,iCell) = rho_zz(k,iCell) * zz(k,iCell)
-         end do
-      end do
-   
-   end subroutine atm_compute_restart_diagnostics
-
    subroutine atm_reset_diagnostics(diag, diag_physics)
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! reset some diagnostics after output
@@ -849,6 +851,9 @@ subroutine atm_do_timestep(domain, dt, itimestep)
       real (kind=RKIND) :: xtime_s
       integer :: ierr
 
+      clock => domain % clock
+      mpas_log_info => domain % logInfo
+
       startTime = mpas_get_clock_time(clock, MPAS_START_TIME, ierr)
       currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr)
          
@@ -889,6 +894,9 @@ function atm_core_finalize(domain) result(ierr)
 
       ierr = 0
 
+      clock => domain % clock
+      mpas_log_info => domain % logInfo
+
       call mpas_atm_diag_cleanup()
 
       call mpas_destroy_clock(clock, ierr)
@@ -923,18 +931,22 @@ subroutine atm_compute_mesh_scaling(mesh, configs)
       type (mpas_pool_type), intent(inout) :: mesh
       type (mpas_pool_type), intent(in) :: configs
 
-      integer :: iEdge, cell1, cell2
-      integer, pointer :: nEdges
+      integer :: iCell,iEdge, cell1, cell2
+      integer, pointer :: nEdges, nCells
       integer, dimension(:,:), pointer :: cellsOnEdge
       real (kind=RKIND), dimension(:), pointer :: meshDensity, meshScalingDel2, meshScalingDel4
+      real (kind=RKIND), dimension(:), pointer :: meshScalingRegionalCell, meshScalingRegionalEdge
       logical, pointer :: config_h_ScaleWithMesh
 
       call mpas_pool_get_array(mesh, 'meshDensity', meshDensity)
       call mpas_pool_get_array(mesh, 'meshScalingDel2', meshScalingDel2)
       call mpas_pool_get_array(mesh, 'meshScalingDel4', meshScalingDel4)
+      call mpas_pool_get_array(mesh, 'meshScalingRegionalCell', meshScalingRegionalCell)
+      call mpas_pool_get_array(mesh, 'meshScalingRegionalEdge', meshScalingRegionalEdge)
       call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge)
 
       call mpas_pool_get_dimension(mesh, 'nEdges', nEdges)
+      call mpas_pool_get_dimension(mesh, 'nCells', nCells)
 
       call mpas_pool_get_config(configs, 'config_h_ScaleWithMesh', config_h_ScaleWithMesh)
 
@@ -952,6 +964,23 @@ subroutine atm_compute_mesh_scaling(mesh, configs)
          end do
       end if
 
+      !
+      ! Compute the scaling factors to be used in relaxation zone of regional configuration
+      !
+      meshScalingRegionalCell(:) = 1.0
+      meshScalingRegionalEdge(:) = 1.0
+      if (config_h_ScaleWithMesh) then
+         do iEdge=1,nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+            meshScalingRegionalEdge(iEdge) = 1.0 / ( (meshDensity(cell1) + meshDensity(cell2) )/2.0)**0.25
+         end do
+
+         do iCell=1,nCells
+            meshScalingRegionalCell(iCell) = 1.0 / (meshDensity(iCell))**0.25
+         end do
+      end if
+
    end subroutine atm_compute_mesh_scaling
 
 
@@ -1259,5 +1288,53 @@ subroutine atm_couple_coef_3rd_order(mesh, configs)
    end subroutine atm_couple_coef_3rd_order
 
 
+   !-----------------------------------------------------------------------
+   !  routine mpas_atm_run_compatibility
+   !
+   !> \brief Checks input fields and options for compatibility
+   !> \author Michael Duda
+   !> \date   22 October 2018
+   !> \details
+   !>  This routine checks the input fields and run-time options provided
+   !>  by the user for compatibility. For example, two run-time options may
+   !>  be mutually exclusive, or an option may require that a certain input
+   !>  field is provided.
+   !>
+   !>  A value of 0 is returned if there are no incompatibilities among
+   !>  the provided input fields and run-time options, and a non-zero value
+   !>  otherwise.
+   !
+   !-----------------------------------------------------------------------
+   subroutine mpas_atm_run_compatibility(dminfo, blockList, streamManager, ierr)
+
+      use mpas_atmphys_control, only : physics_compatibility_check
+      use mpas_atm_boundaries, only : mpas_atm_bdy_checks
+
+      implicit none
+
+      type (dm_info), pointer :: dminfo
+      type (block_type), pointer :: blockList
+      type (MPAS_streamManager_type), pointer :: streamManager
+      integer, intent(out) :: ierr
+
+      integer :: local_ierr
+
+      ierr = 0
+
+      !
+      ! Physics specific checks found in physics/mpas_atmphys_control.F
+      !
+      call physics_compatibility_check(dminfo, blockList, streamManager, local_ierr)
+      ierr = ierr + local_ierr
+
+      !
+      ! Checks for limited-area simulations
+      !
+      call mpas_atm_bdy_checks(dminfo, blockList, streamManager, local_ierr)
+      ierr = ierr + local_ierr
+
+   end subroutine mpas_atm_run_compatibility
+
+
 end module atm_core
 
diff --git a/src/core_atmosphere/mpas_atm_core_interface.F b/src/core_atmosphere/mpas_atm_core_interface.F
index 6a9064c60f..8c3858b165 100644
--- a/src/core_atmosphere/mpas_atm_core_interface.F
+++ b/src/core_atmosphere/mpas_atm_core_interface.F
@@ -55,7 +55,7 @@ subroutine atm_setup_core(core)
       core % Conventions = 'MPAS'
       core % source = 'MPAS'
 
-#include "inc/core_variables.inc"
+#include "core_variables.inc"
 
    end subroutine atm_setup_core
 
@@ -80,7 +80,7 @@ subroutine atm_setup_domain(domain)
 
       type (domain_type), pointer :: domain
 
-#include "inc/domain_variables.inc"
+#include "domain_variables.inc"
 
    end subroutine atm_setup_domain
 
@@ -119,9 +119,16 @@ function atm_setup_packages(configs, packages, iocontext) result(ierr)
 
       logical, pointer :: iauActive
       character(len=StrKIND), pointer :: config_iau_option
+      logical, pointer :: limited_areaActive
+      logical, pointer :: config_apply_lbcs
+      logical, pointer :: config_jedi_da, jedi_daActive
+      integer :: local_ierr
 
       ierr = 0
 
+      !
+      ! Incremental analysis update
+      !
       nullify(config_iau_option)
       call mpas_pool_get_config(configs, 'config_IAU_option', config_iau_option)
 
@@ -134,15 +141,49 @@ function atm_setup_packages(configs, packages, iocontext) result(ierr)
          iauActive = .false.
       end if
 
+      !
+      ! Limited-area
+      !
+      nullify(config_apply_lbcs)
+      call mpas_pool_get_config(configs, 'config_apply_lbcs', config_apply_lbcs)
+
+      nullify(limited_areaActive)
+      call mpas_pool_get_package(packages, 'limited_areaActive', limited_areaActive)
+
+      if (config_apply_lbcs) then
+         limited_areaActive = .true.
+      else
+         limited_areaActive = .false.
+      end if
+
+      !
+      ! JEDI data assimilation
+      !
+      nullify(config_jedi_da)
+      call mpas_pool_get_config(configs, 'config_jedi_da', config_jedi_da)
+
+      nullify(jedi_daActive)
+      call mpas_pool_get_package(packages, 'jedi_daActive', jedi_daActive)
+
+      if (associated(config_jedi_da) .and. associated(jedi_daActive)) then
+         jedi_daActive = config_jedi_da
+      else
+         ierr = ierr + 1
+         call mpas_log_write('Package setup failed for ''jedi_da''. '// &
+              'Either ''jedi_da'' is not a package, or ''config_jedi_da'' is not a namelist option.', &
+              messageType=MPAS_LOG_ERR)
+      end if
+
 #ifdef DO_PHYSICS
       !check that all the physics options are correctly defined and that at
       !least one physics parameterization is called (using the logical moist_physics):
       call physics_namelist_check(configs)
 
-      ierr = atmphys_setup_packages(configs,packages,iocontext)
-      if(ierr /= 0) then
+      local_ierr = atmphys_setup_packages(configs, packages, iocontext)
+      if (local_ierr /= 0) then
+         ierr = ierr + 1
          call mpas_log_write('Package setup failed for atmphys in core_atmosphere', messageType=MPAS_LOG_ERR)
-      endif
+      end if
 #endif
 
    end function atm_setup_packages
@@ -346,16 +387,16 @@ function atm_setup_block(block) result(ierr)
    end function atm_setup_block
 
 
-#include "inc/setup_immutable_streams.inc"
+#include "setup_immutable_streams.inc"
 
-#include "inc/block_dimension_routines.inc"
+#include "block_dimension_routines.inc"
 
-#include "inc/define_packages.inc"
+#include "define_packages.inc"
 
-#include "inc/structs_and_variables.inc"
+#include "structs_and_variables.inc"
 
-#include "inc/namelist_call.inc"
+#include "namelist_call.inc"
 
-#include "inc/namelist_defines.inc"
+#include "namelist_defines.inc"
 
 end module atm_core_interface
diff --git a/src/core_atmosphere/physics/Makefile b/src/core_atmosphere/physics/Makefile
index e8cb03f6f5..faf6b98d40 100644
--- a/src/core_atmosphere/physics/Makefile
+++ b/src/core_atmosphere/physics/Makefile
@@ -48,7 +48,7 @@ OBJS = \
 lookup_tables:
 	./checkout_data_files.sh
 
-core_physics_wrf:
+core_physics_wrf: core_physics_init
 	(cd physics_wrf; $(MAKE) all COREDEF="$(COREDEF)")
 
 core_physics_init: $(OBJS_init)
@@ -185,7 +185,6 @@ mpas_atmphys_todynamics.o: \
 mpas_atmphys_update_surface.o: \
 	mpas_atmphys_date_time.o \
 	mpas_atmphys_constants.o \
-	mpas_atmphys_landuse.o \
 	mpas_atmphys_vars.o
 
 mpas_atmphys_update.o: \
diff --git a/src/core_atmosphere/physics/checkout_data_files.sh b/src/core_atmosphere/physics/checkout_data_files.sh
index e62b466aa7..7e8ab49bf3 100755
--- a/src/core_atmosphere/physics/checkout_data_files.sh
+++ b/src/core_atmosphere/physics/checkout_data_files.sh
@@ -5,64 +5,94 @@
 #
 # The purpose of this script is to obtain lookup tables used by the WRF physics
 #   packages.  At present, the only method for acquiring these tables is through
-#   the MPAS-Dev github repository using either git, svn, or curl.
+#   the MPAS-Dev GitHub repository using either git, svn, or curl.
 #
 # If none of the methods used in this script are successful in acquiring the 
 #   tables, please attempt to manually download the files from the MPAS-Data 
 #   repository at https://github.com/MPAS-Dev/MPAS-Data/.  All *.TBL and *DATA* 
 #   files, as well as the COMPATIBILITY file, should be copied into 
 #   a subdirectory named src/core_atmosphere/physics/physics_wrf/files before 
-#   continuing the build process.
+#   continuing the build process.  In general, one should obtain the lookup
+#   tables from a tag in the MPAS-Dev repository whose name matches the version
+#   of the MPAS-Atmosphere code; e.g., for MPAS-Atmosphere v7.0, one should
+#   use the tables from the v7.0 tag in the MPAS-Data repository.
 #
-# If all else fails, please contact the MPAS-A developers 
-#   via "mpas-atmosphere-help@googlegroups.com".
+# If all else fails, please contact the MPAS-Atmosphere developers through
+#   the MPAS-Atmosphere support forum at http://forum.mmm.ucar.edu/.
 #
 ################################################################################
 
-mpas_vers="4.0"
 
-if [ -s physics_wrf/files/COMPATIBILITY ]; then
+mpas_vers="7.0"
 
-   compatible=0
+github_org="MPAS-Dev"   # GitHub organization where the MPAS-Data repository is found.
+                        # For physics development, it can be helpful for a developer
+                        # to obtain tables from their own fork of the MPAS-Data repository.
 
-   compat=`cat physics_wrf/files/COMPATIBILITY | grep -v "#"`
-   for ver in $compat; do
-      if [ "$ver" = "$mpas_vers" ]; then
-         compatible=1
+#
+# Return 1 if the "mpas_vers" string is found in the physics table COMPATIBILITY
+# file, and 0 otherwise
+#
+check_compatibility() {
+   for ver in `cat physics_wrf/files/COMPATIBILITY | grep -v "#"`; do
+      if [ "${ver}" = "${mpas_vers}" ]; then
+         return 1
       fi
    done
+   return 0
+}
+
+
+#
+# See whether we already have compatible physics tables
+#
+if [ -s physics_wrf/files/COMPATIBILITY ]; then
 
-   if [ $compatible -eq 1 ]; then
+   check_compatibility
+   if [ $? -eq 1 ]; then
       echo "*** Compatible versions of WRF physics tables appear to already exist; no need to obtain them again ***"
       exit 0
    else
-      echo "*** Existing WRF physics tables appear to be incompatible with MPAS v$mpas_vers; downloading the latest tables ***"
+      echo "*** Existing WRF physics tables appear to be incompatible with MPAS v${mpas_vers}; attempting to download compatible tables ***"
    fi
 
 else
 
-   echo "*** No compatible version of WRF physics tables found; downloading the latest tables ***"
+   echo "*** No compatible version of WRF physics tables found; attempting to download compatible tables ***"
 
 fi
 
-
 if [ ! -d physics_wrf/files ]; then
    mkdir -p physics_wrf/files
 fi
 
+
 #
 # Try using 'git'
 #
 which git
 if [ $? -eq 0 ]; then
-   echo "*** trying git to obtain WRF physics tables ***"
-   git clone git://github.com/MPAS-Dev/MPAS-Data.git
+   echo "*** Trying git to obtain WRF physics tables ***"
+   git clone git://github.com/${github_org}/MPAS-Data.git
    if [ $? -eq 0 ]; then
+      cd MPAS-Data
+      git checkout v${mpas_vers}
+      if [ $? -ne 0 ]; then
+         echo "*** MPAS version-specific tag not found; trying the master branch ***"
+      else
+         echo "*** Found v${mpas_vers} tag ***"
+      fi
+      cd ..
       mv MPAS-Data/atmosphere/physics_wrf/files/* physics_wrf/files
       rm -rf MPAS-Data
-      exit 0
+
+      check_compatibility
+      if [ $? -eq 1 ]; then
+         echo "*** Successfully obtained compatible versions of WRF physics tables ***"
+         exit 0
+      fi
    else
-      echo "*** failed to obtain WRF physics tables using git ***"
+      echo "*** Failed to obtain WRF physics tables using git ***"
    fi
 else
    echo "*** git not in path ***"
@@ -74,14 +104,26 @@ fi
 #
 which svn
 if [ $? -eq 0 ]; then
-   echo "*** trying svn to obtain WRF physics tables ***"
-   svn checkout --non-interactive --trust-server-cert https://github.com/MPAS-Dev/MPAS-Data.git
+   echo "*** Trying svn to obtain WRF physics tables ***"
+   branch=v${mpas_vers}
+   svn checkout --non-interactive --trust-server-cert https://github.com/${github_org}/MPAS-Data.git/tags/${branch}
+   if [ $? -ne 0 ]; then
+      echo "*** MPAS version-specific tag not found; trying the trunk ***"
+      branch=trunk
+      svn checkout --non-interactive --trust-server-cert https://github.com/${github_org}/MPAS-Data.git/${branch}
+   else
+      echo "*** Found v${mpas_vers} tag ***"
+   fi
    if [ $? -eq 0 ]; then
-      mv MPAS-Data.git/trunk/atmosphere/physics_wrf/files/* physics_wrf/files
-      rm -rf MPAS-Data.git
-      exit 0
+      mv ${branch}/atmosphere/physics_wrf/files/* physics_wrf/files
+      rm -rf ${branch}
+      check_compatibility
+      if [ $? -eq 1 ]; then
+         echo "*** Successfully obtained compatible versions of WRF physics tables ***"
+         exit 0
+      fi
    else
-      echo "*** failed to obtain WRF physics tables using svn ***"
+      echo "*** Failed to obtain WRF physics tables using svn ***"
    fi
 else
    echo "*** svn not in path ***"
@@ -93,21 +135,34 @@ fi
 #
 which curl
 if [ $? -eq 0 ]; then
-   echo "*** trying curl to obtain WRF physics tables ***"
-   curl -o master.zip https://codeload.github.com/MPAS-Dev/MPAS-Data/zip/master
+   echo "*** Trying curl to obtain WRF physics tables ***"
+   branch=${mpas_vers}
+   curl -sf -o MPAS-Data.tar.gz https://codeload.github.com/${github_org}/MPAS-Data/tar.gz/v${branch}
+   if [ $? -ne 0 ]; then
+      echo "*** MPAS version-specific tar file not found; trying the master tar file ***"
+      branch=master
+      curl -sf -o MPAS-Data.tar.gz https://codeload.github.com/${github_org}/MPAS-Data/tar.gz/${branch}
+   else
+      echo "*** Found v${mpas_vers} tar file ***"
+   fi
    if [ $? -eq 0 ]; then
-      which unzip
+      which tar
       if [ $? -eq 0 ]; then
-         unzip master.zip
-         mv MPAS-Data-master/atmosphere/physics_wrf/files/* physics_wrf/files
-         rm -rf master.zip MPAS-Data-master
-         exit 0
+         tar -xzf MPAS-Data.tar.gz
+         mv MPAS-Data-${branch}/atmosphere/physics_wrf/files/* physics_wrf/files
+         rm -rf MPAS-Data.tar.gz MPAS-Data-${branch}
+
+         check_compatibility
+         if [ $? -eq 1 ]; then
+            echo "*** Successfully obtained compatible versions of WRF physics tables ***"
+            exit 0
+         fi
       else
-         echo "*** unzip not in path -- unable to unzip WRF physics tables"
-         rm -f master.zip
+         echo "*** tar not in path -- unable to extract WRF physics tables ***"
+         rm -rf MPAS-Data.tar.gz
       fi
    else
-      echo "*** failed to obtain WRF physics tables using curl ***"
+      echo "*** Failed to obtain WRF physics tables using curl ***"
    fi
 else
    echo "*** curl not in path ***"
diff --git a/src/core_atmosphere/physics/mpas_atmphys_control.F b/src/core_atmosphere/physics/mpas_atmphys_control.F
index 3ea3e96878..9b7a08c5e0 100644
--- a/src/core_atmosphere/physics/mpas_atmphys_control.F
+++ b/src/core_atmosphere/physics/mpas_atmphys_control.F
@@ -18,7 +18,8 @@ module mpas_atmphys_control
  private
  public:: physics_namelist_check, &
           physics_registry_init,  &
-          physics_tables_init
+          physics_tables_init,    &
+          physics_compatibility_check
 
  logical,public:: moist_physics
 
@@ -417,6 +418,81 @@ subroutine physics_tables_init(dminfo,configs)
 
  end subroutine physics_tables_init
 
+!=================================================================================================================
+!  routine physics_compatibility_check()
+!
+!> \brief Checks physics input fields and options for compatibility
+!> \author Miles Curry and Michael Duda
+!> \date   25 October 2018
+!> \details
+!>  This routine checks the input fields and run-time options provided
+!>  by the user for compatibility. For example, two run-time options may
+!>  be mutually exclusive, or an option may require that a certain input
+!>  field is provided. The checks performed by this routine are only for
+!>  physics related fields and options.
+!>
+!>  A value of 0 is returned if there are no incompatibilities among
+!>  the provided input fields and run-time options, and a non-zero value
+!>  otherwise.
+!>
+ subroutine physics_compatibility_check(dminfo, blockList, streamManager, ierr)
+!=================================================================================================================
+
+ implicit none
+
+ type (dm_info), pointer :: dminfo
+ type (block_type), pointer :: blockList
+ type (MPAS_streamManager_type), pointer :: streamManager
+ integer, intent(out) :: ierr
+
+ real (kind=RKIND) :: maxvar2d_local, maxvar2d_global
+ real (kind=RKIND), dimension(:), pointer :: var2d
+ integer, pointer :: nCellsSolve
+ character (len=StrKIND), pointer :: gwdo_scheme
+ type (block_type), pointer :: block
+ type (mpas_pool_type), pointer :: meshPool
+ type (mpas_pool_type), pointer :: sfc_inputPool
+
+ ierr = 0
+
+ call mpas_pool_get_config(blocklist % configs, 'config_gwdo_scheme', gwdo_scheme)
+
+ if (trim(gwdo_scheme) /= 'off') then
+     maxvar2d_local = -huge(maxvar2d_local)
+     block => blockList
+     do while (associated(block))
+         call mpas_pool_get_subpool(block % structs, 'mesh', meshPool)
+         call mpas_pool_get_subpool(block % structs, 'sfc_input', sfc_inputPool)
+         call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve)
+         call mpas_pool_get_array(sfc_inputPool, 'var2d', var2d)
+
+         maxvar2d_local = max(maxvar2d_local, maxval(var2d(1:nCellsSolve)))
+
+         block => block % next
+     end do
+
+     call mpas_dmpar_max_real(dminfo, maxvar2d_local, maxvar2d_global)
+
+     if (maxvar2d_global <= 0.0_RKIND) then
+         call mpas_log_write('*******************************************************************************', &
+                             messageType=MPAS_LOG_ERR)
+         call mpas_log_write('The GWDO scheme requires valid var2d, con, oa{1,2,3,4}, and ol{1,2,3,4} fields,', &
+                             messageType=MPAS_LOG_ERR)
+         call mpas_log_write('but these fields appear to be zero everywhere in the model input.', &
+                             messageType=MPAS_LOG_ERR)
+         call mpas_log_write('Either set config_gwdo_scheme = ''off'' in the &physics namelist, or generate', &
+                             messageType=MPAS_LOG_ERR)
+         call mpas_log_write('the GWDO static fields with the init_atmosphere core.', &
+                             messageType=MPAS_LOG_ERR)
+         call mpas_log_write('*******************************************************************************', &
+                             messageType=MPAS_LOG_ERR)
+         ierr = ierr + 1
+     end if
+
+ end if
+
+ end subroutine physics_compatibility_check
+
 !=================================================================================================================
  end module mpas_atmphys_control
 !=================================================================================================================
diff --git a/src/core_atmosphere/physics/mpas_atmphys_date_time.F b/src/core_atmosphere/physics/mpas_atmphys_date_time.F
index 356198e05c..65b5349073 100644
--- a/src/core_atmosphere/physics/mpas_atmphys_date_time.F
+++ b/src/core_atmosphere/physics/mpas_atmphys_date_time.F
@@ -13,6 +13,7 @@ module mpas_atmphys_date_time
  implicit none
  private
  public:: get_julgmt,             &
+          cal_mon_day,            &
           monthly_interp_to_date, &
           monthly_min_max
 
@@ -37,6 +38,10 @@ module mpas_atmphys_date_time
 ! * in subroutines get_julgmt_date and split_date_char, changed the declaration of date_str
 !   from StrKIND to *.
 !   Laura D. Fowler (laura@ucar.edu) / 2013-10-18.
+! * added the subroutine cal_mon_day. This subroutine was copied from module_ra_gfdleta.F from WRF version 3.9.0.
+!   It is used in the updated module module_sf_noahdrv.F, but only if we run the urban physics option which we do
+!   not. So this subroutine is currently not used.
+!   Laura D. Fowler (laura@ucar.edu) / 2017-01-10.
 
 
  contains
@@ -78,6 +83,45 @@ subroutine get_julgmt(date_str,julyr,julday,gmt)
 
  end subroutine get_julgmt
 
+!=================================================================================================================
+ subroutine cal_mon_day(julday,julyr,jmonth,jday)
+!=================================================================================================================
+
+!input arguments:
+ integer,intent(in):: julday,julyr
+
+!output arguments:
+ integer,intent(out):: jmonth,jday
+
+!local variables:
+ logical:: leap,not_find_date
+ integer:: month (12),itmpday,itmpmon,i
+ data month/31,28,31,30,31,30,31,31,30,31,30,31/
+
+ not_find_date = .true.
+
+ itmpday = julday
+ itmpmon = 1
+ leap=.false.
+ if(mod(julyr,4).eq.0)then
+    month(2)=29
+    leap=.true.
+ endif
+
+ i = 1
+ do while (not_find_date)
+    if(itmpday.gt.month(i))then
+       itmpday=itmpday-month(i)
+    else
+       jday=itmpday
+       jmonth=i
+       not_find_date = .false.
+    endif
+    i = i+1
+ enddo
+
+ end subroutine cal_mon_day
+
 !=================================================================================================================
  subroutine split_date_char(date,century_year,month,day,hour,minute,second,ten_thousandth)
 !=================================================================================================================
@@ -171,6 +215,7 @@ subroutine monthly_interp_to_date(npoints,date_str,field_in,field_out)
     endif
  enddo find_month
  
+
  end subroutine monthly_interp_to_date
 
 !=================================================================================================================
diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F b/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F
index 08eee06635..29ba7ef0c7 100644
--- a/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F
+++ b/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F
@@ -9,7 +9,7 @@
  module mpas_atmphys_driver_gwdo
  use mpas_kind_types
  use mpas_pool_routines
- use mpas_timer, only : mpas_timer_start, mpas_timer_stop
+ use mpas_timer,only: mpas_timer_start,mpas_timer_stop
 
  use mpas_atmphys_constants
  use mpas_atmphys_vars
@@ -57,6 +57,9 @@ module mpas_atmphys_driver_gwdo
 !   Laura D. Fowler (laura@ucar.edu) / 2016-03-25. 
 ! * change the definition of dx_p to match that used in other physics parameterizations.
 !   Laura D. Fowler (laura@ucar.edu) / 2016-10-18.
+! * modified the call to subroutine gwdo following the update of module_gwdo.F to that
+!   of WRF version 4.0.2.
+!   Laura D. Fowler (laura@ucar.edu) / 2019-01-30.
 
 
  contains
@@ -66,6 +69,9 @@ module mpas_atmphys_driver_gwdo
  subroutine allocate_gwdo
 !=================================================================================================================
 
+ if(.not.allocated(cosa_p)  ) allocate(cosa_p(ims:ime,jms:jme)  )
+ if(.not.allocated(sina_p)  ) allocate(sina_p(ims:ime,jms:jme)  )
+
  if(.not.allocated(dx_p)    ) allocate(dx_p(ims:ime,jms:jme)    )
  if(.not.allocated(var2d_p) ) allocate(var2d_p(ims:ime,jms:jme) )
  if(.not.allocated(con_p)   ) allocate(con_p(ims:ime,jms:jme)   )
@@ -92,6 +98,9 @@ end subroutine allocate_gwdo
  subroutine deallocate_gwdo
 !=================================================================================================================
 
+ if(allocated(cosa_p)  ) deallocate(cosa_p  )
+ if(allocated(sina_p)  ) deallocate(sina_p  )
+
  if(allocated(dx_p)    ) deallocate(dx_p    )
  if(allocated(var2d_p) ) deallocate(var2d_p )
  if(allocated(con_p)   ) deallocate(con_p   )
@@ -164,6 +173,10 @@ subroutine gwdo_from_MPAS(configs,mesh,sfc_input,diag_physics,tend_physics,its,i
 
  do j = jts,jte
  do i = its,ite
+
+    sina_p(i,j)  = 0._RKIND
+    cosa_p(i,j)  = 1._RKIND
+
     var2d_p(i,j) = var2d(i)
     con_p(i,j)   = con(i)
     oa1_p(i,j)   = oa1(i)
@@ -284,7 +297,7 @@ subroutine driver_gwdo(itimestep,configs,mesh,sfc_input,diag_physics,tend_physic
  gwdo_select: select case (trim(gwdo_scheme))
 
     case("bl_ysu_gwdo")
-       call mpas_timer_start('GWDO_YSU')
+       call mpas_timer_start('bl_ysu_gwdo')
        call gwdo ( &
                   p3d       = pres_hydd_p , p3di      = pres2_hydd_p , pi3d    = pi_p      , &
                   u3d       = u_p         , v3d       = v_p          , t3d     = t_p       , & 
@@ -297,12 +310,12 @@ subroutine driver_gwdo(itimestep,configs,mesh,sfc_input,diag_physics,tend_physic
                   var2d     = var2d_p     , oc12d     = con_p        , oa2d1   = oa1_p     , & 
                   oa2d2     = oa2_p       , oa2d3     = oa3_p        , oa2d4   = oa4_p     , &
                   ol2d1     = ol1_p       , ol2d2     = ol2_p        , ol2d3   = ol3_p     , & 
-                  ol2d4     = ol4_p       ,                                                  &
+                  ol2d4     = ol4_p       , sina      = sina_p       , cosa    = cosa_p    , &
                   ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde ,    &
                   ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme ,    &
                   its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte      &
                  )
-       call mpas_timer_stop('GWDO_YSU')
+       call mpas_timer_stop('bl_ysu_gwdo')
 
      case default
 
diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F b/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F
index c2c902d3e4..6b431b3cc5 100644
--- a/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F
+++ b/src/core_atmosphere/physics/mpas_atmphys_driver_lsm.F
@@ -12,12 +12,13 @@ module mpas_atmphys_driver_lsm
  use mpas_timer, only : mpas_timer_start, mpas_timer_stop
 
  use mpas_atmphys_constants
- use mpas_atmphys_landuse
+ use mpas_atmphys_landuse, only: isurban
  use mpas_atmphys_lsm_noahinit
  use mpas_atmphys_vars
 
 !wrf physics
  use module_sf_noahdrv
+ use module_sf_noah_seaice_drv
  use module_sf_sfcdiags
  
  implicit none
@@ -82,10 +83,16 @@ module mpas_atmphys_driver_lsm
 !   Laura D. Fowler (laura@ucar.edu) / 2016-05-11.
 ! * added the calculation of surface variables over seaice cells when config_frac_seaice is set to true.
 !   Laura D. Fowler (laura@ucar.edu) / 2016-10-03.
+! * now use isice and iswater initialized in the init file instead of initialized in mpas_atmphys_landuse.F.
+!   Laura D. Fowler (laura@ucar.edu) / 2017-01-13.
+! * updated the call to subroutine lsm as we updated the Noah LSM scheme to WRF version 3.9.0.
+!   Laura D. Fowler (laura@ucar.edu) / 2017-01-30.
 ! * since we removed the local variable lsm_scheme from mpas_atmphys_vars.F, now defines lsm_scheme as a
 !   pointer to config_lsm_scheme.
-!   Laura D. Fowler (laura@ucar.edu) / 2917-02-16.
-
+!   Laura D. Fowler (laura@ucar.edu) / 2017-02-16.
+! * added call to seaice_noah to include the parameterization of seaice for the updated Noah land surface
+!   scheme.
+!   Laura D. Fowler (laura@ucar.edu) / 2017-02-19.
 
 !
 ! DOCUMENTATION:
@@ -167,10 +174,23 @@ subroutine allocate_lsm(config_frac_seaice)
  if(.not.allocated(t2m_p)       ) allocate(t2m_p(ims:ime,jms:jme)       )
  if(.not.allocated(th2m_p)      ) allocate(th2m_p(ims:ime,jms:jme)      )
  if(.not.allocated(q2_p)        ) allocate(q2_p(ims:ime,jms:jme)        )
+ if(.not.allocated(flxsnow_p)   ) allocate(flxsnow_p(ims:ime,jms:jme)   )
+ if(.not.allocated(fvbsnow_p)   ) allocate(fvbsnow_p(ims:ime,jms:jme)   )
+ if(.not.allocated(fbursnow_p)  ) allocate(fbursnow_p(ims:ime,jms:jme)  )
+ if(.not.allocated(fgsnsnow_p)  ) allocate(fgsnsnow_p(ims:ime,jms:jme)  )
+ if(.not.allocated(frc_urb_p)   ) allocate(frc_urb_p(ims:ime,jms:jme)   )
+ if(.not.allocated(ust_urb_p)   ) allocate(ust_urb_p(ims:ime,jms:jme)   )
+ if(.not.allocated(utype_urb_p) ) allocate(utype_urb_p(ims:ime,jms:jme) )
+ if(.not.allocated(infxsrt_p)   ) allocate(infxsrt_p(ims:ime,jms:jme)   )
+ if(.not.allocated(sfcheadrt_p) ) allocate(sfcheadrt_p(ims:ime,jms:jme) )
+ if(.not.allocated(soldrain_p)  ) allocate(soldrain_p(ims:ime,jms:jme)  )
 
  if(config_frac_seaice) then
-    if(.not.allocated(tsk_sea)) allocate(tsk_sea(ims:ime,jms:jme))
-    if(.not.allocated(tsk_ice)) allocate(tsk_ice(ims:ime,jms:jme))
+    if(.not.allocated(tsk_sea)   ) allocate(tsk_sea(ims:ime,jms:jme)   )
+    if(.not.allocated(tsk_ice)   ) allocate(tsk_ice(ims:ime,jms:jme)   )
+    if(.not.allocated(albsi_p)   ) allocate(albsi_p(ims:ime,jms:jme)   )
+    if(.not.allocated(icedepth_p)) allocate(icedepth_p(ims:ime,jms:jme))
+    if(.not.allocated(snowsi_p)  ) allocate(snowsi_p(ims:ime,jms:jme)  )
  endif
 
  end subroutine allocate_lsm
@@ -242,19 +262,32 @@ subroutine deallocate_lsm(config_frac_seaice)
  if(allocated(t2m_p)       ) deallocate(t2m_p       )
  if(allocated(th2m_p)      ) deallocate(th2m_p      )
  if(allocated(q2_p)        ) deallocate(q2_p        )
+ if(allocated(flxsnow_p)   ) deallocate(flxsnow_p   )
+ if(allocated(fvbsnow_p)   ) deallocate(fvbsnow_p   )
+ if(allocated(fbursnow_p)  ) deallocate(fbursnow_p  )
+ if(allocated(fgsnsnow_p)  ) deallocate(fgsnsnow_p  )
+ if(allocated(frc_urb_p)   ) deallocate(frc_urb_p   )
+ if(allocated(ust_urb_p)   ) deallocate(ust_urb_p   )
+ if(allocated(utype_urb_p) ) deallocate(utype_urb_p )
+ if(allocated(infxsrt_p)   ) deallocate(infxsrt_p   )
+ if(allocated(sfcheadrt_p) ) deallocate(sfcheadrt_p )
+ if(allocated(soldrain_p)  ) deallocate(soldrain_p  )
 
  if(config_frac_seaice) then
-    if(allocated(chs_sea) ) deallocate(chs_sea )
-    if(allocated(chs2_sea)) deallocate(chs2_sea)
-    if(allocated(cqs2_sea)) deallocate(cqs2_sea)
-    if(allocated(cpm_sea) ) deallocate(cpm_sea )
-    if(allocated(hfx_sea) ) deallocate(hfx_sea )
-    if(allocated(qfx_sea) ) deallocate(qfx_sea )
-    if(allocated(qgh_sea) ) deallocate(qgh_sea )
-    if(allocated(qsfc_sea)) deallocate(qsfc_sea)
-    if(allocated(lh_sea)  ) deallocate(lh_sea  )
-    if(allocated(tsk_sea) ) deallocate(tsk_sea )
-    if(allocated(tsk_ice) ) deallocate(tsk_ice )
+    if(allocated(chs_sea)   ) deallocate(chs_sea   )
+    if(allocated(chs2_sea)  ) deallocate(chs2_sea  )
+    if(allocated(cqs2_sea)  ) deallocate(cqs2_sea  )
+    if(allocated(cpm_sea)   ) deallocate(cpm_sea   )
+    if(allocated(hfx_sea)   ) deallocate(hfx_sea   )
+    if(allocated(qfx_sea)   ) deallocate(qfx_sea   )
+    if(allocated(qgh_sea)   ) deallocate(qgh_sea   )
+    if(allocated(qsfc_sea)  ) deallocate(qsfc_sea  )
+    if(allocated(lh_sea)    ) deallocate(lh_sea    )
+    if(allocated(tsk_sea)   ) deallocate(tsk_sea   )
+    if(allocated(tsk_ice)   ) deallocate(tsk_ice   )
+    if(allocated(albsi_p)   ) deallocate(albsi_p   )
+    if(allocated(icedepth_p)) deallocate(icedepth_p)
+    if(allocated(snowsi_p)  ) deallocate(snowsi_p  )
  endif
 
  end subroutine deallocate_lsm
@@ -278,10 +311,11 @@ subroutine lsm_from_MPAS(configs,mesh,diag_physics,sfc_input,its,ite)
 
  integer,dimension(:),pointer:: isltyp,ivgtyp
 
- real(kind=RKIND),dimension(:),pointer  :: acsnom,acsnow,canwat,chs,chs2,chklowq,cpm,cqs2,glw, &
-                                           grdflx,gsw,hfx,lai,lh,noahres,potevp,qfx,qgh,qsfc,  &
-                                           br,sfc_albedo,sfc_emibck,sfc_emiss,sfcrunoff,       &
-                                           smstav,smstot,snotime,snopcx,sr,udrunoff,z0,znt
+ real(kind=RKIND),dimension(:),pointer  :: acsnom,acsnow,canwat,chs,chs2,chklowq,cpm,cqs2,glw,   &
+                                           grdflx,gsw,hfx,lai,lh,noahres,potevp,qfx,qgh,qsfc,    &
+                                           br,sfc_albedo,sfc_albedo_seaice,sfc_emibck,sfc_emiss, &
+                                           sfcrunoff,smstav,smstot,snotime,snopcx,sr,udrunoff,   &
+                                           z0,znt
  real(kind=RKIND),dimension(:),pointer  :: shdmin,shdmax,snoalb,sfc_albbck,snow,snowc,snowh,tmn, &
                                            skintemp,vegfra,xice,xland
  real(kind=RKIND),dimension(:),pointer  :: t2m,th2m,q2
@@ -299,60 +333,61 @@ subroutine lsm_from_MPAS(configs,mesh,diag_physics,sfc_input,its,ite)
  call mpas_pool_get_config(configs,'config_convection_scheme',config_convection_scheme)
  call mpas_pool_get_config(configs,'config_microp_scheme'    ,config_microp_scheme    )
 
- call mpas_pool_get_array(diag_physics,'acsnom'    ,acsnom    )
- call mpas_pool_get_array(diag_physics,'acsnow'    ,acsnow    )
- call mpas_pool_get_array(diag_physics,'canwat'    ,canwat    )
- call mpas_pool_get_array(diag_physics,'chs'       ,chs       )
- call mpas_pool_get_array(diag_physics,'chs2'      ,chs2      )
- call mpas_pool_get_array(diag_physics,'chklowq'   ,chklowq   )
- call mpas_pool_get_array(diag_physics,'cpm'       ,cpm       )
- call mpas_pool_get_array(diag_physics,'cqs2'      ,cqs2      )
- call mpas_pool_get_array(diag_physics,'glw'       ,glw       )
- call mpas_pool_get_array(diag_physics,'grdflx'    ,grdflx    )
- call mpas_pool_get_array(diag_physics,'gsw'       ,gsw       )
- call mpas_pool_get_array(diag_physics,'hfx'       ,hfx       )
- call mpas_pool_get_array(diag_physics,'lai'       ,lai       )
- call mpas_pool_get_array(diag_physics,'lh'        ,lh        )
- call mpas_pool_get_array(diag_physics,'noahres'   ,noahres   )
- call mpas_pool_get_array(diag_physics,'potevp'    ,potevp    )
- call mpas_pool_get_array(diag_physics,'qfx'       ,qfx       )
- call mpas_pool_get_array(diag_physics,'qgh'       ,qgh       )
- call mpas_pool_get_array(diag_physics,'qsfc'      ,qsfc      )
- call mpas_pool_get_array(diag_physics,'br'        ,br        )
- call mpas_pool_get_array(diag_physics,'sfc_albedo',sfc_albedo)
- call mpas_pool_get_array(diag_physics,'sfc_emibck',sfc_emibck)
- call mpas_pool_get_array(diag_physics,'sfc_emiss' ,sfc_emiss )
- call mpas_pool_get_array(diag_physics,'sfcrunoff' ,sfcrunoff )
- call mpas_pool_get_array(diag_physics,'smstav'    ,smstav    )
- call mpas_pool_get_array(diag_physics,'smstot'    ,smstot    )
- call mpas_pool_get_array(diag_physics,'snotime'   ,snotime   )
- call mpas_pool_get_array(diag_physics,'snopcx'    ,snopcx    )
- call mpas_pool_get_array(diag_physics,'udrunoff'  ,udrunoff  )
- call mpas_pool_get_array(diag_physics,'z0'        ,z0        )
- call mpas_pool_get_array(diag_physics,'znt'       ,znt       )
- call mpas_pool_get_array(diag_physics,'t2m'       ,t2m       )
- call mpas_pool_get_array(diag_physics,'th2m'      ,th2m      )
- call mpas_pool_get_array(diag_physics,'q2'        ,q2        )
-
- call mpas_pool_get_array(sfc_input,'isltyp'       ,isltyp    )
- call mpas_pool_get_array(sfc_input,'ivgtyp'       ,ivgtyp    )
- call mpas_pool_get_array(sfc_input,'shdmin'       ,shdmin    )
- call mpas_pool_get_array(sfc_input,'shdmax'       ,shdmax    )
- call mpas_pool_get_array(sfc_input,'snoalb'       ,snoalb    )
- call mpas_pool_get_array(sfc_input,'sfc_albbck'   ,sfc_albbck)
- call mpas_pool_get_array(sfc_input,'snow'         ,snow      )
- call mpas_pool_get_array(sfc_input,'snowc'        ,snowc     )
- call mpas_pool_get_array(sfc_input,'snowh'        ,snowh     )
- call mpas_pool_get_array(sfc_input,'tmn'          ,tmn       )
- call mpas_pool_get_array(sfc_input,'skintemp'     ,skintemp  )
- call mpas_pool_get_array(sfc_input,'vegfra'       ,vegfra    )
- call mpas_pool_get_array(sfc_input,'xice'         ,xice      )
- call mpas_pool_get_array(sfc_input,'xland'        ,xland     )
- call mpas_pool_get_array(sfc_input,'dzs'          ,dzs       )
- call mpas_pool_get_array(sfc_input,'sh2o'         ,sh2o      )
- call mpas_pool_get_array(sfc_input,'smcrel'       ,smcrel    )
- call mpas_pool_get_array(sfc_input,'smois'        ,smois     )
- call mpas_pool_get_array(sfc_input,'tslb'         ,tslb      )
+ call mpas_pool_get_array(diag_physics,'acsnom'           ,acsnom           )
+ call mpas_pool_get_array(diag_physics,'acsnow'           ,acsnow           )
+ call mpas_pool_get_array(diag_physics,'canwat'           ,canwat           )
+ call mpas_pool_get_array(diag_physics,'chs'              ,chs              )
+ call mpas_pool_get_array(diag_physics,'chs2'             ,chs2             )
+ call mpas_pool_get_array(diag_physics,'chklowq'          ,chklowq          )
+ call mpas_pool_get_array(diag_physics,'cpm'              ,cpm              )
+ call mpas_pool_get_array(diag_physics,'cqs2'             ,cqs2             )
+ call mpas_pool_get_array(diag_physics,'glw'              ,glw              )
+ call mpas_pool_get_array(diag_physics,'grdflx'           ,grdflx           )
+ call mpas_pool_get_array(diag_physics,'gsw'              ,gsw              )
+ call mpas_pool_get_array(diag_physics,'hfx'              ,hfx              )
+ call mpas_pool_get_array(diag_physics,'lai'              ,lai              )
+ call mpas_pool_get_array(diag_physics,'lh'               ,lh               )
+ call mpas_pool_get_array(diag_physics,'noahres'          ,noahres          )
+ call mpas_pool_get_array(diag_physics,'potevp'           ,potevp           )
+ call mpas_pool_get_array(diag_physics,'qfx'              ,qfx              )
+ call mpas_pool_get_array(diag_physics,'qgh'              ,qgh              )
+ call mpas_pool_get_array(diag_physics,'qsfc'             ,qsfc             )
+ call mpas_pool_get_array(diag_physics,'br'               ,br               )
+ call mpas_pool_get_array(diag_physics,'sfc_albedo'       ,sfc_albedo       )
+ call mpas_pool_get_array(diag_physics,'sfc_albedo_seaice',sfc_albedo_seaice)
+ call mpas_pool_get_array(diag_physics,'sfc_emibck'       ,sfc_emibck       )
+ call mpas_pool_get_array(diag_physics,'sfc_emiss'        ,sfc_emiss        )
+ call mpas_pool_get_array(diag_physics,'sfcrunoff'        ,sfcrunoff        )
+ call mpas_pool_get_array(diag_physics,'smstav'           ,smstav           )
+ call mpas_pool_get_array(diag_physics,'smstot'           ,smstot           )
+ call mpas_pool_get_array(diag_physics,'snotime'          ,snotime          )
+ call mpas_pool_get_array(diag_physics,'snopcx'           ,snopcx           )
+ call mpas_pool_get_array(diag_physics,'udrunoff'         ,udrunoff         )
+ call mpas_pool_get_array(diag_physics,'z0'               ,z0               )
+ call mpas_pool_get_array(diag_physics,'znt'              ,znt              )
+ call mpas_pool_get_array(diag_physics,'t2m'              ,t2m              )
+ call mpas_pool_get_array(diag_physics,'th2m'             ,th2m             )
+ call mpas_pool_get_array(diag_physics,'q2'               ,q2               )
+
+ call mpas_pool_get_array(sfc_input,'isltyp'    ,isltyp    )
+ call mpas_pool_get_array(sfc_input,'ivgtyp'    ,ivgtyp    )
+ call mpas_pool_get_array(sfc_input,'shdmin'    ,shdmin    )
+ call mpas_pool_get_array(sfc_input,'shdmax'    ,shdmax    )
+ call mpas_pool_get_array(sfc_input,'snoalb'    ,snoalb    )
+ call mpas_pool_get_array(sfc_input,'sfc_albbck',sfc_albbck)
+ call mpas_pool_get_array(sfc_input,'snow'      ,snow      )
+ call mpas_pool_get_array(sfc_input,'snowc'     ,snowc     )
+ call mpas_pool_get_array(sfc_input,'snowh'     ,snowh     )
+ call mpas_pool_get_array(sfc_input,'tmn'       ,tmn       )
+ call mpas_pool_get_array(sfc_input,'skintemp'  ,skintemp  )
+ call mpas_pool_get_array(sfc_input,'vegfra'    ,vegfra    )
+ call mpas_pool_get_array(sfc_input,'xice'      ,xice      )
+ call mpas_pool_get_array(sfc_input,'xland'     ,xland     )
+ call mpas_pool_get_array(sfc_input,'dzs'       ,dzs       )
+ call mpas_pool_get_array(sfc_input,'sh2o'      ,sh2o      )
+ call mpas_pool_get_array(sfc_input,'smcrel'    ,smcrel    )
+ call mpas_pool_get_array(sfc_input,'smois'     ,smois     )
+ call mpas_pool_get_array(sfc_input,'tslb'      ,tslb      )
 
 !In Registry.xml, dzs is a function of nCells. In the Noah lsm scheme, dzs is independent
 !of cell locations:
@@ -423,14 +458,31 @@ subroutine lsm_from_MPAS(configs,mesh,diag_physics,sfc_input,its,ite)
     xice_p(i,j)       = xice(i)
     xland_p(i,j)      = xland(i)
 
-    qz0_p(i,j) = 0._RKIND
+    qz0_p(i,j)        = 0._RKIND
+
+    !initialization of arrays to run the UA Noah LSM snow cover parameterization:
+    flxsnow_p(i,j)    = 0._RKIND
+    fvbsnow_p(i,j)    = 0._RKIND
+    fbursnow_p(i,j)   = 0._RKIND
+    fgsnsnow_p(i,j)   = 0._RKIND
+
+    !initialization of arrays to run the Noah LSM urban parameterization (not currently
+    frc_urb_p(i,j)    = 0._RKIND
+    ust_urb_p(i,j)    = 0._RKIND
+    utype_urb_p(i,j)  = low_density_residential
+
+    !initialization of arrays to run the Noah LSM hydrological parameterization (not currently
+    !implemented in MPAS):
+    infxsrt_p(i,j)    = 0._RKIND
+    sfcheadrt_p(i,j)  = 0._RKIND
+    soldrain_p(i,j)   = 0._RKIND
  enddo
  enddo
 
-!modify the surface albedo and surface emissivity, and surface temperatures over sea-ice points:
  if(config_frac_seaice) then
     do j = jts,jte
     do i = its,ite
+       !modify the surface albedo and surface emissivity, and surface temperatures over sea-ice points:
        if(xice(i).ge.xice_threshold .and. xice(i).le.1._RKIND) then
           sfc_albedo_p(i,j) = (sfc_albedo(i) - 0.08_RKIND*(1._RKIND-xice(i))) / xice(i)
           sfc_emiss_p(i,j)  = (sfc_emiss(i) - 0.98_RKIND*(1._RKIND-xice(i))) / xice(i)
@@ -450,6 +502,16 @@ subroutine lsm_from_MPAS(configs,mesh,diag_physics,sfc_input,its,ite)
        tsk_p(i,j) = tsk_ice(i,j)
     enddo
     enddo
+
+    !initialize the surface albedo, the surface albedo over snow-covered seaice, and the
+    !seaice thickness.
+    do j = jts,jte
+    do i = its,ite
+       albsi_p(i,j)    = sfc_albedo_seaice(i)
+       icedepth_p(i,j) = seaice_thickness_default
+       snowsi_p(i,j)   = seaice_snowdepth_min
+    enddo
+    enddo
  endif
 
  do j = jts,jte
@@ -723,20 +785,24 @@ subroutine driver_lsm(itimestep,configs,mesh,diag_physics,sfc_input,its,ite)
  type(mpas_pool_type),intent(inout):: sfc_input
 
 !local pointers:
- logical,pointer:: config_sfc_albedo
+ logical,pointer:: config_sfc_albedo,config_frac_seaice
  character(len=StrKIND),pointer:: lsm_scheme
  character(len=StrKIND),pointer:: mminlu
+ integer,pointer:: isice
 
 !-----------------------------------------------------------------------------------------------------------------
 !call mpas_log_write('')
 !call mpas_log_write('--- enter subroutine driver_lsm:')
 
- call mpas_pool_get_config(configs,'config_sfc_albedo',config_sfc_albedo)
+ call mpas_pool_get_config(configs,'config_sfc_albedo' ,config_sfc_albedo )
+ call mpas_pool_get_config(configs,'config_frac_seaice',config_frac_seaice)
  call mpas_pool_get_config(configs,'config_lsm_scheme',lsm_scheme)
  call mpas_pool_get_array(sfc_input,'mminlu',mminlu)
+ call mpas_pool_get_array(sfc_input,'isice' ,isice )
 
 !copy MPAS arrays to local arrays:
  call lsm_from_MPAS(configs,mesh,diag_physics,sfc_input,its,ite)
+!write(0,*) '--- end lsm_from_MPAS'
 
 !call to land-surface scheme:
  lsm_select: select case (trim(lsm_scheme))
@@ -744,47 +810,85 @@ subroutine driver_lsm(itimestep,configs,mesh,diag_physics,sfc_input,its,ite)
     case("noah")
        call mpas_timer_start('Noah')
        call lsm( &
-                dz8w      = dz_p      , p8w3d     = pres2_hyd_p  , t3d       = t_p          , &  
-                qv3d      = qv_p      , xland     = xland_p      , xice      = xice_p       , &
-                ivgtyp    = ivgtyp_p  , isltyp    = isltyp_p     , tmn       = tmn_p        , &
-                vegfra    = vegfra_p  , shdmin    = shdmin_p     , shdmax    = shdmax_p     , &
-                snoalb    = snoalb_p  , glw       = glw_p        , gsw       = gsw_p        , &
-                swdown    = swdown_p  , rainbl    = rainbl_p     , embck     = sfc_emibck_p , & 
-                sr        = sr_p      , qgh       = qgh_p        , cpm       = cpm_p        , &
-                qz0       = qz0_p     , tsk       = tsk_p        , hfx       = hfx_p        , & 
-                qfx       = qfx_p     , lh        = lh_p         , grdflx    = grdflx_p     , &
-                qsfc      = qsfc_p    , cqs2      = cqs2_p       , chs       = chs_p        , &
-                chs2      = chs2_p    , snow      = snow_p       , snowc     = snowc_p      , &
-                snowh     = snowh_p   , canwat    = canwat_p     , smstav    = smstav_p     , &
-                smstot    = smstot_p  , sfcrunoff = sfcrunoff_p  , udrunoff  = udrunoff_p   , &               
-                acsnom    = acsnom_p  , acsnow    = acsnow_p     , snotime   = snotime_p    , &
-                snopcx    = snopcx_p  , emiss     = sfc_emiss_p  , rib       = br_p         , &
-                potevp    = potevp_p  , albedo    = sfc_albedo_p , albbck    = sfc_albbck_p , &
-                z0        = z0_p      , znt       = znt_p        , lai       = lai_p        , &
-                noahres   = noahres_p , chklowq   = chklowq_p    , sh2o      = sh2o_p       , &
-                smois     = smois_p   , tslb      = tslb_p       , smcrel    = smcrel_p     , &
-                dzs       = dzs_p     , isurban   = isurban      , isice     = isice        , &                
-                rovcp     = rcp       , dt        = dt_pbl       , myj       = myj          , &
-                itimestep = itimestep , frpcpn    = frpcpn       , rdlai2d   = rdlai2d      , &
-                xice_threshold   = xice_threshold    ,                                        &
-                usemonalb        = config_sfc_albedo ,                                        &
-                mminlu           = mminlu ,                                                   &
-                num_soil_layers  = num_soils    ,                                             &         
-                num_roof_layers  = num_soils    ,                                             &
-                num_wall_layers  = num_soils    ,                                             &
-                num_road_layers  = num_soils    ,                                             &
-                num_urban_layers = num_soils    ,                                             &
-                sf_urban_physics = sf_urban_physics   ,                                       &
-                ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde ,       &
-                ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme ,       &
-                its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte         &
+                dz8w        = dz_p        , p8w3d       = pres2_hyd_p  , t3d       = t_p          , &
+                qv3d        = qv_p        , xland       = xland_p      , xice      = xice_p       , &
+                ivgtyp      = ivgtyp_p    , isltyp      = isltyp_p     , tmn       = tmn_p        , &
+                vegfra      = vegfra_p    , shdmin      = shdmin_p     , shdmax    = shdmax_p     , &
+                snoalb      = snoalb_p    , glw         = glw_p        , gsw       = gsw_p        , &
+                swdown      = swdown_p    , rainbl      = rainbl_p     , embck     = sfc_emibck_p , &
+                sr          = sr_p        , qgh         = qgh_p        , cpm       = cpm_p        , &
+                qz0         = qz0_p       , tsk         = tsk_p        , hfx       = hfx_p        , &
+                qfx         = qfx_p       , lh          = lh_p         , grdflx    = grdflx_p     , &
+                qsfc        = qsfc_p      , cqs2        = cqs2_p       , chs       = chs_p        , &
+                chs2        = chs2_p      , snow        = snow_p       , snowc     = snowc_p      , &
+                snowh       = snowh_p     , canwat      = canwat_p     , smstav    = smstav_p     , &
+                smstot      = smstot_p    , sfcrunoff   = sfcrunoff_p  , udrunoff  = udrunoff_p   , &
+                acsnom      = acsnom_p    , acsnow      = acsnow_p     , snotime   = snotime_p    , &
+                snopcx      = snopcx_p    , emiss       = sfc_emiss_p  , rib       = br_p         , &
+                potevp      = potevp_p    , albedo      = sfc_albedo_p , albbck    = sfc_albbck_p , &
+                z0          = z0_p        , znt         = znt_p        , lai       = lai_p        , &
+                noahres     = noahres_p   , chklowq     = chklowq_p    , sh2o      = sh2o_p       , &
+                smois       = smois_p     , tslb        = tslb_p       , smcrel    = smcrel_p     , &
+                dzs         = dzs_p       , isurban     = isurban      , isice     = isice        , &
+                rovcp       = rcp         , dt          = dt_pbl       , myj       = myj          , &
+                itimestep   = itimestep   , frpcpn      = frpcpn       , rdlai2d   = rdlai2d      , &
+                opt_thcnd   = opt_thcnd   , ua_phys     = ua_phys      , flx4_2d   = flxsnow_p    , &
+                fvb_2d      = fvbsnow_p   , fbur_2d     = fbursnow_p   , fgsn_2d   = fgsnsnow_p   , &
+                utype_urb2d = utype_urb_p , frc_urb2d   = frc_urb_p    , ust_urb2d = ust_urb_p    , &
+                infxsrt     = infxsrt_p   , sfcheadrt   = sfcheadrt_p  , soldrain  = soldrain_p   , &
+                fasdas      = fasdas      , julian      = 0            , julyr     = 0            , &
+                xice_threshold   = xice_threshold    ,                                              &
+                usemonalb        = config_sfc_albedo ,                                              &
+                mminlu           = mminlu ,                                                         &
+                num_soil_layers  = num_soils ,                                                      &
+                num_roof_layers  = num_soils ,                                                      &
+                num_wall_layers  = num_soils ,                                                      &
+                num_road_layers  = num_soils ,                                                      &
+                num_urban_layers = num_soils ,                                                      &
+                num_urban_hi     = num_soils ,                                                      &
+                sf_urban_physics = sf_urban_physics ,                                               &
+                ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde ,             &
+                ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme ,             &
+                its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte               &
                )
 
+       if(config_frac_seaice) then
+          call seaice_noah( &
+                dz8w      = dz_p        , p8w3d   = pres2_hyd_p  , t3d      = t_p      , &
+                qv3d      = qv_p        , xice    = xice_p       , snoalb2d = snoalb_p , &
+                glw       = glw_p       , swdown  = swdown_p     , rainbl   = rainbl_p , &
+                sr        = sr_p        , qgh     = qgh_p        , tsk      = tsk_p    , &
+                hfx       = hfx_p       , qfx     = qfx_p        , lh       = lh_p     , &
+                grdflx    = grdflx_p    , potevp  = potevp_p     , qsfc     = qsfc_p   , &
+                emiss     = sfc_emiss_p , albedo  = sfc_albedo_p , rib      = br_p     , &
+                cqs2      = cqs2_p      , chs     = chs_p        , chs2     = chs2_p   , &
+                z02d      = z0_p        , znt     = znt_p        , tslb     = tslb_p   , &
+                snow      = snow_p      , snowc   = snowc_p      , snowh2d  = snowh_p  , &
+                snopcx    = snopcx_p    , acsnow  = acsnow_p     , acsnom   = acsnom_p , &
+                sfcrunoff = sfcrunoff_p , albsi   = albsi_p      , snowsi   = snowsi_p , &
+                icedepth  = icedepth_p  , noahres = noahres_p    , dt       = dt_pbl   , &
+                frpcpn    = frpcpn      ,                                                &
+                seaice_albedo_opt        = seaice_albedo_opt        ,                    &
+                seaice_albedo_default    = seaice_albedo_default    ,                    &
+                seaice_thickness_opt     = seaice_thickness_opt     ,                    &
+                seaice_thickness_default = seaice_thickness_default ,                    &
+                seaice_snowdepth_opt     = seaice_snowdepth_opt     ,                    &
+                seaice_snowdepth_max     = seaice_snowdepth_max     ,                    &
+                seaice_snowdepth_min     = seaice_snowdepth_min     ,                    &
+                xice_threshold           = xice_threshold           ,                    &
+                num_soil_layers          = num_soils                ,                    &
+                sf_urban_physics         = sf_urban_physics         ,                    &
+                ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde ,  &
+                ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme ,  &
+                its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte    &
+                          )
+       endif
+
        call sfcdiags( &
                 hfx   = hfx_p  , qfx     = qfx_p   , tsk  = tsk_p , qsfc = qsfc_p , chs = chs_p , &
                 chs2  = chs2_p , cqs2    = cqs2_p  , t2   = t2m_p , th2  = th2m_p , q2  = q2_p  , &
                 psfc  = psfc_p , t3d     = t_p     , qv3d = qv_p  , cp   = cp     , R_d = R_d   , &
-                rovcp = rcp    , ua_phys = ua_phys                                              , & 
+                rovcp = rcp    , ua_phys = ua_phys                                              , &
                 ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde ,           &
                 ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme ,           &
                 its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte             &
diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F b/src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F
index 75d075ac3f..437d1525d1 100644
--- a/src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F
+++ b/src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F
@@ -66,6 +66,9 @@ module mpas_atmphys_driver_pbl
 ! * since we removed the local variable pbl_scheme from mpas_atmphys_vars.F, now defines pbl_scheme as a pointer
 !   to config_pbl_scheme.
 !   Laura D. Fowler (laura@ucar.edu) / 2917-02-16.
+! * after updating module_bl_ysu.F to WRF version 4.0.3, corrected call to subroutine ysu to output diagnostics of
+!   exchange coefficients exch_h and exch_m.
+!   Laura D. Fowler (laura@ucar.edu) / 2019-03-12.
 
 
  contains
@@ -508,7 +511,7 @@ subroutine pbl_to_MPAS(configs,diag_physics,tend_physics,its,ite)
 
     kzh(k,i) = kzh_p(i,k,j)
     kzm(k,i) = kzm_p(i,k,j)
-    kzq(k,i) = kzq_p(i,k,j)
+    kzq(k,i) = kzh_p(i,k,j)
  enddo
  enddo
  enddo
@@ -626,12 +629,11 @@ subroutine driver_pbl(itimestep,configs,mesh,sfc_input,diag_physics,tend_physics
                  ust      = ust_p      , hpbl     = hpbl_p      , psim     = psim_p     , &
                  psih     = psih_p     , xland    = xland_p     , hfx      = hfx_p      , &
                  qfx      = qfx_p      , wspd     = wspd_p      , br       = br_p       , &
-                 dt       = dt_pbl     , kpbl2d   = kpbl_p      , exch_h   = exch_p     , &
-                 wstar    = wstar_p    , delta    = delta_p     , uoce     = uoce_p     , &
-                 voce     = voce_p     , rthraten = rthraten_p  , u10      = u10_p      , &
-                 v10      = v10_p      , ctopo    = ctopo_p     , ctopo2   = ctopo2_p   , &
-                 regime   = regime_p   , rho      = rho_p       , kzhout   = kzh_p      , &
-                 kzmout   = kzm_p      , kzqout   = kzq_p       ,                         & 
+                 dt       = dt_pbl     , kpbl2d   = kpbl_p      , exch_h   = kzh_p      , &
+                 exch_m   = kzm_p      , wstar    = wstar_p     , delta    = delta_p    , &
+                 uoce     = uoce_p     , voce     = voce_p      , rthraten = rthraten_p , &
+                 u10      = u10_p      , v10      = v10_p       , ctopo    = ctopo_p    , &
+                 ctopo2   = ctopo2_p   , regime   = regime_p    ,                         &
                  ysu_topdown_pblmix = ysu_pblmix ,                                        &
                  ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde  , &
                  ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme  , &
diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F b/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F
index afe42154d8..c5ace58d06 100644
--- a/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F
+++ b/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F
@@ -871,14 +871,13 @@ subroutine driver_sfclayer(itimestep,configs,mesh,diag_physics,sfc_input,its,ite
                    rmol     = rmol_p     , u10      = u10_p      , v10      = v10_p      , &
                    th2      = th2m_p     , t2       = t2m_p      , q2       = q2_p       , &
                    gz1oz0   = gz1oz0_p   , wspd     = wspd_p     , br       = br_p       , &
-                   isfflx   = isfflx     , dx       = dx         , svp1     = svp1       , &
+                   isfflx   = isfflx     , dx       = dx_p       , svp1     = svp1       , &
                    svp2     = svp2       , svp3     = svp3       , svpt0    = svpt0      , &
                    ep1      = ep_1       , ep2      = ep_2       , karman   = karman     , &
                    eomeg    = eomeg      , stbolt   = stbolt     , P1000mb  = P0         , &
-                   dxCell   = dx_p       , ustm     = ustm_p     , ck       = ck_p       , & 
-                   cka      = cka_p      , cd       = cd_p       , cda      = cda_p      , & 
-                   isftcflx = isftcflx   , iz0tlnd  = iz0tlnd    ,                         &
-                   scm_force_flux = scm_force_flux               ,                         & 
+                   ustm     = ustm_p     , ck       = ck_p       , cka      = cka_p      , &
+                   cd       = cd_p       , cda      = cda_p      , isftcflx = isftcflx   , &
+                   iz0tlnd  = iz0tlnd    , scm_force_flux = scm_force_flux               , &
                    ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
                    ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
                    its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte   &
@@ -901,14 +900,13 @@ subroutine driver_sfclayer(itimestep,configs,mesh,diag_physics,sfc_input,its,ite
                       rmol     = rmol_sea   , u10      = u10_sea    , v10      = v10_sea    , &
                       th2      = th2m_sea   ,  t2      = t2m_sea    , q2       = q2_sea     , &
                       gz1oz0   = gz1oz0_sea , wspd     = wspd_sea   , br       = br_sea     , &
-                      isfflx   = isfflx     , dx       = dx         , svp1     = svp1       , &
+                      isfflx   = isfflx     , dx       = dx_p       , svp1     = svp1       , &
                       svp2     = svp2       , svp3     = svp3       , svpt0    = svpt0      , &
                       ep1      = ep_1       , ep2      = ep_2       , karman   = karman     , &
                       eomeg    = eomeg      , stbolt   = stbolt     , P1000mb  = P0         , &
-                      dxCell   = dx_p       , ustm     = ustm_sea   , ck       = ck_sea     , &
-                      cka      = cka_sea    , cd       = cd_sea     , cda      = cda_sea    , &
-                      isftcflx = isftcflx   , iz0tlnd  = iz0tlnd    ,                         &
-                      scm_force_flux = scm_force_flux               ,                         &
+                      ustm     = ustm_sea   , ck       = ck_sea     , cka      = cka_sea    , &
+                      cd       = cd_sea     , cda      = cda_sea    , isftcflx = isftcflx   , &
+                      iz0tlnd  = iz0tlnd    , scm_force_flux = scm_force_flux               , &
                       ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
                       ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
                       its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte   &
diff --git a/src/core_atmosphere/physics/mpas_atmphys_functions.F b/src/core_atmosphere/physics/mpas_atmphys_functions.F
index e2980bbb3f..bbc5922667 100644
--- a/src/core_atmosphere/physics/mpas_atmphys_functions.F
+++ b/src/core_atmosphere/physics/mpas_atmphys_functions.F
@@ -8,6 +8,7 @@
 !=================================================================================================================
  module mpas_atmphys_functions
 
+ use mpas_kind_types, only : RKIND
  use mpas_derived_types, only : MPAS_LOG_ERR
  use mpas_log, only : mpas_log_write
 
@@ -34,12 +35,12 @@ SUBROUTINE GCF(GAMMCF,A,X,GLN)
 !     --- USES GAMMLN
       IMPLICIT NONE
       INTEGER, PARAMETER:: ITMAX=100
-      REAL, PARAMETER:: gEPS=3.E-7
-      REAL, PARAMETER:: FPMIN=1.E-30
-      REAL, INTENT(IN):: A, X
-      REAL:: GAMMCF,GLN
+      REAL(KIND=RKIND), PARAMETER:: gEPS=3.E-7
+      REAL(KIND=RKIND), PARAMETER:: FPMIN=1.E-30
+      REAL(KIND=RKIND), INTENT(IN):: A, X
+      REAL(KIND=RKIND):: GAMMCF,GLN
       INTEGER:: I
-      REAL:: AN,B,C,D,DEL,H
+      REAL(KIND=RKIND):: AN,B,C,D,DEL,H
       GLN=GAMMLN(A)
       B=X+1.-A
       C=1./FPMIN
@@ -69,11 +70,11 @@ SUBROUTINE GSER(GAMSER,A,X,GLN)
 !     --- USES GAMMLN
       IMPLICIT NONE
       INTEGER, PARAMETER:: ITMAX=100
-      REAL, PARAMETER:: gEPS=3.E-7
-      REAL, INTENT(IN):: A, X
-      REAL:: GAMSER,GLN
+      REAL(KIND=RKIND), PARAMETER:: gEPS=3.E-7
+      REAL(KIND=RKIND), INTENT(IN):: A, X
+      REAL(KIND=RKIND):: GAMSER,GLN
       INTEGER:: N
-      REAL:: AP,DEL,SUM
+      REAL(KIND=RKIND):: AP,DEL,SUM
       GLN=GAMMLN(A)
       IF(X.LE.0.)THEN
         IF(X.LT.0.) CALL MPAS_LOG_WRITE('X < 0 IN GSER', MESSAGETYPE=MPAS_LOG_ERR)
@@ -94,10 +95,10 @@ SUBROUTINE GSER(GAMSER,A,X,GLN)
       END SUBROUTINE GSER
 !  (C) Copr. 1986-92 Numerical Recipes Software 2.02
 !+---+-----------------------------------------------------------------+
-      REAL FUNCTION GAMMLN(XX)
+      REAL(KIND=RKIND) FUNCTION GAMMLN(XX)
 !     --- RETURNS THE VALUE LN(GAMMA(XX)) FOR XX > 0.
       IMPLICIT NONE
-      REAL, INTENT(IN):: XX
+      REAL(KIND=RKIND), INTENT(IN):: XX
       DOUBLE PRECISION, PARAMETER:: STP = 2.5066282746310005D0
       DOUBLE PRECISION, DIMENSION(6), PARAMETER:: &
                COF = (/76.18009172947146D0, -86.50532032941677D0, &
@@ -119,13 +120,13 @@ REAL FUNCTION GAMMLN(XX)
       END FUNCTION GAMMLN
 !  (C) Copr. 1986-92 Numerical Recipes Software 2.02
 !+---+-----------------------------------------------------------------+
-      REAL FUNCTION GAMMP(A,X)
+      REAL(KIND=RKIND) FUNCTION GAMMP(A,X)
 !     --- COMPUTES THE INCOMPLETE GAMMA FUNCTION P(A,X)
 !     --- SEE ABRAMOWITZ AND STEGUN 6.5.1
 !     --- USES GCF,GSER
       IMPLICIT NONE
-      REAL, INTENT(IN):: A,X
-      REAL:: GAMMCF,GAMSER,GLN
+      REAL(KIND=RKIND), INTENT(IN):: A,X
+      REAL(KIND=RKIND):: GAMMCF,GAMSER,GLN
       GAMMP = 0.
       IF((X.LT.0.) .OR. (A.LE.0.)) THEN
         CALL MPAS_LOG_WRITE('BAD ARGUMENTS IN GAMMP', MESSAGETYPE=MPAS_LOG_ERR)
@@ -140,10 +141,10 @@ REAL FUNCTION GAMMP(A,X)
       END FUNCTION GAMMP
 !  (C) Copr. 1986-92 Numerical Recipes Software 2.02
 !+---+-----------------------------------------------------------------+
-      REAL FUNCTION WGAMMA(y)
+      REAL(KIND=RKIND) FUNCTION WGAMMA(y)
 
       IMPLICIT NONE
-      REAL, INTENT(IN):: y
+      REAL(KIND=RKIND), INTENT(IN):: y
 
       WGAMMA = EXP(GAMMLN(y))
 
@@ -152,20 +153,20 @@ END FUNCTION WGAMMA
 ! THIS FUNCTION CALCULATES THE LIQUID SATURATION VAPOR MIXING RATIO AS
 ! A FUNCTION OF TEMPERATURE AND PRESSURE
 !
-      REAL FUNCTION RSLF(P,T)
+      REAL(KIND=RKIND) FUNCTION RSLF(P,T)
 
       IMPLICIT NONE
-      REAL, INTENT(IN):: P, T
-      REAL:: ESL,X
-      REAL, PARAMETER:: C0= .611583699E03
-      REAL, PARAMETER:: C1= .444606896E02
-      REAL, PARAMETER:: C2= .143177157E01
-      REAL, PARAMETER:: C3= .264224321E-1
-      REAL, PARAMETER:: C4= .299291081E-3
-      REAL, PARAMETER:: C5= .203154182E-5
-      REAL, PARAMETER:: C6= .702620698E-8
-      REAL, PARAMETER:: C7= .379534310E-11
-      REAL, PARAMETER:: C8=-.321582393E-13
+      REAL(KIND=RKIND), INTENT(IN):: P, T
+      REAL(KIND=RKIND):: ESL,X
+      REAL(KIND=RKIND), PARAMETER:: C0= .611583699E03
+      REAL(KIND=RKIND), PARAMETER:: C1= .444606896E02
+      REAL(KIND=RKIND), PARAMETER:: C2= .143177157E01
+      REAL(KIND=RKIND), PARAMETER:: C3= .264224321E-1
+      REAL(KIND=RKIND), PARAMETER:: C4= .299291081E-3
+      REAL(KIND=RKIND), PARAMETER:: C5= .203154182E-5
+      REAL(KIND=RKIND), PARAMETER:: C6= .702620698E-8
+      REAL(KIND=RKIND), PARAMETER:: C7= .379534310E-11
+      REAL(KIND=RKIND), PARAMETER:: C8=-.321582393E-13
 
       X=MAX(-80.,T-273.16)
 
@@ -187,20 +188,20 @@ END FUNCTION RSLF
 ! THIS FUNCTION CALCULATES THE ICE SATURATION VAPOR MIXING RATIO AS A
 ! FUNCTION OF TEMPERATURE AND PRESSURE
 !
-      REAL FUNCTION RSIF(P,T)
+      REAL(KIND=RKIND) FUNCTION RSIF(P,T)
 
       IMPLICIT NONE
-      REAL, INTENT(IN):: P, T
-      REAL:: ESI,X
-      REAL, PARAMETER:: C0= .609868993E03
-      REAL, PARAMETER:: C1= .499320233E02
-      REAL, PARAMETER:: C2= .184672631E01
-      REAL, PARAMETER:: C3= .402737184E-1
-      REAL, PARAMETER:: C4= .565392987E-3
-      REAL, PARAMETER:: C5= .521693933E-5
-      REAL, PARAMETER:: C6= .307839583E-7
-      REAL, PARAMETER:: C7= .105785160E-9
-      REAL, PARAMETER:: C8= .161444444E-12
+      REAL(KIND=RKIND), INTENT(IN):: P, T
+      REAL(KIND=RKIND):: ESI,X
+      REAL(KIND=RKIND), PARAMETER:: C0= .609868993E03
+      REAL(KIND=RKIND), PARAMETER:: C1= .499320233E02
+      REAL(KIND=RKIND), PARAMETER:: C2= .184672631E01
+      REAL(KIND=RKIND), PARAMETER:: C3= .402737184E-1
+      REAL(KIND=RKIND), PARAMETER:: C4= .565392987E-3
+      REAL(KIND=RKIND), PARAMETER:: C5= .521693933E-5
+      REAL(KIND=RKIND), PARAMETER:: C6= .307839583E-7
+      REAL(KIND=RKIND), PARAMETER:: C7= .105785160E-9
+      REAL(KIND=RKIND), PARAMETER:: C8= .161444444E-12
 
       X=MAX(-80.,T-273.16)
       ESI=C0+X*(C1+X*(C2+X*(C3+X*(C4+X*(C5+X*(C6+X*(C7+X*C8)))))))
diff --git a/src/core_atmosphere/physics/mpas_atmphys_initialize_real.F b/src/core_atmosphere/physics/mpas_atmphys_initialize_real.F
index 303c1ce337..eae7dd844d 100644
--- a/src/core_atmosphere/physics/mpas_atmphys_initialize_real.F
+++ b/src/core_atmosphere/physics/mpas_atmphys_initialize_real.F
@@ -49,6 +49,9 @@ module mpas_atmphys_initialize_real
 ! * In subroutine physics_init_seaice, assign the sea-ice land use category as a function of
 !   the land use category input file (MODIS OR USGS).
 !   Dominikus Heinzeller (IMK) / 2014-07-24.
+! * In subroutine physics_init_seaice, removed the initialization of isice_lu since it is now defined in
+!   Registry.xml and initialized in subroutine init_atm_static.
+!   Laura D. Fowler (laura@ucar.edu) / 2017-01-12.
 
 
  contains
@@ -600,7 +603,7 @@ subroutine physics_init_seaice(mesh, input, dims, configs)
 
  logical, pointer :: config_frac_seaice
  character(len=StrKIND),pointer:: config_landuse_data
- integer:: isice_lu
+ integer,pointer:: isice_lu
 
 !note that this threshold is also defined in module_physics_vars.F.It is defined here to avoid
 !adding "use module_physics_vars" since this subroutine is only used for the initialization of
@@ -618,6 +621,7 @@ subroutine physics_init_seaice(mesh, input, dims, configs)
  call mpas_pool_get_dimension(dims, 'nCellsSolve', nCellsSolve)
  call mpas_pool_get_dimension(dims, 'nSoilLevels', nSoilLevels)
 
+ call mpas_pool_get_array(mesh, 'isice_lu', isice_lu)
  call mpas_pool_get_array(mesh, 'landmask', landmask)
  call mpas_pool_get_array(mesh, 'lu_index', ivgtyp)
  call mpas_pool_get_array(mesh, 'soilcat_top', isltyp)
@@ -635,17 +639,6 @@ subroutine physics_init_seaice(mesh, input, dims, configs)
  call mpas_pool_get_array(input, 'sh2o', sh2o)
  call mpas_pool_get_array(input, 'smcrel', smcrel)
 
-!define the land use category for sea-ice as a function of the land use category input file:
- sfc_input_select1: select case(trim(config_landuse_data))
-    case('OLD')
-       isice_lu = 11
-    case('USGS')
-       isice_lu = 24
-    case('MODIFIED_IGBP_MODIS_NOAH')
-       isice_lu = 15
-    case default
-       CALL physics_error_fatal ('Invalid Land Use Dataset '//trim(config_landuse_data))
- end select sfc_input_select1
  call mpas_log_write('--- isice_lu   = $i', intArgs=(/isice_lu/))
 
 !assign the threshold value for xice as a function of config_frac_seaice:
diff --git a/src/core_atmosphere/physics/mpas_atmphys_interface.F b/src/core_atmosphere/physics/mpas_atmphys_interface.F
index f4ec446521..1f5410b3a8 100644
--- a/src/core_atmosphere/physics/mpas_atmphys_interface.F
+++ b/src/core_atmosphere/physics/mpas_atmphys_interface.F
@@ -572,6 +572,9 @@ subroutine microphysics_from_MPAS(configs,mesh,state,time_lev,diag,diag_physics,
           qi_p(i,k,j) = qi(k,i)
           qs_p(i,k,j) = qs(k,i)
           qg_p(i,k,j) = qg(k,i)
+          recloud_p(i,k,j) = re_cloud(k,i)
+          reice_p(i,k,j)   = re_ice(k,i)
+          resnow_p(i,k,j)  = re_snow(k,i)
        enddo
        enddo
        enddo
@@ -595,9 +598,6 @@ subroutine microphysics_from_MPAS(configs,mesh,state,time_lev,diag,diag_physics,
              nr_p(i,k,j) = nr(k,i)
              rainprod_p(i,k,j) = rainprod(k,i)
              evapprod_p(i,k,j) = evapprod(k,i)
-             recloud_p(i,k,j)  = re_cloud(k,i)
-             reice_p(i,k,j)    = re_ice(k,i)
-             resnow_p(i,k,j)   = re_snow(k,i)
           enddo
           enddo
           enddo
@@ -750,6 +750,9 @@ subroutine microphysics_to_MPAS(configs,mesh,state,time_lev,diag,diag_physics,te
           qi(k,i) = qi_p(i,k,j)
           qs(k,i) = qs_p(i,k,j)
           qg(k,i) = qg_p(i,k,j)
+          re_cloud(k,i) = recloud_p(i,k,j)
+          re_ice(k,i)   = reice_p(i,k,j)
+          re_snow(k,i)  = resnow_p(i,k,j)
        enddo
        enddo
        enddo
@@ -767,9 +770,6 @@ subroutine microphysics_to_MPAS(configs,mesh,state,time_lev,diag,diag_physics,te
              nr(k,i) = nr_p(i,k,j)
              rainprod(k,i) = rainprod_p(i,k,j)
              evapprod(k,i) = evapprod_p(i,k,j)
-             re_cloud(k,i) = recloud_p(i,k,j)
-             re_ice(k,i)   = reice_p(i,k,j)
-             re_snow(k,i)  = resnow_p(i,k,j)
           enddo
           enddo
           enddo
diff --git a/src/core_atmosphere/physics/mpas_atmphys_landuse.F b/src/core_atmosphere/physics/mpas_atmphys_landuse.F
index 0e2aa5578b..c482565cf1 100644
--- a/src/core_atmosphere/physics/mpas_atmphys_landuse.F
+++ b/src/core_atmosphere/physics/mpas_atmphys_landuse.F
@@ -23,10 +23,7 @@ module mpas_atmphys_landuse
  public:: landuse_init_forMPAS
 
 !global variables:
- integer,public:: isice,iswater,isurban
-
- integer,parameter:: frac_seaice      = 0       ! = 1: treats seaice as fractional field.
-                                                ! = 0: ice/no-ice flag. 
+ integer,public:: isurban
 
 !This module reads the file LANDUSE.TBL which defines the land type of each cell, depending on
 !the origin of the input data, as defined by the value of the variable "sfc_input_data".
@@ -72,6 +69,12 @@ module mpas_atmphys_landuse
 ! * in subroutine landuse_int_forMPAS, added the initialization of variable ust to a very small value. this was
 !   needed when the surface layer scheme was updated to that used in WRF version 3.8.1
 !   Laura D. Fowler (laura@ucar.edu) / 2016-10-27.
+! * removed the parameter frac_seaice which is not used anymore and has been replaced with config_frac_seaice. 
+!   Laura D. Fowler (laura@ucar.edu) / 2017-01-11.
+! * now use isice and iswater initialized in the init file instead of initialized in mpas_atmphys_landuse.F.
+!   Laura D. Fowler (laura@ucar.edu) / 2017-01-13.
+! * added the initialization of sfc_albedo_seaice which is the surface albedo over seaice points.
+!   Laura D. Fowler (laura@ucar.edu) / 2017-03-02.
 
 
  contains
@@ -98,13 +101,14 @@ subroutine landuse_init_forMPAS(dminfo,julday,mesh,configs,diag_physics,sfc_inpu
  character(len=StrKIND),pointer:: mminlu
 
  integer,pointer:: nCells
+ integer,pointer:: isice,iswater
  integer,dimension(:),pointer:: ivgtyp
  integer,dimension(:),pointer:: landmask
 
  real(kind=RKIND),dimension(:),pointer:: latCell
  real(kind=RKIND),dimension(:),pointer:: snoalb,snowc,xice
  real(kind=RKIND),dimension(:),pointer:: albbck,embck,xicem,xland,z0
- real(kind=RKIND),dimension(:),pointer:: mavail,sfc_albedo,sfc_emiss,thc,ust,znt
+ real(kind=RKIND),dimension(:),pointer:: mavail,sfc_albedo,sfc_albedo_seaice,sfc_emiss,thc,ust,znt
 
 !local variables:
  character(len=StrKIND) :: lutype
@@ -130,36 +134,39 @@ subroutine landuse_init_forMPAS(dminfo,julday,mesh,configs,diag_physics,sfc_inpu
  call mpas_pool_get_config(configs,'config_do_restart' ,config_do_restart )
  call mpas_pool_get_config(configs,'config_frac_seaice',config_frac_seaice)
  call mpas_pool_get_config(configs,'config_sfc_albedo' ,config_sfc_albedo )
- call mpas_pool_get_array(sfc_input,'mminlu',mminlu)
 
  call mpas_pool_get_dimension(mesh,'nCells',nCells)
 
  call mpas_pool_get_array(mesh,'latCell',latCell)
  
- call mpas_pool_get_array(sfc_input,'landmask'  , landmask  )
- call mpas_pool_get_array(sfc_input,'ivgtyp'    , ivgtyp    )
- call mpas_pool_get_array(sfc_input,'snoalb'    , snoalb    )
- call mpas_pool_get_array(sfc_input,'snowc'     , snowc     )
- call mpas_pool_get_array(sfc_input,'xice'      , xice      )
- call mpas_pool_get_array(sfc_input,'xland'     , xland     )
- call mpas_pool_get_array(sfc_input,'sfc_albbck', albbck    )
+ call mpas_pool_get_array(sfc_input,'mminlu'    ,mminlu  )
+ call mpas_pool_get_array(sfc_input,'isice'     ,isice   )
+ call mpas_pool_get_array(sfc_input,'iswater'   ,iswater )
+ call mpas_pool_get_array(sfc_input,'landmask'  ,landmask)
+ call mpas_pool_get_array(sfc_input,'ivgtyp'    ,ivgtyp  )
+ call mpas_pool_get_array(sfc_input,'snoalb'    ,snoalb  )
+ call mpas_pool_get_array(sfc_input,'snowc'     ,snowc   )
+ call mpas_pool_get_array(sfc_input,'xice'      ,xice    )
+ call mpas_pool_get_array(sfc_input,'xland'     ,xland   )
+ call mpas_pool_get_array(sfc_input,'sfc_albbck',albbck  )
 
  nullify(mavail)
  nullify(ust)
- call mpas_pool_get_array(diag_physics,'sfc_emibck', embck     )
- call mpas_pool_get_array(diag_physics,'mavail'    , mavail    )
- call mpas_pool_get_array(diag_physics,'sfc_albedo', sfc_albedo)
- call mpas_pool_get_array(diag_physics,'sfc_emiss' , sfc_emiss )
- call mpas_pool_get_array(diag_physics,'thc'       , thc       )
- call mpas_pool_get_array(diag_physics,'ust'       , ust       )
- call mpas_pool_get_array(diag_physics,'xicem'     , xicem     )
- call mpas_pool_get_array(diag_physics,'z0'        , z0        )
- call mpas_pool_get_array(diag_physics,'znt'       , znt       )
- 
+ call mpas_pool_get_array(diag_physics,'sfc_emibck'       ,embck            )
+ call mpas_pool_get_array(diag_physics,'mavail'           ,mavail           )
+ call mpas_pool_get_array(diag_physics,'sfc_albedo'       ,sfc_albedo       )
+ call mpas_pool_get_array(diag_physics,'sfc_albedo_seaice',sfc_albedo_seaice)
+ call mpas_pool_get_array(diag_physics,'sfc_emiss'        ,sfc_emiss        )
+ call mpas_pool_get_array(diag_physics,'thc'              ,thc              )
+ call mpas_pool_get_array(diag_physics,'ust'              ,ust              )
+ call mpas_pool_get_array(diag_physics,'xicem'            ,xicem            )
+ call mpas_pool_get_array(diag_physics,'z0'               ,z0               )
+ call mpas_pool_get_array(diag_physics,'znt'              ,znt              )
+
 !call mpas_log_write('')
-!call mpas_log_write('--- enter subroutine landuse_init_forMPAS: julian day=$i', intArgs=(/julday/))
-!call mpas_log_write('--- config_frac_seaice = $l', logicArgs=(/config_frac_seaice/))
-!call mpas_log_write('--- xice_threshold     = $r', realArgs=(/xice_threshold/))
+!call mpas_log_write('--- enter subroutine landuse_init_forMPAS: julian day=$i' , intArgs=(/julday/))
+!call mpas_log_write('--- config_frac_seaice = $1',logicArgs=(/config_frac_seaice/))
+!call mpas_log_write('--- xice_threshold     = $r',realArgs=(/xice_threshold/))
 
 !reads in the landuse properties from landuse.tbl:
  if(dminfo % my_proc_id == IO_NODE) then
@@ -197,33 +204,24 @@ subroutine landuse_init_forMPAS(dminfo,julday,mesh,configs,diag_physics,sfc_inpu
                                      therin(ic,is),scfx(ic,is),sfhc(ic,is)
        enddo
 !      do ic = 1, lucats
-!         call mpas_log_write('$i $r $r $r $r $r $r $r $r', intArgs=(/ic/), realArgs=(/albd(ic,is),slmo(ic,is),sfem(ic,is),sfz0(ic,is), &
+!         call mpas_log_write('$i $r $r $r $r $r $r $r $r', intArgs=(/ic/), &
+!                realArgs=(/albd(ic,is),slmo(ic,is),sfem(ic,is),sfz0(ic,is), &
 !                therin(ic,is),scfx(ic,is),sfhc(ic,is)/))
 !      enddo
 !      if(is .lt. luseas) call mpas_log_write('')
     enddo
 
-!defines the index isurban, iswater and, isice as a function of sfc_input_data:
+!defines the index isurban as a function of sfc_input_data:
     sfc_input_select: select case(trim(lutype))
        case('OLD')
-          iswater = 7
-          isice   = 11
           isurban = 1
        case('USGS')
-          iswater = 16
-          isice   = 24
           isurban = 1
        case('MODIFIED_IGBP_MODIS_NOAH')
-          iswater = 17
-          isice   = 15
           isurban = 13
        case('SiB')
-          iswater = 15
-          isice   = 16
           isurban = 11
        case('LW12')
-          iswater = 2
-          isice   = 3
           isurban = 1
        case default
     end select sfc_input_select
@@ -260,7 +258,6 @@ subroutine landuse_init_forMPAS(dminfo,julday,mesh,configs,diag_physics,sfc_inpu
     if(julday.lt.105 .or. julday.ge.288) isn=2
     if(latCell(iCell) .lt. 0.) isn=3-isn
 
-!   is = nint(ivgtyp(iCell))
     is = ivgtyp(iCell)
     
     !set no data points to water:
@@ -289,6 +286,7 @@ subroutine landuse_init_forMPAS(dminfo,julday,mesh,configs,diag_physics,sfc_inpu
     if(xice(iCell) .ge. xice_threshold) then
        albbck(iCell) = albd(isice,isn) / 100.
        embck(iCell)  = sfem(isice,isn)
+       sfc_albedo_seaice(iCell) = albbck(iCell)
        if(config_frac_seaice) then
           !0.08 is the albedo over open water.
           !0.98 is the emissivity over open water.
@@ -303,6 +301,9 @@ subroutine landuse_init_forMPAS(dminfo,julday,mesh,configs,diag_physics,sfc_inpu
        znt(iCell) = z0(iCell)
 
        if(associated(mavail)) mavail(iCell) = slmo(isice,isn)
+    else
+       !over seaice-free cells, initialize sfc_albedo_seaice with the background surface albedo:
+       sfc_albedo_seaice(iCell) = albbck(iCell)
     endif
 
  enddo
diff --git a/src/core_atmosphere/physics/mpas_atmphys_lsm_noahinit.F b/src/core_atmosphere/physics/mpas_atmphys_lsm_noahinit.F
index 497603a94c..1f85b7de07 100644
--- a/src/core_atmosphere/physics/mpas_atmphys_lsm_noahinit.F
+++ b/src/core_atmosphere/physics/mpas_atmphys_lsm_noahinit.F
@@ -42,6 +42,10 @@ module mpas_atmphys_lsm_noahinit
 !   Laura D. Fowler (laura@ucar.edu) / 2014-03-21.
 ! * added "use mpas_kind_types" at the top of the module.
 !   Laura D. Fowler (laura@ucar.edu) / 2014-09-18.
+! * in subroutine soil_veg_gen_parm, modified reading the updated file VEGPARM.TBL so that we can update the NOAH
+!   land surface scheme.added the categories low_density_residential,high_density_residential,and high_intensity_
+!   industrial.added the variables ztopvtbl and zbotvtbl.
+!   Laura D. Fowler (laura@ucar.edu) / 2017-01-25.
 
 
  contains
@@ -263,7 +267,7 @@ subroutine soil_veg_gen_parm(dminfo,mminlu,mminsl)
           lumatch=1
        else
           call physics_message('    skipping over lutype = ' // trim ( lutype ))
-          do lc = 1, lucats+12
+          do lc = 1, lucats+20
              read(16,*)
           enddo
        endif
@@ -283,16 +287,19 @@ subroutine soil_veg_gen_parm(dminfo,mminlu,mminsl)
        size(z0maxtbl)     < lucats .or. &
        size(albedomintbl) < lucats .or. &
        size(albedomaxtbl) < lucats .or. &
+       size(ztopvtbl)     < lucats .or. &
+       size(zbotvtbl)     < lucats .or. &
        size(emissmintbl ) < lucats .or. &
        size(emissmaxtbl ) < lucats) then
-!      call wrf_error_fatal('table sizes too small for value of lucats in module_sf_noahdrv.f')
+       call physics_error_fatal('table sizes too small for value of lucats in module_sf_noahdrv.f')
     endif
 
     if(lutype.eq.mminlu)then
        do lc = 1, lucats
-          read(16,*) iindex,shdtbl(lc),nrotbl(lc),rstbl(lc),rgltbl(lc),hstbl(lc),snuptbl(lc), &
-                     maxalb(lc),laimintbl(lc),laimaxtbl(lc),emissmintbl(lc),emissmaxtbl(lc),  &
-                     albedomintbl(lc),albedomaxtbl(lc),z0mintbl(lc),z0maxtbl(lc)
+          read(16,*) iindex,shdtbl(lc),nrotbl(lc),rstbl(lc),rgltbl(lc),hstbl(lc),snuptbl(lc),  &
+                     maxalb(lc),laimintbl(lc),laimaxtbl(lc),emissmintbl(lc),emissmaxtbl(lc),   &
+                     albedomintbl(lc),albedomaxtbl(lc),z0mintbl(lc),z0maxtbl(lc),ztopvtbl(lc), &
+                     zbotvtbl(lc)
        enddo
        read (16,*)
        read (16,*)topt_data
@@ -306,6 +313,14 @@ subroutine soil_veg_gen_parm(dminfo,mminlu,mminsl)
        read (16,*)bare
        read (16,*)
        read (16,*)natural
+       read (16,*)
+       read (16,*)
+       read (16,*)
+       read (16,*)low_density_residential
+       read (16,*)
+       read (16,*)high_density_residential
+       read (16,*)
+       read (16,*)high_intensity_industrial
     endif
 
     2002 continue
@@ -334,6 +349,8 @@ subroutine soil_veg_gen_parm(dminfo,mminlu,mminsl)
  DM_BCAST_REALS(emissmaxtbl)
  DM_BCAST_REALS(albedomintbl)
  DM_BCAST_REALS(albedomaxtbl)
+ DM_BCAST_REALS(ztopvtbl)
+ DM_BCAST_REALS(zbotvtbl)
  DM_BCAST_REALS(maxalb)
  DM_BCAST_REAL(topt_data)
  DM_BCAST_REAL(cmcmax_data)
@@ -341,6 +358,9 @@ subroutine soil_veg_gen_parm(dminfo,mminlu,mminsl)
  DM_BCAST_REAL(rsmax_data)
  DM_BCAST_INTEGER(bare)
  DM_BCAST_INTEGER(natural)
+ DM_BCAST_INTEGER(low_density_residential)
+ DM_BCAST_INTEGER(high_density_residential)
+ DM_BCAST_INTEGER(high_intensity_industrial)
 
 !call mpas_log_write(' LUTYPE  = '//trim(lutype))
 !call mpas_log_write(' LUCATS  = $i',intArgs=(/lucats/))
@@ -353,13 +373,16 @@ subroutine soil_veg_gen_parm(dminfo,mminlu,mminsl)
 !call mpas_log_write(' RSMAX_DATA  = $r',realArgs=(/rsmax_data/))
 !call mpas_log_write(' BARE        = $i',intArgs=(/bare/))
 !call mpas_log_write(' NATURAL     = $i',intArgs=(/natural/))
-
+!call mpas_log_write(' LOW_DENSITY_RESIDENTIAL   = $i , intArgs=(/low_density_residential/))
+!call mpas_log_write(' HIGH_DENSITY_RESIDENTIAL  = $i , intArgs=(/high_density_residential/))
+!call mpas_log_write(' HIGH_DENSITY_INDUSTRIAL   = $i , intArgs=(/high_density_industrial/))
 !call mpas_log_write('')
 !do lc = 1, lucats
-!   call mpas_log_write('$i $r $r $r $r $r $r $r $r $r $r $r $r $r $r $r', intArgs=(/lc/), &
+!   call mpas_log_write('$i $r $r $r $r $r $r $r $r $r $r $r $r $r $r $r $r $r', intArgs=(/lc/),     &
 !                realArgs=(/shdtbl(lc),float(nrotbl(lc)),rstbl(lc),rgltbl(lc),hstbl(lc),snuptbl(lc), &
-!                maxalb(lc),laimintbl(lc),laimaxtbl(lc),emissmintbl(lc),emissmaxtbl(lc),     &
-!                albedomintbl(lc),albedomaxtbl(lc),z0mintbl(lc),z0maxtbl(lc)/))
+!                maxalb(lc),laimintbl(lc),laimaxtbl(lc),emissmintbl(lc),emissmaxtbl(lc),             &
+!                albedomintbl(lc),albedomaxtbl(lc),z0mintbl(lc),z0maxtbl(lc),ztopvtbl(lc),           &
+!                zbottvtbl(lc)/))
 !enddo
  call mpas_log_write('    end read VEGPARM.TBL')
 
diff --git a/src/core_atmosphere/physics/mpas_atmphys_update_surface.F b/src/core_atmosphere/physics/mpas_atmphys_update_surface.F
index 684c274581..6e2057d5cb 100644
--- a/src/core_atmosphere/physics/mpas_atmphys_update_surface.F
+++ b/src/core_atmosphere/physics/mpas_atmphys_update_surface.F
@@ -13,7 +13,6 @@ module mpas_atmphys_update_surface
 
  use mpas_atmphys_date_time
  use mpas_atmphys_constants,only: stbolt
- use mpas_atmphys_landuse, only : isice,iswater 
  use mpas_atmphys_vars
 
  implicit none
@@ -41,6 +40,11 @@ module mpas_atmphys_update_surface
 !   Laura D. Fowler (laura@ucar.edu) / 2013-08-24.
 ! * modified sourcecode to use pools.
 !   Laura D. Fowler (laura@ucar.edu) / 2014-05-15.
+! * now use isice and iswater initialized in the init file instead of initialized in mpas_atmphys_landuse.F.
+!   Laura D. Fowler (laura@ucar.edu) / 2017-01-13.
+! * corrected the initialization of the soil temperature tslb over ocean points for exact restartability, and
+!   for consistency with module_sf_noahdrv.F when itimestep = 1.
+!   Laura D. Fowler (laura@ucar.edu) / 2017-08-29.
 
 
  contains
@@ -121,6 +125,7 @@ subroutine physics_update_sst(dminfo,config_frac_seaice,mesh,sfc_input,diag_phys
 
 
  integer,pointer:: nCellsSolve,nSoilLevels
+ integer,pointer:: isice,iswater
 
  real(kind=RKIND),dimension(:),pointer  :: sfc_albbck,sst,snow,tmn,tsk,vegfra,xice,seaice
  real(kind=RKIND),dimension(:),pointer  :: snowc,snowh
@@ -144,6 +149,8 @@ subroutine physics_update_sst(dminfo,config_frac_seaice,mesh,sfc_input,diag_phys
  call mpas_pool_get_dimension(mesh,'nCellsSolve',nCellsSolve)
  call mpas_pool_get_dimension(mesh,'nSoilLevels',nSoilLevels)
 
+ call mpas_pool_get_array(sfc_input,'isice'     ,isice     )
+ call mpas_pool_get_array(sfc_input,'iswater'   ,iswater   )
  call mpas_pool_get_array(sfc_input,'isltyp'    ,isltyp    )    
  call mpas_pool_get_array(sfc_input,'ivgtyp'    ,ivgtyp    )
  call mpas_pool_get_array(sfc_input,'landmask'  ,landmask  )
@@ -263,7 +270,9 @@ subroutine physics_update_sst(dminfo,config_frac_seaice,mesh,sfc_input,diag_phys
 
     if(xland(iCell) >= 1.5_RKIND) then
        tsk(iCell)    = sst(iCell)
-       tslb(1,iCell) = sst(iCell)
+       do iSoil = 1, nSoilLevels
+          tslb(iSoil,iCell) = 273.16
+       enddo 
     endif
  enddo
 !call mpas_log_write('')
diff --git a/src/core_atmosphere/physics/mpas_atmphys_vars.F b/src/core_atmosphere/physics/mpas_atmphys_vars.F
index 012f63befa..28c72579f5 100644
--- a/src/core_atmosphere/physics/mpas_atmphys_vars.F
+++ b/src/core_atmosphere/physics/mpas_atmphys_vars.F
@@ -67,7 +67,10 @@ module mpas_atmphys_vars
 !   Laura D. Fowler (laura@ucar.edu) / 2016-10-21.
 ! * moved the declarations of arrays delta_p,wstar_p,uoce_p,and voce_p since they are now used in both modules
 !   module_bl_ysu.F and module_bl_mynn.F.
-!   Laura D. Fowler (laura@ucar.edu) / 20016-10-27.
+!   Laura D. Fowler (laura@ucar.edu) / 2016-10-27.
+! * added the variable opt_thcnd (option to treat thermal conductivity in NoahLSM). added additional options and
+!   arrays to run the Noah LSM scheme from WRF version 3.9.0.
+!   Laura D. Fowler (laura@ucar.edu) / 2017-01-27.
 ! * removed the initialization local variable gwdo_scheme. gwdo_scheme is no longer needed and can be replaced
 !   with config_gwdo_scheme.
 !   Laura D. Fowler (laura@ucar.edu) / 2017-02-16.
@@ -95,6 +98,18 @@ module mpas_atmphys_vars
 ! * removed the initialization local variable microp_scheme. microp_scheme is no longer needed and can be
 !   replaced replaced with config_microp_scheme.
 !   Laura D. Fowler (laura@ucar.edu) / 2017-02-16.
+! * add variables and arrays needed to the parameterization of seaice in the updated Noah land surface scheme.
+!   Laura D. Fowler (laura@ucar.edu) / 2017-02-19.
+! * changed the option seaice_albedo_opt from 0 to 2 so that we can initialize the surface albedo over seaice
+!   cells using the surface background albedo (see initialization of sfc_albedo_seaice in subroutine
+!   landuse_init_forMPAS).
+!   Laura D. Fowler (laura@ucar.edu) / 2017-03-02.
+! * added local variables for the mass-weighted mean velocities for rain, cloud ice, snow, and graupel from the
+!   Thompson cloud microphysics scheme.
+!   Laura D. Fowler (laura@ucar.edu) / 2017-04-19.
+! * added the local variables cosa_p and sina_p needed in call to subroutine gwdo after updating module_bl_gwdo.F
+!   to that of WRF version 4.0.2
+!   Laura D. Fowler (laura@ucar.edu) / 2019-01-30.
 
 
 !=================================================================================================================
@@ -167,6 +182,7 @@ module mpas_atmphys_vars
     qg_p               !graupel mixing ratio                                                [kg/kg]
 
  real(kind=RKIND),dimension(:,:,:),allocatable:: &
+    nc_p,             &!
     ni_p,             &!
     nr_p               !
 
@@ -387,6 +403,10 @@ module mpas_atmphys_vars
 !... variables and arrays related to parameterization of gravity wave drag over orography:
 !=================================================================================================================
 
+ real(kind=RKIND),dimension(:,:),allocatable:: &
+    cosa_p,           &!cosine of map rotation                                                                 [-]
+    sina_p             !sine of map rotation                                                                   [-]
+
  real(kind=RKIND),dimension(:,:),allocatable:: &
     var2d_p,          &!orographic variance                                                                   [m2]
     con_p,            &!orographic convexity                                                                  [m2]
@@ -467,6 +487,34 @@ module mpas_atmphys_vars
     sh3d_p,           &!stability function for heat                                                            [-]
     elpbl_p            !length scale from PBL                                                                  [m]
 
+!=================================================================================================================
+!... variables and arrays related to parameterization of seaice:
+!=================================================================================================================
+
+ integer,parameter:: &
+    seaice_albedo_opt    = 2           !option to set albedo over sea ice.
+                                       !0 = seaice albedo is constant set in seaice_albedo_default.
+                                       !1 = seaice albedo is f(Tair,Tskin,Tsnow), following Mill (2011).
+                                       !2 = seaice albedo is read in from input variable albsi.
+ integer,parameter:: &
+    seaice_thickness_opt = 0           !option for treating seaice thickness.
+                                       !0 = seaice thickness is constant set in seaice_thickness_default.
+                                       !1 = seaice_thickness is read in from input variable icedepth.
+ integer,parameter:: &
+    seaice_snowdepth_opt = 0           !option for treating snow depth on sea ice.
+                                       !0=snow depth is bounded by seaice_snowdepth_min and seaice_snowdepth_max.
+
+ real(kind=RKIND),parameter:: &
+    seaice_albedo_default     = 0.65 ,&!default value of seaice albedo for seaice_albedo_opt=0.
+    seaice_thickness_default  = 3.0,  &!default value of seaice thickness for seaice_thickness_opt=0
+    seaice_snowdepth_max      = 1.e10,&!maximum allowed accumulation of snow (m) on sea ice.
+    seaice_snowdepth_min      = 0.001  !minimum snow depth (m) on sea ice.
+
+ real(kind=RKIND),dimension(:,:),allocatable:: &
+    albsi_p,          &!surface albedo over seaice                                                             [-]
+    snowsi_p,         &!snow depth over seaice                                                                 [m]
+    icedepth_p         !seaice thickness                                                                       [m]
+
 !=================================================================================================================
 !... variables and arrays related to parameterization of short-wave radiation:
 !=================================================================================================================
@@ -596,6 +644,14 @@ module mpas_atmphys_vars
     ua_phys=.false.    !option to activate UA Noah changes: a different snow-cover physics in the land-surface
                        !scheme. That option is not currently implemented in MPAS.
 
+ integer,parameter:: &
+    opt_thcnd = 1      !option to treat thermal conductivity in NoahLSM (new option implemented in WRF 3.8.0).
+                       != 1, original (default).
+                       != 2, McCumber and Pielke for silt loam and sandy loam.
+
+ integer,parameter:: &
+    fasdas = 0         !for WRF surface data assimilation system (not used in MPAS).
+
  integer,public:: &
     sf_surface_physics !used to define the land surface scheme by a number instead of name. It
                        !is only needed in module_ra_rrtmg_sw.F to define the spectral surface
@@ -648,6 +704,29 @@ module mpas_atmphys_vars
     alswnirdir_p,     &!direct-beam surface albedo in near-IR spectrum                                         [-]
     alswnirdif_p       !diffuse-beam surface albedo in near-IR spectrum                                        [-]
 
+!.. arrays needed to run UA Noah changes (different snow-cover physics):
+ real(kind=RKIND),dimension(:,:),allocatable:: &
+    flxsnow_p,        &!energy added to sensible heat flux when ua_phys=true                               [W m-2]
+    fvbsnow_p,        &!fraction of vegetation with snow beneath when ua_phys=true                             [-]
+    fbursnow_p,       &!fraction of canopy buried when ua_phys=true                                            [-]
+    fgsnsnow_p         !fraction of ground snow cover when ua_phys=true                                        [-]
+
+!.. arrays needed in the argument list in the call to the Noah LSM urban parameterization: note that these arrays
+!.. are initialized to zero since we do not run an urban model:
+ integer,dimension(:,:),allocatable:: &
+    utype_urb_p        !urban type                                                                             [-]
+
+ real(kind=RKIND),dimension(:,:),allocatable:: &
+    frc_urb_p,        &!urban fraction                                                                         [-]
+    ust_urb_p          !urban u* in similarity theory                                                        [m/s]
+
+!.. arrays needed in the argument list in the call to the Noah LSM hydrology model: note that these arrays are
+!.. initialized to zero since we do not run a hydrology model:
+ real(kind=RKIND),dimension(:,:),allocatable:: &
+    infxsrt_p,        &!timestep infiltration excess                                                          [mm]
+    sfcheadrt_p,      &!surface water detph                                                                   [mm]
+    soldrain_p         !soil column drainage                                                                  [mm]
+
 !=================================================================================================================
 !.. variables and arrays related to surface characteristics:
 !=================================================================================================================
diff --git a/src/core_atmosphere/physics/physics_wrf/Makefile b/src/core_atmosphere/physics/physics_wrf/Makefile
index cc9ee673b9..b470771cc2 100644
--- a/src/core_atmosphere/physics/physics_wrf/Makefile
+++ b/src/core_atmosphere/physics/physics_wrf/Makefile
@@ -34,6 +34,9 @@ OBJS = \
 	module_sf_mynn.o               \
 	module_sf_noahdrv.o            \
 	module_sf_noahlsm.o            \
+        module_sf_noahlsm_glacial_only.o \
+        module_sf_noah_seaice.o        \
+        module_sf_noah_seaice_drv.o    \
 	module_sf_oml.o                \
 	module_sf_sfclay.o             \
 	module_sf_urban.o
@@ -81,8 +84,18 @@ module_sf_noahdrv.o: \
 	module_sf_bep.o \
 	module_sf_bep_bem.o \
 	module_sf_noahlsm.o \
+        module_sf_noahlsm_glacial_only.o \
 	module_sf_urban.o
 
+module_sf_noahlsm_glacial_only.o: \
+        module_sf_noahlsm.o
+
+module_sf_noah_seaice_drv.o: \
+        module_sf_noah_seaice.o
+
+module_sf_noah_seaice.o: \
+        module_sf_noahlsm.o
+
 clean:
 	$(RM) *.f90 *.o *.mod
 	@# Certain systems with intel compilers generate *.i files
diff --git a/src/core_atmosphere/physics/physics_wrf/module_bl_gwdo.F b/src/core_atmosphere/physics/physics_wrf/module_bl_gwdo.F
index ac7c660f22..beaa2955f2 100644
--- a/src/core_atmosphere/physics/physics_wrf/module_bl_gwdo.F
+++ b/src/core_atmosphere/physics/physics_wrf/module_bl_gwdo.F
@@ -1,162 +1,159 @@
-!==================================================================================================
-! copied for implementation in MPAS from WRF version 3.6.1.
+!-----------------------------------------------------------------------------------------------------------------
+! copied from WRF version 4.0.2 for implementation in MPAS:
 
-! modifications made to sourcecode:
-! * used preprocessing option to define the variable dx as a function of the horizontal grid.
-!   Laura D. Fowler (laura@ucar.edu) / 2014-09-25.
+! modifications to sourcecode for implementation in MPAS:
+!    * made the variable dx (and local variable dxmeter) a two-dimensional array to include the impact
+!      of the mean distance between cells.
+!    * added the initialization of kpblmax to kte if the optional variables p_top,znu,and znw are not
+!      available in the argument list.
+!      Laura D. Fowler (laura@ucar.edu) / 2019-01-29.
+!    * because the topography variance is zero over ocean points,also check that the variable zlowtop
+!      is strictly greater than zero for the initialization of klowtop and kloop1.
+!      Laura D. Fowler (laura@ucar.edu) / 2019-01-30.
 
-!==================================================================================================
-
-! WRf:model_layer:physics
-!
-!
-!
-!
+!WRF:model_layer:physics
 !
 module module_bl_gwdo
 contains
-!
-!-------------------------------------------------------------------
-!
-   subroutine gwdo(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, &
-                  rublten,rvblten, &
-                  dtaux3d,dtauy3d,dusfcg,dvsfcg, &
+!-------------------------------------------------------------------------------
+   subroutine gwdo(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z,                           &
+                  rublten,rvblten,                                             &
+                  dtaux3d,dtauy3d,dusfcg,dvsfcg,                               &
                   var2d,oc12d,oa2d1,oa2d2,oa2d3,oa2d4,ol2d1,ol2d2,ol2d3,ol2d4, &
-                  znu,znw,mut,p_top, &
-                  cp,g,rd,rv,ep1,pi, &
-                  dt,dx,kpbl2d,itimestep, &
-                  ids,ide, jds,jde, kds,kde, &
-                  ims,ime, jms,jme, kms,kme, &
+                  sina,cosa,znu,znw,p_top,                                     &
+                  cp,g,rd,rv,ep1,pi,                                           &
+                  dt,dx,kpbl2d,itimestep,                                      &
+                  ids,ide, jds,jde, kds,kde,                                   &
+                  ims,ime, jms,jme, kms,kme,                                   &
                   its,ite, jts,jte, kts,kte)
-!-------------------------------------------------------------------
-      implicit none
-!------------------------------------------------------------------------------
-!
-!-- u3d 3d u-velocity interpolated to theta points (m/s)
-!-- v3d 3d v-velocity interpolated to theta points (m/s)
-!-- t3d temperature (k)
-!-- qv3d 3d water vapor mixing ratio (kg/kg)
-!-- p3d 3d pressure (pa)
-!-- p3di 3d pressure (pa) at interface level
-!-- pi3d 3d exner function (dimensionless)
-!-- rublten u tendency due to
-! pbl parameterization (m/s/s)
-!-- rvblten v tendency due to
-!-- cp heat capacity at constant pressure for dry air (j/kg/k)
-!-- g acceleration due to gravity (m/s^2)
-!-- rd gas constant for dry air (j/kg/k)
-!-- z height above sea level (m)
-!-- rv gas constant for water vapor (j/kg/k)
-!-- dt time step (s)
-!-- dx model grid interval (m)
-!-- ep1 constant for virtual temperature (r_v/r_d - 1) (dimensionless)
-!-- ids start index for i in domain
-!-- ide end index for i in domain
-!-- jds start index for j in domain
-!-- jde end index for j in domain
-!-- kds start index for k in domain
-!-- kde end index for k in domain
-!-- ims start index for i in memory
-!-- ime end index for i in memory
-!-- jms start index for j in memory
-!-- jme end index for j in memory
-!-- kms start index for k in memory
-!-- kme end index for k in memory
-!-- its start index for i in tile
-!-- ite end index for i in tile
-!-- jts start index for j in tile
-!-- jte end index for j in tile
-!-- kts start index for k in tile
-!-- kte end index for k in tile
-!-------------------------------------------------------------------
-!
-  integer, intent(in ) :: ids,ide, jds,jde, kds,kde, &
-                                     ims,ime, jms,jme, kms,kme, &
+!-------------------------------------------------------------------------------
+   implicit none
+!-------------------------------------------------------------------------------
+!                                                                       
+!-- u3d         3d u-velocity interpolated to theta points (m/s)
+!-- v3d         3d v-velocity interpolated to theta points (m/s)
+!-- t3d         temperature (k)
+!-- qv3d        3d water vapor mixing ratio (kg/kg)
+!-- p3d         3d pressure (pa)
+!-- p3di        3d pressure (pa) at interface level
+!-- pi3d        3d exner function (dimensionless)
+!-- rublten     u tendency due to pbl parameterization (m/s/s) 
+!-- rvblten     v tendency due to pbl parameterization (m/s/s)
+!-- sina        sine rotation angle
+!-- cosa        cosine rotation angle
+!-- znu         eta values (sigma values)
+!-- cp          heat capacity at constant pressure for dry air (j/kg/k)
+!-- g           acceleration due to gravity (m/s^2)
+!-- rd          gas constant for dry air (j/kg/k)
+!-- z           height above sea level (m)
+!-- rv          gas constant for water vapor (j/kg/k)
+!-- dt          time step (s)
+!-- dx          model grid interval (m)
+!-- ep1         constant for virtual temperature (r_v/r_d - 1) (dimensionless)
+!-- ids         start index for i in domain
+!-- ide         end index for i in domain
+!-- jds         start index for j in domain
+!-- jde         end index for j in domain
+!-- kds         start index for k in domain
+!-- kde         end index for k in domain
+!-- ims         start index for i in memory
+!-- ime         end index for i in memory
+!-- jms         start index for j in memory
+!-- jme         end index for j in memory
+!-- kms         start index for k in memory
+!-- kme         end index for k in memory
+!-- its         start index for i in tile
+!-- ite         end index for i in tile
+!-- jts         start index for j in tile
+!-- jte         end index for j in tile
+!-- kts         start index for k in tile
+!-- kte         end index for k in tile
+!
+!-------------------------------------------------------------------------------
+  integer,  intent(in   )   ::      ids,ide, jds,jde, kds,kde,                 &
+                                     ims,ime, jms,jme, kms,kme,                &
                                      its,ite, jts,jte, kts,kte
-  integer, intent(in ) :: itimestep
-!
-!MPAS specific (Laura D. Fowler 2013-02-12):
-#if defined(mpas)
-  real, intent(in ) :: dt,cp,g,rd,rv,ep1,pi
-  real, intent(in), dimension(ims:ime,jms:jme):: dx
-#else
-  real, intent(in ) :: dt,dx,cp,g,rd,rv,ep1,pi
-#endif
-!MPAS  specific end.
-!
-  real, dimension( ims:ime, kms:kme, jms:jme ) , &
-            intent(in ) :: qv3d, &
+  integer,  intent(in   )   ::      itimestep
+!
+  real,     intent(in   )   ::      dt,cp,g,rd,rv,ep1,pi
+!
+  real,     dimension( ims:ime, kms:kme, jms:jme )                           , &
+            intent(in   )   ::                                           qv3d, &
                                                                           p3d, &
                                                                          pi3d, &
                                                                           t3d, &
                                                                              z
-  real, dimension( ims:ime, kms:kme, jms:jme ) , &
-            intent(in ) :: p3di
+  real,     dimension( ims:ime, kms:kme, jms:jme )                           , &
+            intent(in   )   ::                                           p3di
 !
-  real, dimension( ims:ime, kms:kme, jms:jme ) , &
-            intent(inout) :: rublten, &
+  real,     dimension( ims:ime, kms:kme, jms:jme )                           , &
+            intent(inout)   ::                                        rublten, &
                                                                       rvblten
-  real, dimension( ims:ime, kms:kme, jms:jme ) , &
-            intent(inout) :: dtaux3d, &
+  real,     dimension( ims:ime, kms:kme, jms:jme )                           , &
+            intent(inout)   ::                                        dtaux3d, &
                                                                       dtauy3d
 !
-  real, dimension( ims:ime, kms:kme, jms:jme ) , &
-             intent(in ) :: u3d, &
+  real,      dimension( ims:ime, kms:kme, jms:jme )                          , &
+             intent(in   )   ::                                           u3d, &
                                                                           v3d
 !
-  integer, dimension( ims:ime, jms:jme ) , &
-             intent(in ) :: kpbl2d
-  real, dimension( ims:ime, jms:jme ) , &
-             intent(inout ) :: dusfcg, &
+  integer,   dimension( ims:ime, jms:jme )                                   , &
+             intent(in  )   ::                                         kpbl2d
+  real,   dimension( ims:ime, jms:jme )                                      , &
+             intent(inout  )   ::                                      dusfcg, &
                                                                        dvsfcg
 !
-  real, dimension( ims:ime, jms:jme ) , &
-             intent(in ) :: var2d, &
+  real,   dimension( ims:ime, jms:jme )                                      , &
+             intent(in  )   ::                                             dx
+  real,   dimension( ims:ime, jms:jme )                                      , &
+             intent(in  )   ::                                          var2d, &
                                                                         oc12d, &
                                                       oa2d1,oa2d2,oa2d3,oa2d4, &
-                                                      ol2d1,ol2d2,ol2d3,ol2d4
+                                                      ol2d1,ol2d2,ol2d3,ol2d4, &
+                                                                    sina,cosa
 !
-  real, dimension( ims:ime, jms:jme ) , &
-             optional , &
-             intent(in ) :: mut
-!
-  real, dimension( kms:kme ) , &
-             optional , &
-             intent(in ) :: znu, &
+  real,     dimension( kms:kme )                                             , &
+            optional                                                         , &
+            intent(in  )   ::                                             znu, &
                                                                           znw
 !
-  real, optional, intent(in ) :: p_top
+  real,     optional, intent(in  )   ::                                 p_top
 !
 !local
 !
-  real, dimension( its:ite, kts:kte ) :: delprsi, &
+  real,   dimension( its:ite, kts:kte )  ::                           delprsi, &
                                                                           pdh
-  real, dimension( its:ite, kts:kte+1 ) :: pdhi
-  real, dimension( its:ite, 4 ) :: oa4, &
+  real,   dimension( its:ite, kts:kte )  ::  ugeo, vgeo, dudt, dvdt, dtaux, dtauy
+  real,   dimension( its:ite )  ::  dusfc, dvsfc
+  real,     dimension( its:ite, kts:kte+1 )   ::                         pdhi
+  real,   dimension( its:ite, 4 )        ::                               oa4, &
                                                                           ol4
-  integer :: i,j,k,kdt
+  integer ::  i,j,k,kpblmax
+!
+   if(present(p_top) .and. present(znu) .and. present(znw)) then
+      do k = kts,kte
+        if (znu(k).gt.0.6) kpblmax = k + 1
+      enddo
+   else
+      kpblmax = kte
+   endif
 !
    do j = jts,jte
-      if(present(mut))then
-! For ARW we will replace p and p8w with dry hydrostatic pressure
-        do k = kts,kte+1
-          do i = its,ite
-             if(k.le.kte)pdh(i,k) = mut(i,j)*znu(k) + p_top
-             pdhi(i,k) = mut(i,j)*znw(k) + p_top
-          enddo
-        enddo
-      else
-        do k = kts,kte+1
-          do i = its,ite
-             if(k.le.kte)pdh(i,k) = p3d(i,k,j)
-             pdhi(i,k) = p3di(i,k,j)
-          enddo
+      do k = kts,kte+1
+        do i = its,ite
+           if (k.le.kte)pdh(i,k) = p3d(i,k,j)
+           pdhi(i,k) = p3di(i,k,j)
         enddo
-      endif
+      enddo
 !
       do k = kts,kte
         do i = its,ite
           delprsi(i,k) = pdhi(i,k)-pdhi(i,k+1)
+! rotate winds to zonal/meridional
+          ugeo(i,k) = u3d(i,k,j)*cosa(i,j) - v3d(i,k,j)*sina(i,j)
+          vgeo(i,k) = u3d(i,k,j)*sina(i,j) + v3d(i,k,j)*cosa(i,j)
+          dudt(i,k) = 0.0
+          dvdt(i,k) = 0.0
         enddo
       enddo
         do i = its,ite
@@ -169,466 +166,433 @@ subroutine gwdo(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z, &
             ol4(i,3) = ol2d3(i,j)
             ol4(i,4) = ol2d4(i,j)
         enddo
-      call gwdo2d(dudt=rublten(ims,kms,j),dvdt=rvblten(ims,kms,j) &
-              ,dtaux2d=dtaux3d(ims,kms,j),dtauy2d=dtauy3d(ims,kms,j) &
-              ,u1=u3d(ims,kms,j),v1=v3d(ims,kms,j) &
-              ,t1=t3d(ims,kms,j),q1=qv3d(ims,kms,j) &
-              ,prsi=pdhi(its,kts),del=delprsi(its,kts) &
-              ,prsl=pdh(its,kts),prslk=pi3d(ims,kms,j) &
-              ,zl=z(ims,kms,j),rcl=1.0 &
-              ,dusfc=dusfcg(ims,j),dvsfc=dvsfcg(ims,j) &
-              ,var=var2d(ims,j),oc1=oc12d(ims,j) &
-              ,oa4=oa4,ol4=ol4 &
-              ,g=g,cp=cp,rd=rd,rv=rv,fv=ep1,pi=pi &
-!MPAS specific (Laura D. Fowler 2013-02-12): 
-#if defined(mpas)
-              ,dxmeter=dx(ims,j),deltim=dt &
-#else
-              ,dxmeter=dx,deltim=dt &
-#endif
-!MPAS specific end. 
-              ,kpbl=kpbl2d(ims,j),kdt=itimestep,lat=j &
-              ,ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde &
-              ,ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme &
-              ,its=its,ite=ite, jts=jts,jte=jte, kts=kts,kte=kte )
+      call gwdo2d(dudt=dudt(its,kts),dvdt=dvdt(its,kts)                        &
+              ,dtaux2d=dtaux(its,kts),dtauy2d=dtauy(its,kts)                   &
+              ,u1=ugeo(its,kts),v1=vgeo(its,kts)                               &
+              ,t1=t3d(ims,kms,j),q1=qv3d(ims,kms,j)                            &
+              ,del=delprsi(its,kts)                                            &
+              ,prsi=pdhi(its,kts)                                              &
+              ,prsl=pdh(its,kts),prslk=pi3d(ims,kms,j)                         &
+              ,zl=z(ims,kms,j)                                                 &
+              ,kpblmax=kpblmax                                                 &
+              ,var=var2d(ims,j),oc1=oc12d(ims,j)                               &
+              ,oa4=oa4,ol4=ol4                                                 &
+              ,dusfc=dusfc(its),dvsfc=dvsfc(its)                               &
+              ,g_=g,cp_=cp,rd_=rd,rv_=rv,fv_=ep1,pi_=pi                        &
+              ,dxmeter=dx,deltim=dt                                            &
+              ,kpbl=kpbl2d(ims,j),lat=j                                        &
+              ,ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde               &
+              ,ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme               &
+              ,its=its,ite=ite, jts=jts,jte=jte, kts=kts,kte=kte   )
+      do k = kts,kte
+        do i = its,ite
+! rotate tendencies from zonal/meridional to model grid
+          rublten(i,k,j) = rublten(i,k,j)+dudt(i,k)*cosa(i,j) + dvdt(i,k)*sina(i,j)
+          rvblten(i,k,j) = rvblten(i,k,j)-dudt(i,k)*sina(i,j) + dvdt(i,k)*cosa(i,j)
+          dtaux3d(i,k,j) = dtaux(i,k)*cosa(i,j) + dtauy(i,k)*sina(i,j)
+          dtauy3d(i,k,j) =-dtaux(i,k)*sina(i,j) + dtauy(i,k)*cosa(i,j)
+          if(k.eq.kts)then
+             dusfcg(i,j) = dusfc(i)*cosa(i,j) + dvsfc(i)*sina(i,j)
+             dvsfcg(i,j) =-dusfc(i)*sina(i,j) + dvsfc(i)*cosa(i,j)
+          endif
+        enddo
+      enddo
    enddo
-!
 !
    end subroutine gwdo
-!
-!-------------------------------------------------------------------
-!
-!
-!
-!
-   subroutine gwdo2d(dudt,dvdt,dtaux2d,dtauy2d, &
-                    u1,v1,t1,q1, &
-                    prsi,del,prsl,prslk,zl,rcl, &
-                    var,oc1,oa4,ol4,dusfc,dvsfc, &
-                    g,cp,rd,rv,fv,pi,dxmeter,deltim,kpbl,kdt,lat, &
-                    ids,ide, jds,jde, kds,kde, &
-                    ims,ime, jms,jme, kms,kme, &
-                    its,ite, jts,jte, kts,kte)
-!-------------------------------------------------------------------
-!
-! this code handles the time tendencies of u v due to the effect of mountain
-! induced gravity wave drag from sub-grid scale orography. this routine
-! not only treats the traditional upper-level wave breaking due to mountain
-! variance (alpert 1988), but also the enhanced lower-tropospheric wave
-! breaking due to mountain convexity and asymmetry (kim and arakawa 1995).
-! thus, in addition to the terrain height data in a model grid gox,
-! additional 10-2d topographic statistics files are needed, including
-! orographic standard deviation (var), convexity (oc1), asymmetry (oa4)
-! and ol (ol4). these data sets are prepared based on the 30 sec usgs orography
-! hong (1999). the current scheme was implmented as in hong et al.(2008)
-!
-! coded by song-you hong and young-joon kim and implemented by song-you hong
-!
-! references:
-! hong et al. (2008), wea. and forecasting
-! kim and arakawa (1995), j. atmos. sci.
-! alpet et al. (1988), NWP conference.
-! hong (1999), NCEP office note 424.
-!
-! notice : comparible or lower resolution orography files than model resolution
-! are desirable in preprocess (wps) to prevent weakening of the drag
-!-------------------------------------------------------------------
-!
-! input
-! dudt (ims:ime,kms:kme) non-lin tendency for u wind component
-! dvdt (ims:ime,kms:kme) non-lin tendency for v wind component
-! u1(ims:ime,kms:kme) zonal wind / sqrt(rcl) m/sec at t0-dt
-! v1(ims:ime,kms:kme) meridional wind / sqrt(rcl) m/sec at t0-dt
-! t1(ims:ime,kms:kme) temperature deg k at t0-dt
-! q1(ims:ime,kms:kme) specific humidity at t0-dt
-!
-! rcl a scaling factor = reciprocal of square of cos(lat)
-! for mrf gsm. rcl=1 if u1 and v1 are wind components.
-! deltim time step secs
-! del(kts:kte) positive increment of pressure across layer (pa)
-!
-! output
-! dudt, dvdt wind tendency due to gwdo
-!
-!-------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+   subroutine gwdo2d(dudt, dvdt, dtaux2d, dtauy2d,                             &
+                     u1, v1, t1, q1,                                           &
+                     del,                                                      &
+                     prsi, prsl, prslk, zl,                                    &
+                     kpblmax,                                                  &
+                     var, oc1, oa4, ol4, dusfc, dvsfc,                         &
+                     g_, cp_, rd_, rv_, fv_, pi_,                              &
+                     dxmeter, deltim, kpbl, lat,                               &
+                     ids, ide, jds, jde, kds, kde,                             &
+                     ims, ime, jms, jme, kms, kme,                             &
+                     its, ite, jts, jte, kts, kte)
+!-------------------------------------------------------------------------------
+!  
+!  abstract : 
+!    this code handles the time tendencies of u v due to the effect of 
+!    mountain induced gravity wave drag from sub-grid scale orography. 
+!    this routine not only treats the traditional upper-level wave breaking due 
+!    to mountain variance (alpert 1988), but also the enhanced 
+!    lower-tropospheric wave breaking due to mountain convexity and asymmetry
+!    (kim and arakawa 1995). thus, in addition to the terrain height data 
+!    in a model grid gox, additional 10-2d topographic statistics files are 
+!    needed, including orographic standard  deviation (var), convexity (oc1), 
+!    asymmetry (oa4) and ol (ol4). these data sets are prepared based on the 
+!    30 sec usgs orography (hong 1999). the current scheme was implmented as in 
+!    choi and hong (2015), which names kim gwdo since it was developed by 
+!    kiaps staffs for kiaps integrated model system (kim). the scheme 
+!    additionally includes the effects of orographic anisotropy and 
+!    flow-blocking drag. 
+!    coded by song-you hong and young-joon kim and implemented by song-you hong
+!
+!  history log :
+!    2015-07-01  hyun-joo choi add flow-blocking drag and orographic anisotropy 
+!
+!  references :
+!    choi and hong (2015), j. geophys. res.
+!    hong et al. (2008), wea. forecasting
+!    kim and doyle (2005), q. j. r. meteor. soc.
+!    kim and arakawa (1995), j. atmos. sci.
+!    alpet et al. (1988), NWP conference
+!    hong (1999), NCEP office note 424
+!
+!  input :                                                                
+!    dudt, dvdt       - non-lin tendency for u and v wind component
+!    u1, v1           - zonal and meridional wind m/sec  at t0-dt
+!    t1               - temperature deg k at t0-dt
+!    q1               - mixing ratio at t0-dt
+!    deltim           - time step (s)                                      
+!    del              - positive increment of pressure across layer (pa)
+!    kpblmax, kpbl    - vertical index of pbl height  
+!    prslk, zl, prsl, prsi    - pressure and height variables
+!    oa4, ol4, omax, var, oc1 - orographic statistics 
+!                                                                       
+!  output :
+!    dudt, dvdt - wind tendency due to gwdo
+!    dtaux2d, dtauy2d - diagnoised orographic gwd
+!    dusfc, dvsfc     - gw stress
+!
+!-------------------------------------------------------------------------------
    implicit none
-!-------------------------------------------------------------------
-   integer :: kdt,lat,latd,lond, &
-                            ids,ide, jds,jde, kds,kde, &
-                            ims,ime, jms,jme, kms,kme, &
-                            its,ite, jts,jte, kts,kte
-!
-!MPAS specific (Laura D. Fowler 2013-02-12):
-#if defined(mpas)
-   real :: g,rd,rv,fv,cp,pi,deltim,rcl
-   real, dimension(ims:ime):: dxmeter
-#else
-   real :: g,rd,rv,fv,cp,pi,dxmeter,deltim,rcl
-#endif
-!MPAS specific end.
-
-   real :: dudt(ims:ime,kms:kme),dvdt(ims:ime,kms:kme), &
-                            dtaux2d(ims:ime,kms:kme),dtauy2d(ims:ime,kms:kme), &
-                            u1(ims:ime,kms:kme),v1(ims:ime,kms:kme), &
-                            t1(ims:ime,kms:kme),q1(ims:ime,kms:kme), &
-                            zl(ims:ime,kms:kme),prslk(ims:ime,kms:kme)
-   real :: prsl(its:ite,kts:kte),prsi(its:ite,kts:kte+1), &
-                            del(its:ite,kts:kte)
-   real :: oa4(its:ite,4),ol4(its:ite,4)
-!
-   integer :: kpbl(ims:ime)
-   real :: var(ims:ime),oc1(ims:ime), &
-                            dusfc(ims:ime),dvsfc(ims:ime)
-! critical richardson number for wave breaking : ! larger drag with larger value
-!
-   real,parameter :: ric = 0.25
-!
-   real,parameter :: dw2min = 1.
-   real,parameter :: rimin = -100.
-   real,parameter :: bnv2min = 1.0e-5
-   real,parameter :: efmin = 0.0
-   real,parameter :: efmax = 10.0
-   real,parameter :: xl = 4.0e4
-   real,parameter :: critac = 1.0e-5
-   real,parameter :: gmax = 1.
-   real,parameter :: veleps = 1.0
-   real,parameter :: factop = 0.5
-   real,parameter :: frc = 1.0
-   real,parameter :: ce = 0.8
-   real,parameter :: cg = 0.5
+!
+   integer                           , intent(in   ) :: lat, kpblmax,          &
+                                                        ids, ide, jds, jde,    &
+                                                        kds, kde, ims, ime,    &
+                                                        jms, jme, kms, kme,    &
+                                                        its, ite, jts, jte,    &
+                                                        kts, kte
+   integer, dimension(ims:ime)       , intent(in   ) :: kpbl
+   real                              , intent(in   ) :: g_, pi_, rd_, rv_, fv_,&
+                                                        cp_, deltim
+   real, dimension(ims:ime)          , intent(in   ) :: dxmeter
+   real, dimension(its:ite,kts:kte)  , intent(inout) :: dudt, dvdt        
+   real, dimension(its:ite,kts:kte)  , intent(  out) :: dtaux2d, dtauy2d  
+   real, dimension(its:ite,kts:kte)  , intent(in   ) :: u1, v1
+   real, dimension(ims:ime,kms:kme)  , intent(in   ) :: t1, q1, prslk, zl 
+!
+   real, dimension(its:ite,kts:kte)  , intent(in   ) :: prsl, del 
+   real, dimension(its:ite,kts:kte+1), intent(in   ) :: prsi
+   real, dimension(its:ite,4)        , intent(in   ) :: oa4, ol4
+!
+   real, dimension(ims:ime)          , intent(in   ) :: var, oc1
+   real, dimension(its:ite)          , intent(  out) :: dusfc, dvsfc
+!
+   real, parameter      ::  ric     = 0.25    ! critical richardson number 
+   real, parameter      ::  dw2min  = 1.
+   real, parameter      ::  rimin   = -100.
+   real, parameter      ::  bnv2min = 1.0e-5
+   real, parameter      ::  efmin   = 0.0
+   real, parameter      ::  efmax   = 10.0
+   real, parameter      ::  xl      = 4.0e4  
+   real, parameter      ::  critac  = 1.0e-5
+   real, parameter      ::  gmax    = 1.    
+   real, parameter      ::  veleps  = 1.0                                                 
+   real, parameter      ::  frc     = 1.0      
+   real, parameter      ::  ce      = 0.8     
+   real, parameter      ::  cg      = 0.5    
+   integer,parameter    ::  kpblmin = 2
 !
 ! local variables
 !
-   integer :: i,k,lcap,lcapp1,nwd,idir,kpblmin,kpblmax, &
+   integer              ::  latd,lond
+   integer              ::  i,k,lcap,lcapp1,nwd,idir,                          &
                             klcap,kp1,ikount,kk
 !
-!MPAS specific (Laura D. Fowler 2013-02-12):
-#if defined(mpas)
-   real :: rcs,rclcs,csg,fdir,cs,rcsks, &
-                            wdir,ti,rdz,temp,tem2,dw2,shr2,bvf2,rdelks, &
-                            wtkbj,coefm,tem,gfobnv,hd,fro,rim,temc,tem1,efact, &
+   real                 ::  fdir,cs,rcsks,                                     &
+                            wdir,ti,rdz,temp,tem2,dw2,shr2,bvf2,rdelks,        &
+                            wtkbj,tem,gfobnv,hd,fro,rim,temc,tem1,efact,       &
                             temv,dtaux,dtauy
-   real, dimension(its:ite):: cleff
-#else
-   real :: rcs,rclcs,csg,fdir,cleff,cs,rcsks, &
-                            wdir,ti,rdz,temp,tem2,dw2,shr2,bvf2,rdelks, &
-                            wtkbj,coefm,tem,gfobnv,hd,fro,rim,temc,tem1,efact, &
-                            temv,dtaux,dtauy
-#endif	
-!
-   logical :: ldrag(its:ite),icrilv(its:ite), &
-                            flag(its:ite),kloop1(its:ite)
-!
-   real :: taub(its:ite),taup(its:ite,kts:kte+1), &
-                            xn(its:ite),yn(its:ite), &
-                            ubar(its:ite),vbar(its:ite), &
-                            fr(its:ite),ulow(its:ite), &
-                            rulow(its:ite),bnv(its:ite), &
-                            oa(its:ite),ol(its:ite), &
-                            roll(its:ite),dtfac(its:ite), &
-                            brvf(its:ite),xlinv(its:ite), &
-                            delks(its:ite),delks1(its:ite), &
-                            bnv2(its:ite,kts:kte),usqj(its:ite,kts:kte), &
-                            taud(its:ite,kts:kte),ro(its:ite,kts:kte), &
-                            vtk(its:ite,kts:kte),vtj(its:ite,kts:kte), &
-                            zlowtop(its:ite),velco(its:ite,kts:kte-1)
-!
-   integer :: kbl(its:ite),klowtop(its:ite), &
-                            lowlv(its:ite)
-!
-   logical :: iope
-   integer,parameter :: mdir=8
-   integer :: nwdir(mdir)
+!
+   logical, dimension(its:ite)        :: ldrag, icrilv, flag,kloop1
+   real, dimension(its:ite)           :: coefm
+!                                                                       
+   real, dimension(its:ite)           :: taub, xn, yn, ubar, vbar, fr,         &
+                                         ulow, rulow, bnv, oa, ol, rhobar,     &
+                                         dtfac, brvf, xlinv, delks,delks1,     &
+                                         zlowtop,cleff
+   real, dimension(its:ite,kts:kte+1) :: taup
+   real, dimension(its:ite,kts:kte-1) :: velco
+   real, dimension(its:ite,kts:kte)   :: bnv2, usqj, taud, rho, vtk, vtj
+!
+   integer, dimension(its:ite)        :: kbl, klowtop
+   integer, parameter       ::  mdir=8
+   integer, dimension(mdir) :: nwdir
    data nwdir/6,7,5,8,2,3,1,4/
 !
-! initialize local variables
+! variables for flow-blocking drag
 !
-   kbl=0 ; klowtop=0 ; lowlv=0
+   real, parameter      :: frmax  = 10.
+   real, parameter      :: olmin  = 1.0e-5
+   real, parameter      :: odmin  = 0.1 
+   real, parameter      :: odmax  = 10. 
 !
-!---- constants
+   real                               :: fbdcd
+   real                               :: zblk, tautem
+   real                               :: fbdpe, fbdke 
+   real, dimension(its:ite)           :: delx, dely
+   real, dimension(its:ite,4)         :: dxy4, dxy4p
+   real, dimension(4)                 :: ol4p
+   real, dimension(its:ite)           :: dxy, dxyp, olp, od
+   real, dimension(its:ite,kts:kte+1) :: taufb
 !
-   rcs = sqrt(rcl)
-   cs = 1. / sqrt(rcl)
-   csg = cs * g
-   lcap = kte
-   lcapp1 = lcap + 1
-   fdir = mdir / (2.0*pi)
+   integer, dimension(its:ite)        :: komax
+   integer                            :: kblk
+!-------------------------------------------------------------------------------
 !
+! constants                                                         
+!                                                                       
+   lcap   = kte                                                         
+   lcapp1 = lcap + 1                                                 
+   fdir   = mdir / (2.0*pi_)
 !
-!!!!!!! cleff (subgrid mountain scale ) is highly tunable parameter
-!!!!!!! the bigger (smaller) value produce weaker (stronger) wave drag
+! calculate length of grid for flow-blocking drag
 !
-!MPAS specific (Laura D. Fowler 2013-02-13):
-#if defined(mpas)
-   do i = its, ite
-      cleff(i) = max(dxmeter(i),50.e3)
-   enddo
-#else
-   cleff = max(dxmeter,50.e3)
-#endif
-!MPAS specific end.
+   delx(its:ite) = dxmeter(its:ite)
+   dely(its:ite) = dxmeter(its:ite)
+   dxy4(its:ite,1)  = delx(its:ite)
+   dxy4(its:ite,2)  = dely(its:ite)
+   dxy4(its:ite,3)  = sqrt(delx(its:ite)**2. + dely(its:ite)**2.)
+   dxy4(its:ite,4)  = dxy4(its:ite,3)
+   dxy4p(its:ite,1) = dxy4(its:ite,2)
+   dxy4p(its:ite,2) = dxy4(its:ite,1)
+   dxy4p(its:ite,3) = dxy4(its:ite,4)
+   dxy4p(its:ite,4) = dxy4(its:ite,3)
 !
-! initialize!!
+   cleff(its:ite) = dxmeter
 !
-   dtaux = 0.0
-   dtauy = 0.0
-   do k = kts,kte
-     do i = its,ite
-       usqj(i,k) = 0.0
-       bnv2(i,k) = 0.0
-       vtj(i,k) = 0.0
-       vtk(i,k) = 0.0
-       taup(i,k) = 0.0
-       taud(i,k) = 0.0
-       dtaux2d(i,k)= 0.0
-       dtauy2d(i,k)= 0.0
-     enddo
-   enddo
-   do i = its,ite
-     taup(i,kte+1) = 0.0
-     xlinv(i) = 1.0/xl
-   enddo
+! initialize arrays                                                 
+!                                                                       
+   ldrag   = .false. ; icrilv = .false. ; flag    = .true.
+!
+   klowtop = 0       ; kbl    = 0
+!
+   dtaux   = 0.      ; dtauy  = 0.      ; xn      = 0.     ; yn      = 0.  
+   ubar    = 0.      ; vbar   = 0.      ; rhobar  = 0.     ; ulow    = 0.
+   oa      = 0.      ; ol     = 0.      ; taub    = 0.  
+!
+   usqj    = 0.      ; bnv2   = 0.      ; vtj     = 0.     ; vtk     = 0. 
+   taup    = 0.      ; taud   = 0.      ; dtaux2d = 0.     ; dtauy2d = 0.
+!
+   dtfac   = 1.0     ; xlinv  = 1.0/xl
+!
+! initialize arrays for flow-blocking drag
+!
+   komax = 0
+   taufb = 0.0
 !
    do k = kts,kte
      do i = its,ite
-       vtj(i,k) = t1(i,k) * (1.+fv*q1(i,k))
+       vtj(i,k) = t1(i,k)  * (1.+fv_*q1(i,k))
        vtk(i,k) = vtj(i,k) / prslk(i,k)
-       ro(i,k) = 1./rd * prsl(i,k) / vtj(i,k) ! density kg/m**3
+       rho(i,k) = 1./rd_ * prsl(i,k) / vtj(i,k) ! density kg/m**3
      enddo
    enddo
 !
    do i = its,ite
      zlowtop(i) = 2. * var(i)
    enddo
-!
-!--- determine new reference level > 2*var
 !
    do i = its,ite
      kloop1(i) = .true.
    enddo
+!
    do k = kts+1,kte
      do i = its,ite
-       if(kloop1(i).and.zl(i,k)-zl(i,1).ge.zlowtop(i)) then
+       if(zlowtop(i) .gt. 0.) then
+       if (kloop1(i).and.zl(i,k)-zl(i,1).ge.zlowtop(i)) then
          klowtop(i) = k+1
          kloop1(i) = .false.
        endif
-     enddo
-   enddo
-!
-   kpblmax = 2
-   do i = its,ite
-     kbl(i) = max(2, kpbl(i))
-     kbl(i) = max(kbl(i), klowtop(i))
-     delks(i) = 1.0 / (prsi(i,1) - prsi(i,kbl(i)))
-     ubar (i) = 0.0
-     vbar (i) = 0.0
-     taup(i,1) = 0.0
-     oa(i) = 0.0
-     kpblmax = max(kpblmax,kbl(i))
-     flag(i) = .true.
-     lowlv(i) = 2
-   enddo
-   kpblmax = min(kpblmax+1,kte-1)
-!
-! compute low level averages within pbl
-!
-   do k = kts,kpblmax
-     do i = its,ite
-       if (k.lt.kbl(i)) then
-         rcsks = rcs * del(i,k) * delks(i)
-         ubar(i) = ubar(i) + rcsks * u1(i,k) ! pbl u mean
-         vbar(i) = vbar(i) + rcsks * v1(i,k) ! pbl v mean
        endif
      enddo
    enddo
-!
-! figure out low-level horizontal wind direction
-!
-! nwd 1 2 3 4 5 6 7 8
-! wd w s sw nw e n ne se
 !
    do i = its,ite
-     wdir = atan2(ubar(i),vbar(i)) + pi
-     idir = mod(nint(fdir*wdir),mdir) + 1
-     nwd = nwdir(idir)
-     oa(i) = (1-2*int( (nwd-1)/4 )) * oa4(i,mod(nwd-1,4)+1)
-     ol(i) = ol4(i,mod(nwd-1,4)+1)
-   enddo
 !
-   kpblmax = 2
-   kpblmin = kte
-   do i = its,ite
-     if (oa(i).le.0.0) kbl(i) = kpbl(i) + 1
-     kpblmax = max(kpblmax,kbl(i))
-     kpblmin = min(kpblmin, kbl(i))
-   enddo
-   kpblmax = min(kpblmax+1,kte-1)
+! determine reference level: 2*var
 !
-   do i = its,ite
-     delks(i) = 1.0 / (prsi(i,1) - prsi(i,kbl(i)))
-     delks1(i) = 1.0 / (prsl(i,1) - prsl(i,kbl(i)))
+     kbl(i) = klowtop(i)
+     kbl(i) = max(min(kbl(i),kpblmax),kpblmin)
    enddo
 !
-!--- saving richardson number in usqj for migwdi
-!
-   do k = kts,kte-1
-     do i = its,ite
-       ti = 2.0 / (t1(i,k)+t1(i,k+1))
-       rdz = 1./(zl(i,k+1) - zl(i,k))
-       tem1 = u1(i,k) - u1(i,k+1)
-       tem2 = v1(i,k) - v1(i,k+1)
-       dw2 = rcl*(tem1*tem1 + tem2*tem2)
-       shr2 = max(dw2,dw2min) * rdz * rdz
-       bvf2 = g*(g/cp+rdz*(vtj(i,k+1)-vtj(i,k))) * ti
-       usqj(i,k) = max(bvf2/shr2,rimin)
-       bnv2(i,k) = 2*g*rdz*(vtk(i,k+1)-vtk(i,k))/(vtk(i,k+1)+vtk(i,k))
-       bnv2(i,k) = max( bnv2(i,k), bnv2min )
-     enddo
-   enddo
+! determine the level of maximum orographic height
 !
-!-----initialize arrays
+   komax(:) = kbl(:)
 !
    do i = its,ite
-     xn(i) = 0.0
-     yn(i) = 0.0
-     ubar (i) = 0.0
-     vbar (i) = 0.0
-     roll (i) = 0.0
-     taub (i) = 0.0
-     ulow (i) = 0.0
-     dtfac(i) = 1.0
-     ldrag(i) = .false.
-     icrilv(i) = .false. ! initialize critical level control vector
+     delks(i)  = 1.0 / (prsi(i,1) - prsi(i,kbl(i)))
+     delks1(i) = 1.0 / (prsl(i,1) - prsl(i,kbl(i)))
    enddo
 !
-!---- compute low level averages
-!---- (u,v)*cos(lat) use uv=(u1,v1) which is wind at t0-1
-!---- use rcs=1/cos(lat) to get wind field
+! compute low level averages within pbl
 !
-   do k = 1,kpblmax
+   do k = kts,kpblmax
      do i = its,ite
-       if (k .lt. kbl(i)) then
-         rdelks = del(i,k) * delks(i)
-         rcsks = rcs * rdelks
-         ubar(i) = ubar(i) + rcsks * u1(i,k) ! u mean
-         vbar(i) = vbar(i) + rcsks * v1(i,k) ! v mean
-         roll(i) = roll(i) + rdelks * ro(i,k) ! ro mean
+       if (k.lt.kbl(i)) then
+         rcsks     = del(i,k) * delks(i)
+         rdelks    = del(i,k)  * delks(i)
+         ubar(i)   = ubar(i) + rcsks  * u1(i,k)      ! pbl  u  mean
+         vbar(i)   = vbar(i) + rcsks  * v1(i,k)      ! pbl  v  mean
+         rhobar(i) = rhobar(i) + rdelks * rho(i,k)   ! pbl rho mean
        endif
      enddo
    enddo
 !
-!----compute the "low level" or 1/3 wind magnitude (m/s)
+! figure out low-level horizontal wind direction 
 !
-   do i = its,ite
+! nwd  1   2   3   4   5   6   7   8
+! wd   w   s  sw  nw   e   n  ne  se
+!
+   do i = its,ite                                                       
+     wdir  = atan2(ubar(i),vbar(i)) + pi_
+     idir  = mod(nint(fdir*wdir),mdir) + 1
+     nwd   = nwdir(idir)
+     oa(i) = (1-2*int( (nwd-1)/4 )) * oa4(i,mod(nwd-1,4)+1)
+     ol(i) = ol4(i,mod(nwd-1,4)+1) 
+!
+! compute orographic width along (ol) and perpendicular (olp) the wind direction
+!
+     ol4p(1) = ol4(i,2)
+     ol4p(2) = ol4(i,1)
+     ol4p(3) = ol4(i,4)
+     ol4p(4) = ol4(i,3)
+     olp(i)  = ol4p(mod(nwd-1,4)+1) 
+!
+! compute orographic direction (horizontal orographic aspect ratio)
+!
+     od(i) = olp(i)/max(ol(i),olmin)
+     od(i) = min(od(i),odmax)
+     od(i) = max(od(i),odmin)
+!
+! compute length of grid in the along(dxy) and cross(dxyp) wind directions
+!
+     dxy(i)  = dxy4(i,MOD(nwd-1,4)+1)
+     dxyp(i) = dxy4p(i,MOD(nwd-1,4)+1)
+   enddo
+!                                                                       
+! saving richardson number in usqj for migwdi                       
+!
+   do k = kts,kte-1                                                     
+     do i = its,ite                                                     
+       ti        = 2.0 / (t1(i,k)+t1(i,k+1))                                
+       rdz       = 1./(zl(i,k+1) - zl(i,k))
+       tem1      = u1(i,k) - u1(i,k+1)
+       tem2      = v1(i,k) - v1(i,k+1)   
+       dw2       = tem1*tem1 + tem2*tem2
+       shr2      = max(dw2,dw2min) * rdz * rdz
+       bvf2      = g_*(g_/cp_+rdz*(vtj(i,k+1)-vtj(i,k))) * ti                
+       usqj(i,k) = max(bvf2/shr2,rimin)                            
+       bnv2(i,k) = 2.0*g_*rdz*(vtk(i,k+1)-vtk(i,k))/(vtk(i,k+1)+vtk(i,k))
+     enddo                                                          
+   enddo                                                             
+!
+! compute the "low level" or 1/3 wind magnitude (m/s)                
+!                                                                       
+   do i = its,ite                                                       
      ulow(i) = max(sqrt(ubar(i)*ubar(i) + vbar(i)*vbar(i)), 1.0)
      rulow(i) = 1./ulow(i)
-   enddo
+   enddo                                                             
 !
-   do k = kts,kte-1
-     do i = its,ite
-       velco(i,k) = (0.5*rcs) * ((u1(i,k)+u1(i,k+1)) * ubar(i) &
-                                + (v1(i,k)+v1(i,k+1)) * vbar(i))
-       velco(i,k) = velco(i,k) * rulow(i)
+   do k = kts,kte-1                                                    
+     do i = its,ite                                                   
+       velco(i,k) = 0.5 * ((u1(i,k)+u1(i,k+1)) * ubar(i)                       &
+                          + (v1(i,k)+v1(i,k+1)) * vbar(i))                 
+       velco(i,k) = velco(i,k) * rulow(i)                               
        if ((velco(i,k).lt.veleps) .and. (velco(i,k).gt.0.)) then
-         velco(i,k) = veleps
+         velco(i,k) = veleps                                      
        endif
-     enddo
-   enddo
-!
-! no drag when critical level in the base layer
-!
-   do i = its,ite
-     ldrag(i) = velco(i,1).le.0.
-   enddo
-!
-   do k = kts+1,kpblmax-1
-     do i = its,ite
+     enddo                                                          
+   enddo                                                             
+!                                                                       
+! no drag when critical level in the base layer                        
+!                                                                       
+   do i = its,ite                                                       
+     ldrag(i) = velco(i,1).le.0.                                    
+   enddo                                                             
+!
+!  no drag when velco.lt.0                                               
+!                                                                       
+   do k = kpblmin,kpblmax
+     do i = its,ite                                                    
        if (k .lt. kbl(i)) ldrag(i) = ldrag(i).or. velco(i,k).le.0.
-     enddo
-   enddo
-!
-! no drag when bnv2.lt.0
-!
-   do k = kts,kpblmax-1
-     do i = its,ite
-       if (k .lt. kbl(i)) ldrag(i) = ldrag(i).or. bnv2(i,k).lt.0.
-     enddo
-   enddo
-!
-!-----the low level weighted average ri is stored in usqj(1,1; im)
-!-----the low level weighted average n**2 is stored in bnv2(1,1; im)
-!---- this is called bnvl2 in phys_gwd_alpert_sub not bnv2
-!---- rdelks (del(k)/delks) vert ave factor so we can * instead of /
-!
-   do i = its,ite
-     wtkbj = (prsl(i,1)-prsl(i,2)) * delks1(i)
-     bnv2(i,1) = wtkbj * bnv2(i,1)
-     usqj(i,1) = wtkbj * usqj(i,1)
-   enddo
-!
-   do k = kts+1,kpblmax-1
-     do i = its,ite
+     enddo                                                          
+   enddo                                                             
+!                                                                       
+! the low level weighted average ri is stored in usqj(1,1; im)      
+! the low level weighted average n**2 is stored in bnv2(1,1; im)    
+! this is called bnvl2 in phy_gwd_alpert_sub not bnv2                           
+! rdelks (del(k)/delks) vert ave factor so we can * instead of /    
+!                                                                       
+   do i = its,ite                                                       
+     wtkbj     = (prsl(i,1)-prsl(i,2)) * delks1(i)
+     bnv2(i,1) = wtkbj * bnv2(i,1)                                
+     usqj(i,1) = wtkbj * usqj(i,1)                                
+   enddo                                                             
+!
+   do k = kpblmin,kpblmax                                                
+     do i = its,ite                                                    
        if (k .lt. kbl(i)) then
-         rdelks = (prsl(i,k)-prsl(i,k+1)) * delks1(i)
+         rdelks    = (prsl(i,k)-prsl(i,k+1)) * delks1(i)
          bnv2(i,1) = bnv2(i,1) + bnv2(i,k) * rdelks
          usqj(i,1) = usqj(i,1) + usqj(i,k) * rdelks
        endif
-     enddo
-   enddo
-!
-   do i = its,ite
-     ldrag(i) = ldrag(i) .or. bnv2(i,1).le.0.0
-     ldrag(i) = ldrag(i) .or. ulow(i).eq.1.0
+     enddo                                                          
+   enddo                                                             
+!                                                                       
+   do i = its,ite                                                       
+     ldrag(i) = ldrag(i) .or. bnv2(i,1).le.0.0                         
+     ldrag(i) = ldrag(i) .or. ulow(i).eq.1.0                           
      ldrag(i) = ldrag(i) .or. var(i) .le. 0.0
-   enddo
-!
-! ----- set all ri low level values to the low level value
-!
-   do k = kts+1,kpblmax-1
-     do i = its,ite
+   enddo                                                             
+!                                                                       
+! set all ri low level values to the low level value          
+!                                                                       
+   do k = kpblmin,kpblmax
+     do i = its,ite                                                    
        if (k .lt. kbl(i)) usqj(i,k) = usqj(i,1)
-     enddo
-   enddo
-!
-   do i = its,ite
-     if (.not.ldrag(i)) then
-       bnv(i) = sqrt( bnv2(i,1) )
-       fr(i) = bnv(i) * rulow(i) * var(i)
-       xn(i) = ubar(i) * rulow(i)
-       yn(i) = vbar(i) * rulow(i)
+     enddo                                                          
+   enddo                                                             
+!
+   do i = its,ite 
+     if (.not.ldrag(i))   then   
+       bnv(i) = sqrt( bnv2(i,1) )                                  
+       fr(i) = bnv(i)  * rulow(i) * var(i) * od(i)
+       fr(i) = min(fr(i),frmax)
+       xn(i)  = ubar(i) * rulow(i)
+       yn(i)  = vbar(i) * rulow(i)
      endif
    enddo
 !
 ! compute the base level stress and store it in taub
-! calculate enhancement factor, number of mountains & aspect
-! ratio const. use simplified relationship between standard
-! deviation & critical hgt
-!
-   do i = its,ite
-     if (.not. ldrag(i)) then
-       efact = (oa(i) + 2.) ** (ce*fr(i)/frc)
-       efact = min( max(efact,efmin), efmax )
-       coefm = (1. + ol(i)) ** (oa(i)+1.)
-!MPAS specific (Laura D. Fowler 2013-02-12):
-#if defined(mpas)
-       xlinv(i) = coefm / cleff(i)
-#else
-       xlinv(i) = coefm / cleff
-#endif
-       tem = fr(i) * fr(i) * oc1(i)
-       gfobnv = gmax * tem / ((tem + cg)*bnv(i))
-       taub(i) = xlinv(i) * roll(i) * ulow(i) * ulow(i) &
-                * ulow(i) * gfobnv * efact
-     else
-       taub(i) = 0.0
-       xn(i) = 0.0
-       yn(i) = 0.0
-     endif
-   enddo
-!
+! calculate enhancement factor, number of mountains & aspect        
+! ratio const. use simplified relationship between standard            
+! deviation & critical hgt                                          
+!
+   do i = its,ite                                                       
+     if (.not. ldrag(i))   then   
+       efact    = (oa(i) + 2.) ** (ce*fr(i)/frc)                         
+       efact    = min( max(efact,efmin), efmax )                            
+       coefm(i) = (1. + ol(i)) ** (oa(i)+1.)                   
+       xlinv(i) = coefm(i) / cleff(i)
+       tem      = fr(i) * fr(i) * oc1(i)
+       gfobnv   = gmax * tem / ((tem + cg)*bnv(i))   
+       taub(i)  = xlinv(i) * rhobar(i) * ulow(i) * ulow(i)                     &
+                * ulow(i) * gfobnv * efact          
+     else                                                          
+       taub(i) = 0.0                                             
+       xn(i)   = 0.0                                             
+       yn(i)   = 0.0                                             
+     endif                                                         
+   enddo                                                             
+!                                                                       
 ! now compute vertical structure of the stress.
-!
-!----set up bottom values of stress
 !
    do k = kts,kpblmax
      do i = its,ite
@@ -636,117 +600,149 @@ subroutine gwdo2d(dudt,dvdt,dtaux2d,dtauy2d, &
      enddo
    enddo
 !
-   do k = kpblmin, kte-1 ! vertical level k loop!
+   do k = kpblmin, kte-1                   ! vertical level k loop!
      kp1 = k + 1
      do i = its,ite
 !
-!-----unstablelayer if ri < ric
-!-----unstable layer if upper air vel comp along surf vel <=0 (crit lay)
-!---- at (u-c)=0. crit layer exists and bit vector should be set (.le.)
+! unstablelayer if ri < ric
+! unstable layer if upper air vel comp along surf vel <=0 (crit lay)
+! at (u-c)=0. crit layer exists and bit vector should be set (.le.)
 !
        if (k .ge. kbl(i)) then
-         icrilv(i) = icrilv(i) .or. ( usqj(i,k) .lt. ric) &
+         icrilv(i) = icrilv(i) .or. ( usqj(i,k) .lt. ric)                      &
                                .or. (velco(i,k) .le. 0.0)
          brvf(i) = max(bnv2(i,k),bnv2min) ! brunt-vaisala frequency squared
-         brvf(i) = sqrt(brvf(i)) ! brunt-vaisala frequency
+         brvf(i) = sqrt(brvf(i))          ! brunt-vaisala frequency
        endif
      enddo
 !
      do i = its,ite
-       if (k .ge. kbl(i) .and. (.not. ldrag(i))) then
+       if (k .ge. kbl(i) .and. (.not. ldrag(i)))   then   
          if (.not.icrilv(i) .and. taup(i,k) .gt. 0.0 ) then
            temv = 1.0 / velco(i,k)
-           tem1 = xlinv(i)*(ro(i,kp1)+ro(i,k))*brvf(i)*velco(i,k)*0.5
-           hd = sqrt(taup(i,k) / tem1)
-           fro = brvf(i) * hd * temv
+           tem1 = coefm(i)/dxy(i)*(rho(i,kp1)+rho(i,k))*brvf(i)*velco(i,k)*0.5
+           hd   = sqrt(taup(i,k) / tem1)
+           fro  = brvf(i) * hd * temv
 !
-! rim is the minimum-richardson number by shutts (1985)
+! rim is the  minimum-richardson number by shutts (1985)
 !
            tem2 = sqrt(usqj(i,k))
-           tem = 1. + tem2 * fro
-           rim = usqj(i,k) * (1.-fro) / (tem * tem)
+           tem  = 1. + tem2 * fro
+           rim  = usqj(i,k) * (1.-fro) / (tem * tem)
 !
 ! check stability to employ the 'saturation hypothesis'
 ! of lindzen (1981) except at tropospheric downstream regions
 !
-           if (rim .le. ric) then ! saturation hypothesis!
-             if ((oa(i) .le. 0. .or. kp1 .ge. lowlv(i) )) then
+           if (rim .le. ric) then  ! saturation hypothesis!
+             if ((oa(i) .le. 0.).or.(kp1 .ge. kpblmin )) then
                temc = 2.0 + 1.0 / tem2
-               hd = velco(i,k) * (2.*sqrt(temc)-temc) / brvf(i)
+               hd   = velco(i,k) * (2.*sqrt(temc)-temc) / brvf(i)
                taup(i,kp1) = tem1 * hd * hd
              endif
-           else ! no wavebreaking!
+           else                    ! no wavebreaking!
              taup(i,kp1) = taup(i,k)
            endif
          endif
        endif
-     enddo
+     enddo      
    enddo
 !
-   if(lcap.lt.kte) then
-     do klcap = lcapp1,kte
-       do i = its,ite
-         taup(i,klcap) = prsi(i,klcap) / prsi(i,lcap) * taup(i,lcap)
-       enddo
-     enddo
-   endif
+   if (lcap.lt.kte) then                                               
+     do klcap = lcapp1,kte                                          
+       do i = its,ite                                                 
+         taup(i,klcap) = prsi(i,klcap) / prsi(i,lcap) * taup(i,lcap)      
+       enddo                                                       
+     enddo                                                          
+   endif                                                             
+   do i = its,ite
+     if (.not.ldrag(i)) then
 !
-! calculate - (g)*d(tau)/d(pressure) and deceleration terms dtaux, dtauy
+! determine the height of flow-blocking layer
 !
-   do k = kts,kte
-     do i = its,ite
-       taud(i,k) = 1. * (taup(i,k+1) - taup(i,k)) * csg / del(i,k)
-     enddo
-   enddo
+       kblk = 0
+       fbdpe = 0.0
+       fbdke = 0.0
+       do k = kte, kpblmin, -1
+         if (kblk.eq.0 .and. k.le.kbl(i)) then
+           fbdpe = fbdpe + bnv2(i,k)*(zl(i,kbl(i))-zl(i,k))                    &
+                   *del(i,k)/g_/rho(i,k)
+           fbdke = 0.5*(u1(i,k)**2.+v1(i,k)**2.)
 !
-!------limit de-acceleration (momentum deposition ) at top to 1/2 value
-!------the idea is some stuff must go out the 'top'
+! apply flow-blocking drag when fbdpe >= fbdke 
 !
-   do klcap = lcap,kte
-     do i = its,ite
-       taud(i,klcap) = taud(i,klcap) * factop
-     enddo
-   enddo
+           if (fbdpe.ge.fbdke) then
+             kblk = k
+             kblk = min(kblk,kbl(i))
+             zblk = zl(i,kblk)-zl(i,kts)
+           endif
+         endif
+       enddo
+       if (kblk.ne.0) then
 !
-!------if the gravity wave drag would force a critical line
-!------in the lower ksmm1 layers during the next deltim timestep,
-!------then only apply drag until that critical line is reached.
+! compute flow-blocking stress
 !
-   do k = kts,kpblmax-1
-     do i = its,ite
+         fbdcd = max(2.0-1.0/od(i),0.0)
+         taufb(i,kts) = 0.5*rhobar(i)*coefm(i)/dxmeter(i)**2*fbdcd*dxyp(i)     &
+                        *olp(i)*zblk*ulow(i)**2
+         tautem = taufb(i,kts)/real(kblk-kts)
+         do k = kts+1, kblk
+           taufb(i,k) = taufb(i,k-1) - tautem
+         enddo
+!
+! sum orographic GW stress and flow-blocking stress
+!
+         taup(i,:) = taup(i,:) + taufb(i,:)
+       endif
+     endif
+   enddo 
+!                                                                       
+! calculate - (g)*d(tau)/d(pressure) and deceleration terms dtaux, dtauy
+!
+   do k = kts,kte                                                       
+     do i = its,ite                                                       
+       taud(i,k) = 1. * (taup(i,k+1) - taup(i,k)) * g_ / del(i,k)
+     enddo                                                             
+   enddo                                                             
+!                                                                       
+! if the gravity wave drag would force a critical line             
+! in the lower ksmm1 layers during the next deltim timestep,     
+! then only apply drag until that critical line is reached.        
+!                                                                       
+   do k = kts,kpblmax-1                                                    
+     do i = its,ite                                                    
        if (k .le. kbl(i)) then
-         if(taud(i,k).ne.0.) &
-         dtfac(i) = min(dtfac(i),abs(velco(i,k) &
-                   /(deltim*rcs*taud(i,k))))
+         if (taud(i,k).ne.0.)                                                   &
+           dtfac(i) = min(dtfac(i),abs(velco(i,k)/(deltim*taud(i,k))))  
        endif
-     enddo
-   enddo
+     enddo                                                          
+   enddo                                                             
 !
    do i = its,ite
      dusfc(i) = 0.
      dvsfc(i) = 0.
    enddo
 !
-   do k = kts,kte
-     do i = its,ite
-       taud(i,k) = taud(i,k) * dtfac(i)
+   do k = kts,kte                                                       
+     do i = its,ite 
+       taud(i,k) = taud(i,k) * dtfac(i)                              
        dtaux = taud(i,k) * xn(i)
        dtauy = taud(i,k) * yn(i)
        dtaux2d(i,k) = dtaux
        dtauy2d(i,k) = dtauy
        dudt(i,k) = dtaux + dudt(i,k)
        dvdt(i,k) = dtauy + dvdt(i,k)
-       dusfc(i) = dusfc(i) + dtaux * del(i,k)
-       dvsfc(i) = dvsfc(i) + dtauy * del(i,k)
-     enddo
-   enddo
+       dusfc(i)  = dusfc(i) + dtaux * del(i,k)
+       dvsfc(i)  = dvsfc(i) + dtauy * del(i,k)
+     enddo                                                          
+   enddo                                                             
 !
    do i = its,ite
-     dusfc(i) = (-1./g*rcs) * dusfc(i)
-     dvsfc(i) = (-1./g*rcs) * dvsfc(i)
+     dusfc(i) = (-1./g_) * dusfc(i)
+     dvsfc(i) = (-1./g_) * dvsfc(i)
    enddo
 !
-   return
+   return                                                            
    end subroutine gwdo2d
-!-------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
 end module module_bl_gwdo
diff --git a/src/core_atmosphere/physics/physics_wrf/module_bl_ysu.F b/src/core_atmosphere/physics/physics_wrf/module_bl_ysu.F
index 9061651398..46486d305e 100644
--- a/src/core_atmosphere/physics/physics_wrf/module_bl_ysu.F
+++ b/src/core_atmosphere/physics/physics_wrf/module_bl_ysu.F
@@ -1,12 +1,5 @@
 !=================================================================================================================
-!module_bl_ysu.F was originally copied from ./phys/module_bl_ysu.F from WRF version 3.8.1.
-!Laura D. Fowler (laura@ucar.edu) / 2016-10-26.
-
-!modifications to sourcecode for MPAS:
-!   * calculated the dry hydrostatic pressure using the dry air density.
-!   * added outputs of the vertical diffusivity coefficients.
-!     Laura D. Fowler (laura@ucar.edu) / 2016-10-26.
-
+!module_bl_ysu.F was modified to accomodate both the WRF and MPAS models / 2018-12-7 
 !=================================================================================================================
 !WRF:model_layer:physics
 !
@@ -27,11 +20,10 @@ subroutine ysu(u3d,v3d,th3d,t3d,qv3d,qc3d,qi3d,p3d,p3di,pi3d,               &
                   rqvblten,rqcblten,rqiblten,flag_qi,                          &
                   cp,g,rovcp,rd,rovg,ep1,ep2,karman,xlv,rv,                    &
                   dz8w,psfc,                                                   &
-                  znu,znw,mut,p_top,                                           &
                   znt,ust,hpbl,psim,psih,                                      &
                   xland,hfx,qfx,wspd,br,                                       &
                   dt,kpbl2d,                                                   &
-                  exch_h,                                                      &
+                  exch_h,exch_m,                                               &
                   wstar,delta,                                                 &
                   u10,v10,                                                     &
                   uoce,voce,                                                   &
@@ -42,10 +34,6 @@ subroutine ysu(u3d,v3d,th3d,t3d,qv3d,qc3d,qi3d,p3d,p3di,pi3d,               &
                   its,ite, jts,jte, kts,kte,                                   &
                 !optional
                   regime                                                       &
-#if defined(mpas)
-                !MPAS specific optional arguments for additional diagnostics:
-                  ,rho,kzhout,kzmout,kzqout                                    &
-#endif
                  )
 !-------------------------------------------------------------------------------
    implicit none
@@ -156,7 +144,8 @@ subroutine ysu(u3d,v3d,th3d,t3d,qv3d,qc3d,qi3d,p3d,p3di,pi3d,               &
                                                                      rqcblten
 !
    real,     dimension( ims:ime, kms:kme, jms:jme )                          , &
-             intent(inout)   ::                                        exch_h
+             intent(inout)   ::                                        exch_h, &
+                                                                       exch_m
    real,     dimension( ims:ime, jms:jme )                                   , &
              intent(inout)   ::                                         wstar
    real,     dimension( ims:ime, jms:jme )                                   , &
@@ -201,17 +190,6 @@ subroutine ysu(u3d,v3d,th3d,t3d,qv3d,qc3d,qi3d,p3d,p3di,pi3d,               &
    real,     dimension( ims:ime, kms:kme, jms:jme )                          , &
              optional                                                        , &
              intent(inout)   ::                                       rqiblten
-!
-   real,     dimension( kms:kme )                                            , &
-             optional                                                        , &
-             intent(in   )   ::                                           znu, &
-                                                                          znw
-!
-   real,     dimension( ims:ime, jms:jme )                                   , &
-             optional                                                        , &
-             intent(in   )   ::                                           mut
-!
-   real,     optional, intent(in   )   ::                               p_top
 !
    real,     dimension( ims:ime, jms:jme )                                   , &
              optional                                                        , &
@@ -228,65 +206,18 @@ subroutine ysu(u3d,v3d,th3d,t3d,qv3d,qc3d,qi3d,p3d,p3di,pi3d,               &
                                                                         dvsfc, &
                                                                         dtsfc, &
                                                                         dqsfc
-#if defined(mpas)
-!MPAS specific optional arguments for additional diagnostics:
-   real,intent(in),dimension(ims:ime,kms:kme,jms:jme),optional:: rho
-   real:: rho_d
-   real,intent(out),dimension(ims:ime,kms:kme,jms:jme),optional:: kzhout,kzmout,kzqout
-   do j = jts,jte
-   do k = kts,kte
-   do i = its,ite
-      kzhout(i,k,j) = 0.
-      kzmout(i,k,j) = 0.
-      kzqout(i,k,j) = 0.
-   enddo
-   enddo
-   enddo
-!MPAS specific end.
-#endif
 
 !
    qv2d(its:ite,:) = 0.0
 !
    do j = jts,jte
-     if(present(mut))then
-!
-! For ARW we will replace p and p8w with dry hydrostatic pressure
-!
-        do k = kts,kte+1
-          do i = its,ite
-             if(k.le.kte)pdh(i,k) = mut(i,j)*znu(k) + p_top
-             pdhi(i,k) = mut(i,j)*znw(k) + p_top
-          enddo
-        enddo
-      elseif(present(rho)) then
-  203 format(1x,i4,1x,i2,10(1x,e15.8))
-!For MPAS, we replace the hydrostatic pressures defined at theta and w points by
-!the dry hydrostatic pressures (Laura D. Fowler):
-        k = kte+1
+      do k = kts,kte+1
         do i = its,ite
-           pdhi(i,k) = p3di(i,k,j)
+          if(k.le.kte)pdh(i,k) = p3d(i,k,j)
+          pdhi(i,k) = p3di(i,k,j)
         enddo
-        do k = kte,kts,-1
-        do i = its,ite
-           rho_d = rho(i,k,j) / (1. + qv3d(i,k,j))
-           if(k.le.kte) pdhi(i,k) = pdhi(i,k+1) + g*rho_d*dz8w(i,k,j)
-        enddo
-        enddo
-        do k = kts,kte
-        do i = its,ite
-           pdh(i,k) = 0.5*(pdhi(i,k) + pdhi(i,k+1))
-        enddo
-        enddo
-!MPAS specific end.
-      else
-        do k = kts,kte+1
-          do i = its,ite
-            if(k.le.kte)pdh(i,k) = p3d(i,k,j)
-            pdhi(i,k) = p3di(i,k,j)
-          enddo
-        enddo
-      endif
+      enddo
+
       do k = kts,kte
         do i = its,ite
           qv2d(i,k) = qv3d(i,k,j)
@@ -315,6 +246,7 @@ subroutine ysu(u3d,v3d,th3d,t3d,qv3d,qc3d,qi3d,p3d,p3di,pi3d,               &
               ,dusfc=dusfc,dvsfc=dvsfc,dtsfc=dtsfc,dqsfc=dqsfc                 &
               ,dt=dt,rcl=1.0,kpbl1d=kpbl2d(ims,j)                              &
               ,exch_hx=exch_h(ims,kms,j)                                       &
+              ,exch_mx=exch_m(ims,kms,j)                                       &
               ,wstar=wstar(ims,j)                                              &
               ,delta=delta(ims,j)                                              &
               ,u10=u10(ims,j),v10=v10(ims,j)                                   &
@@ -322,12 +254,6 @@ subroutine ysu(u3d,v3d,th3d,t3d,qv3d,qc3d,qi3d,p3d,p3di,pi3d,               &
               ,rthraten=rthraten(ims,kms,j),p2diORG=p3di(ims,kms,j)            &
               ,ysu_topdown_pblmix=ysu_topdown_pblmix                           &
               ,ctopo=ctopo(ims,j),ctopo2=ctopo2(ims,j)                         &
-#if defined(mpas)
-!MPAS specific optional arguments for additional diagnostics:
-              ,kzh=kzhout(ims,kms,j)                                           &
-              ,kzm=kzmout(ims,kms,j)                                           &
-              ,kzq=kzqout(ims,kms,j)                                           &
-#endif
               ,ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde               &
               ,ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme               &
               ,its=its,ite=ite, jts=jts,jte=jte, kts=kts,kte=kte   )
@@ -355,7 +281,7 @@ subroutine ysu2d(j,ux,vx,tx,qx,p2d,p2di,pi2d,                               &
                   xland,hfx,qfx,wspd,br,                                       &
                   dusfc,dvsfc,dtsfc,dqsfc,                                     &
                   dt,rcl,kpbl1d,                                               &
-                  exch_hx,                                                     &
+                  exch_hx,exch_mx,                                             &
                   wstar,delta,                                                 &
                   u10,v10,                                                     &
                   uox,vox,                                                     &
@@ -367,10 +293,6 @@ subroutine ysu2d(j,ux,vx,tx,qx,p2d,p2di,pi2d,                               &
                   its,ite, jts,jte, kts,kte,                                   &
                 !optional
                   regime                                                       &
-#if defined(mpas)
-                !MPAS specific optional arguments for additional diagnostics:
-                 ,kzh,kzm,kzq                                                  &
-#endif
                    )
 !-------------------------------------------------------------------------------
    implicit none
@@ -411,10 +333,10 @@ subroutine ysu2d(j,ux,vx,tx,qx,p2d,p2di,pi2d,                               &
 !              revised thermal, shin et al. mon. wea. rev. , songyou hong, aug 2011
 !              ==> reduce the thermal strength when z1 < 0.1 h
 !              revised prandtl number for free convection, dudhia, mar 2012
-!              ==> pr0 = 1 + bke (=0.272) when newtral, kh is reduced
+!              ==> pr0 = 1 + bke (=0.272) when neutral, kh is reduced
 !              minimum kzo = 0.01, lo = min (30m,delz), hong, mar 2012
 !              ==> weaker mixing when stable, and les resolution in vertical
-!              gz1oz0 is removed, and phim phih are ln(z1/z0)-phim,h, hong, mar 2012
+!              gz1oz0 is removed, and psim psih are ln(z1/z0)-psim,h, hong, mar 2012
 !              ==> consider thermal z0 when differs from mechanical z0
 !              a bug fix in wscale computation in stable bl, sukanta basu, jun 2012
 !              ==> wscale becomes small with height, and less mixing in stable bl
@@ -552,7 +474,8 @@ subroutine ysu2d(j,ux,vx,tx,qx,p2d,p2di,pi2d,                               &
 !jdf added exch_hx
 !
    real,    dimension( ims:ime, kms:kme )                                    , &
-            intent(inout)   ::                                        exch_hx
+            intent(inout)   ::                                        exch_hx, &
+                                                                      exch_mx
 !
    real,    dimension( ims:ime )                                             , &
             intent(inout)    ::                                           u10, &
@@ -605,14 +528,15 @@ subroutine ysu2d(j,ux,vx,tx,qx,p2d,p2di,pi2d,                               &
    real    ::  prnumfac,bfx0,hfx0,qfx0,delb,dux,dvx,                           &
                dsdzu,dsdzv,wm3,dthx,dqx,wspd10,ross,tem1,dsig,tvcon,conpr,     &
                prfac,prfac2,phim8z,radsum,tmp1,templ,rvls,temps,ent_eff,    &
-               rcldb,bruptmp,radflux
-!
-#if defined(mpas)
-!MPAS specific begin:
-   real,intent(out),dimension(ims:ime,kms:kme),optional::kzh,kzm,kzq
-!MPAS specific end.
-#endif
-
+               rcldb,bruptmp,radflux,vconvlim,vconvnew,fluxc,vconvc,vconv
+!topo-corr
+   real,    dimension( ims:ime, kms:kme )    ::                          fric, &
+                                                                       tke_ysu,&
+                                                                        el_ysu,&
+                                                                     shear_ysu,&
+                                                                     buoy_ysu
+   real,    dimension( ims:ime )             ::                       pblh_ysu,&
+                                                                      vconvfx
 !
 !-------------------------------------------------------------------------------
 !
@@ -715,19 +639,6 @@ subroutine ysu2d(j,ux,vx,tx,qx,p2d,p2di,pi2d,                               &
      delta(i)  = 0.0
      wstar3_2(i) =  0.0
    enddo
-!
-!MPAS specific begin: Added initialization of local vertical diffusion coefficients:
-   if(present(kzh) .and. present(kzm) .and. present(kzq)) then
-      do k = kts,kte
-      do i = its,ite
-         xkzh(i,k)  = 0.0
-         xkzm(i,k)  = 0.0
-         xkzhl(i,k) = 0.0
-         xkzml(i,k) = 0.0
-      enddo
-      enddo
-   endif
-!MPAS specific end.
 !
    do k = kts,klpbl
      do i = its,ite
@@ -1387,18 +1298,62 @@ subroutine ysu2d(j,ux,vx,tx,qx,p2d,p2di,pi2d,                               &
      enddo
    enddo
 !
-   do i = its,ite
 ! paj: ctopo=1 if topo_wind=0 (default)
-! mchen add this line to make sure NMM can still work with YSU PBL
-     if(present(ctopo)) then
-       ad(i,1) = 1.+ctopo(i)*ust(i)**2/wspd1(i)*rhox(i)*g/del(i,1)*dt2         &
-        *(wspd1(i)/wspd(i))**2
-     else
-       ad(i,1) = 1.+ust(i)**2/wspd1(i)*rhox(i)*g/del(i,1)*dt2                  &
+!raquel---paj tke code (could be replaced with shin-hong tke in future
+   do i = its,ite
+      do k= kts, kte-1
+        shear_ysu(i,k)=xkzm(i,k)*((-hgamu(i)/hpbl(i)+(ux(i,k+1)-ux(i,k))/dza(i,k+1))*(ux(i,k+1)-ux(i,k))/dza(i,k+1) &
+        + (-hgamv(i)/hpbl(i)+(vx(i,k+1)-vx(i,k))/dza(i,k+1))*(vx(i,k+1)-vx(i,k))/dza(i,k+1))
+         buoy_ysu(i,k)=xkzh(i,k)*g*(1.0/thx(i,k))*(-hgamt(i)/hpbl(i)+(thx(i,k+1)-thx(i,k))/dza(i,k+1))
+
+       zk = karman*zq(i,k+1)
+ !over pbl
+       if (k.ge.kpbl(i)) then
+        rlamdz = min(max(0.1*dza(i,k+1),rlam),300.)
+        rlamdz = min(dza(i,k+1),rlamdz)
+       else
+ !in pbl
+        rlamdz = 150.0
+       endif
+       el_ysu(i,k) = zk*rlamdz/(rlamdz+zk)
+       tke_ysu(i,k)=16.6*el_ysu(i,k)*(shear_ysu(i,k)-buoy_ysu(i,k))
+ !q2 when q3 positive
+       if(tke_ysu(i,k).le.0) then
+        tke_ysu(i,k)=0.0
+       else
+        tke_ysu(i,k)=(tke_ysu(i,k))**0.66
+       endif
+      enddo
+ !Hybrid pblh of MYNN
+ !tke is q2
+      CALL GET_PBLH(KTS,KTE,pblh_ysu(i),thvx(i,kts:kte),&
+      &    tke_ysu(i,kts:kte),zq(i,kts:kte+1),dzq(i,kts:kte),xland(i))
+
+!--- end of paj tke
+! compute vconv
+!      Use Beljaars over land
+        if (xland(i).lt.1.5) then
+        fluxc = max(sflux(i),0.0)
+        vconvc=1.
+        VCONV = vconvc*(g/thvx(i,1)*pblh_ysu(i)*fluxc)**.33
+        else
+! for water there is no topo effect so vconv not needed
+        VCONV = 0.
+        endif
+        vconvfx(i) = vconv
+!raquel
+!ctopo stability correction
+      fric(i,1)=ust(i)**2/wspd1(i)*rhox(i)*g/del(i,1)*dt2         &
         *(wspd1(i)/wspd(i))**2
-     endif
-     f1(i,1) = ux(i,1)+uox(i)*ust(i)**2*g/del(i,1)*dt2/wspd1(i)
-     f2(i,1) = vx(i,1)+vox(i)*ust(i)**2*g/del(i,1)*dt2/wspd1(i)
+      if(present(ctopo)) then
+        vconvnew=0.9*vconvfx(i)+1.5*(max((pblh_ysu(i)-500)/1000.0,0.0))
+        vconvlim = min(vconvnew,1.0)
+        ad(i,1) = 1.+fric(i,1)*vconvlim+ctopo(i)*fric(i,1)*(1-vconvlim)
+      else
+       ad(i,1) = 1.+fric(i,1)
+      endif
+     f1(i,1) = ux(i,1)+uox(i)*ust(i)**2*rhox(i)*g/del(i,1)*dt2/wspd1(i)*(wspd1(i)/wspd(i))**2
+     f2(i,1) = vx(i,1)+vox(i)*ust(i)**2*rhox(i)*g/del(i,1)*dt2/wspd1(i)*(wspd1(i)/wspd(i))**2
    enddo
 !
    do k = kts,kte-1
@@ -1432,6 +1387,7 @@ subroutine ysu2d(j,ux,vx,tx,qx,p2d,p2di,pi2d,                               &
        al(i,k)   = -dtodsu*dsdz2
        ad(i,k)   = ad(i,k)-au(i,k)
        ad(i,k+1) = 1.-al(i,k)
+       exch_mx(i,k+1) = xkzm(i,k)
      enddo
    enddo
 !
@@ -1476,18 +1432,6 @@ subroutine ysu2d(j,ux,vx,tx,qx,p2d,p2di,pi2d,                               &
    do i = its,ite
      kpbl1d(i) = kpbl(i)
    enddo
-!
-!MPAS specific begin:
-   if(present(kzh) .and. present(kzm) .and. present(kzq)) then
-      do i = its,ite
-      do k = kts,kte
-         kzh(i,k) = xkzh(i,k)
-         kzm(i,k) = xkzm(i,k)
-         kzq(i,k) = xkzq(i,k)
-      enddo
-      enddo
-   endif
-!MPAS specific end.
 !
    end subroutine ysu2d
 !-------------------------------------------------------------------------------
@@ -1704,5 +1648,117 @@ subroutine ysuinit(rublten,rvblten,rthblten,rqvblten,                       &
 !
    end subroutine ysuinit
 !-------------------------------------------------------------------------------
+! ==================================================================
+
+      SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea)
+! Copied from MYNN PBL
+
+      !---------------------------------------------------------------
+      !             NOTES ON THE PBLH FORMULATION
+      !
+      !The 1.5-theta-increase method defines PBL heights as the level at
+      !which the potential temperature first exceeds the minimum potential
+      !temperature within the boundary layer by 1.5 K. When applied to
+      !observed temperatures, this method has been shown to produce PBL-
+      !height estimates that are unbiased relative to profiler-based
+      !estimates (Nielsen-Gammon et al. 2008). However, their study did not
+      !include LLJs. Banta and Pichugina (2008) show that a TKE-based
+      !threshold is a good estimate of the PBL height in LLJs. Therefore,
+      !a hybrid definition is implemented that uses both methods, weighting
+      !the TKE-method more during stable conditions (PBLH < 400 m).
+      !A variable tke threshold (TKEeps) is used since no hard-wired
+      !value could be found to work best in all conditions.
+      !---------------------------------------------------------------
+
+      INTEGER,INTENT(IN) :: KTS,KTE
+      REAL, INTENT(OUT) :: zi
+      REAL, INTENT(IN) :: landsea
+      REAL, DIMENSION(KTS:KTE), INTENT(IN) :: thetav1D, qke1D, dz1D
+      REAL, DIMENSION(KTS:KTE+1), INTENT(IN) :: zw1D
+      !LOCAL VARS
+      REAL ::  PBLH_TKE,qtke,qtkem1,wt,maxqke,TKEeps,minthv
+      REAL :: delt_thv   !delta theta-v; dependent on land/sea point
+      REAL, PARAMETER :: sbl_lim  = 200. !Theta-v PBL lower limit of trust (m).
+      REAL, PARAMETER :: sbl_damp = 400. !Damping range for averaging with TKE-based PBLH (m).
+      INTEGER :: I,J,K,kthv,ktke
+
+      !FIND MAX TKE AND MIN THETAV IN THE LOWEST 500 M
+      k = kts+1
+      kthv = 1
+      ktke = 1
+      maxqke = 0.
+      minthv = 9.E9
+
+      DO WHILE (zw1D(k) .LE. 500.)
+        qtke  =MAX(Qke1D(k),0.)   ! maximum QKE
+         IF (maxqke < qtke) then
+            maxqke = qtke
+            ktke = k
+         ENDIF
+         IF (minthv > thetav1D(k)) then
+             minthv = thetav1D(k)
+             kthv = k
+         ENDIF
+         k = k+1
+      ENDDO
+      !TKEeps = maxtke/20. = maxqke/40.
+      TKEeps = maxqke/40.
+      TKEeps = MAX(TKEeps,0.025)
+      TKEeps = MIN(TKEeps,0.25)
+
+      !FIND THETAV-BASED PBLH (BEST FOR DAYTIME).
+      zi=0.
+      k = kthv+1
+      IF((landsea-1.5).GE.0)THEN
+      ! WATER
+          delt_thv = 0.75
+      ELSE
+      ! LAND
+          delt_thv = 1.5
+      ENDIF
+
+      zi=0.
+      k = kthv+1
+      DO WHILE (zi .EQ. 0.)
+         IF (thetav1D(k) .GE. (minthv + delt_thv))THEN
+            zi = zw1D(k) - dz1D(k-1)* &
+              & MIN((thetav1D(k)-(minthv + delt_thv))/MAX(thetav1D(k)-thetav1D(k-1),1E-6),1.0)
+        ENDIF
+        k = k+1
+         IF (k .EQ. kte-1) zi = zw1D(kts+1) !EXIT SAFEGUARD
+      ENDDO
+
+      !print*,"IN GET_PBLH:",thsfc,zi
+      !FOR STABLE BOUNDARY LAYERS, USE TKE METHOD TO COMPLEMENT THE
+      !THETAV-BASED DEFINITION (WHEN THE THETA-V BASED PBLH IS BELOW ~0.5 KM).
+      !THE TANH WEIGHTING FUNCTION WILL MAKE THE TKE-BASED DEFINITION NEGLIGIBLE
+      !WHEN THE THETA-V-BASED DEFINITION IS ABOVE ~1 KM.
+      !FIND TKE-BASED PBLH (BEST FOR NOCTURNAL/STABLE CONDITIONS).
+
+      PBLH_TKE=0.
+      k = ktke+1
+     DO WHILE (PBLH_TKE .EQ. 0.)
+        !QKE CAN BE NEGATIVE (IF CKmod == 0)... MAKE TKE NON-NEGATIVE.
+         qtke  =MAX(Qke1D(k)/2.,0.)      ! maximum TKE
+         qtkem1=MAX(Qke1D(k-1)/2.,0.)
+         IF (qtke .LE. TKEeps) THEN
+               PBLH_TKE = zw1D(k) - dz1D(k-1)* &
+               & MIN((TKEeps-qtke)/MAX(qtkem1-qtke, 1E-6), 1.0)
+             !IN CASE OF NEAR ZERO TKE, SET PBLH = LOWEST LEVEL.
+             PBLH_TKE = MAX(PBLH_TKE,zw1D(kts+1))
+             !print *,"PBLH_TKE:",i,j,PBLH_TKE, Qke1D(k)/2., zw1D(kts+1)
+         ENDIF
+         k = k+1
+         IF (k .EQ. kte-1) PBLH_TKE = zw1D(kts+1) !EXIT SAFEGUARD
+      ENDDO
+
+    !BLEND THE TWO PBLH TYPES HERE:
+
+      wt=.5*TANH((zi - sbl_lim)/sbl_damp) + .5
+      zi=PBLH_TKE*(1.-wt) + zi*wt
+
+   END SUBROUTINE GET_PBLH
+! ==================================================================
+
 end module module_bl_ysu
 !-------------------------------------------------------------------------------
diff --git a/src/core_atmosphere/physics/physics_wrf/module_cu_ntiedtke.F b/src/core_atmosphere/physics/physics_wrf/module_cu_ntiedtke.F
index 02fa16cc8b..f798bf62ea 100644
--- a/src/core_atmosphere/physics/physics_wrf/module_cu_ntiedtke.F
+++ b/src/core_atmosphere/physics/physics_wrf/module_cu_ntiedtke.F
@@ -1,15 +1,3 @@
-!=================================================================================================================
-! copied for implementation in MPAS from WRF version 3.8.1:
-
-! modifications made to sourcecode:
-! * used preprocessing option to replace module_model_constants with mpas_atmphys_constants; used preprocessing
-!   option to include the horizontal dependence of the array znu.
-!   Laura D. Fowler (laura@ucar.edu) / 2016-09-19.
-! * added the three corrections available from module_cu_ntiedtke.F available in the WRF github repository Z(not
-!   in the released version WRF 3.8.1.
-!   Laura D. Fowler (laura@ucar.edu) / 2016-10-18.
-
-!=================================================================================================================
 !-----------------------------------------------------------------------
 !
 !wrf:model_layer:physics
@@ -19,7 +7,7 @@
 !    j.morcrette                    1992
 !--------------------------------------------    
 !    modifications
-!    C. zhang & Yuqing Wang         2011-2014
+!    C. zhang & Yuqing Wang         2011-2017
 !
 !   modified from IPRC IRAM - yuqing wang, university of hawaii
 !               & ICTP REGCM4.4
@@ -41,6 +29,18 @@
 !   other refenrence: tiedtke (1989, mwr, 117, 1779-1800)
 !                     IFS documentation - cy33r1, cy37r2, cy38r1, cy40r1
 !
+!===========================================================
+!  Note for climate simulation of Tropical Cyclones
+!  This version of Tiedtke scheme was tested with YSU PBL scheme, RRTMG radation
+!  schemes, and WSM6 microphysics schemes, at horizontal resolution around 20 km
+!  Set: momtrans = 2. 
+!       pgcoef   = 0.7 to 1.0 is good depends on the basin 
+!       nonequil = .false.
+!===========================================================
+!  Note for the diurnal simulation of precipitaton
+!  When nonequil = .true., the CAPE is relaxed toward to a value from PBL
+!  It can improve the diurnal precipitation over land. 
+!===========================================================
 !###########################################################
 
 module module_cu_ntiedtke
@@ -51,18 +51,19 @@ module module_cu_ntiedtke
    &       cpd=>cp, alv=>xlv, als=>xls, alf=>xlf, g=>gravity
 #else
      use module_model_constants, only:rd=>r_d, rv=>r_v, &
-   &       cpd=>cp, alv=>xlv, als=>xls, alf=>xlf, g              
+   &       cpd=>cp, alv=>xlv, als=>xls, alf=>xlf, g
 #endif
 
      implicit none
-     real,private :: rcpd,vtmpc1,tmelt,                &
+     real,private :: t13,rcpd,vtmpc1,tmelt,            &
              c1es,c2es,c3les,c3ies,c4les,c4ies,c5les,c5ies,zrg
 
      real,private :: r5alvcp,r5alscp,ralvdcp,ralsdcp,ralfdcp,rtwat,rtber,rtice 
-     real,private :: entrdd,cmfcmax,cmfcmin,cmfdeps,zdnoprc,cprcon
+     real,private :: entrdd,cmfcmax,cmfcmin,cmfdeps,zdnoprc,cprcon,pgcoef
      integer,private :: momtrans
 
      parameter(         &
+      t13=1.0/3.0,      &
       rcpd=1.0/cpd,     &
       tmelt=273.16,     &
       zrg=1.0/g,        &
@@ -120,11 +121,17 @@ module module_cu_ntiedtke
       parameter(momtrans = 2 )
 !     -------
 !
-      logical :: isequil
-!     isequil: representing equilibrium and nonequilibrium convection
-!     ( .false. [default]; .true. [experimental]. Ref. Bechtold et al. 2014 JAS )
+!     coefficient for pressure gradient intensity
+!     (0.7 - 1.0 is recommended in this vesion of Tiedtke scheme) 
+      parameter(pgcoef=0.7)
+!     -------
+!
+      logical :: nonequil
+!     nonequil: representing equilibrium and nonequilibrium convection
+!     ( .false. [equilibrium: removing all CAPE]; .true. [nonequilibrium: relaxing CAPE toward CAPE from PBL]. 
+!       Ref. Bechtold et al. 2014 JAS )
 ! 
-      parameter(isequil = .true. )
+      parameter(nonequil = .true. )
 !
 !--------------------
 !     switches for deep, mid, shallow convections, downdraft, and momentum transport
@@ -278,7 +285,9 @@ subroutine cu_ntiedtke(                                    &
                                         rcs,                            &
                                         rn,                             &
                                         evap,                           &
-                                        heatflux                       
+                                        heatflux,                       &
+                                        dx2d
+
       integer  , dimension(its:ite) ::  slimsk
 
 
@@ -319,7 +328,7 @@ subroutine cu_ntiedtke(                                    &
                                         kx1
 
 !-------other local variables----
-      integer                      :: zz
+      integer                      :: zz, pp
 !-----------------------------------------------------------------------
 !
 !
@@ -365,6 +374,10 @@ subroutine cu_ntiedtke(                                    &
         slimsk(i)=int(abs(xland(i,j)-2.))
       enddo
 
+      do i=its,ite
+         dx2d(i) = dx(i,j)
+      enddo
+
       do k=kts,kte
         kp=k+1
         do i=its,ite
@@ -372,8 +385,9 @@ subroutine cu_ntiedtke(                                    &
         enddo
       enddo
 
+      pp = 0
       do k=kts,kte
-        zz = kte+1-k
+        zz = kte-pp
         do i=its,ite
           u1(i,zz)=u3d(i,k,j)
           v1(i,zz)=v3d(i,k,j)
@@ -392,14 +406,17 @@ subroutine cu_ntiedtke(                                    &
           ghtl(i,zz)=zl(i,k)
           prsl(i,zz) = pcps(i,k,j)
         enddo
+        pp = pp + 1
       enddo
 
+      pp = 0
       do k=kts,kte+1
-        zz = kte+2-k
+        zz = kte+1-pp
         do i=its,ite
           ghti(i,zz) = zi(i,k)
           prsi(i,zz) = p8w(i,k,j) 
         enddo
+        pp = pp + 1
       enddo
 !
       do i=its,ite
@@ -409,41 +426,47 @@ subroutine cu_ntiedtke(                                    &
 !
 !########################################################################
       call tiecnvn(u1,v1,t1,q1,q2,q3,q1b,t1b,ghtl,ghti,omg,prsl,prsi,evap,heatflux,  &
-                  rn,slimsk,im,kx,kx1,delt,dx)
+                  rn,slimsk,im,kx,kx1,delt,dx2d)
 
       do i=its,ite
          raincv(i,j)=rn(i)/stepcu
          pratec(i,j)=rn(i)/(stepcu * dt)
       enddo
 
+      pp = 0
       do k=kts,kte
-        zz = kte+1-k
+        zz = kte-pp
         do i=its,ite
           rthcuten(i,k,j)=(t1(i,zz)-t3d(i,k,j))/pi3d(i,k,j)*rdelt
           rqvcuten(i,k,j)=(q1(i,zz)-qv3d(i,k,j))*rdelt
           rucuten(i,k,j) =(u1(i,zz)-u3d(i,k,j))*rdelt
           rvcuten(i,k,j) =(v1(i,zz)-v3d(i,k,j))*rdelt
         enddo
+        pp = pp + 1
       enddo
 
       if(present(rqccuten))then
         if ( f_qc ) then
+          pp = 0
           do k=kts,kte
-            zz = kte+1-k
+            zz = kte-pp
             do i=its,ite
               rqccuten(i,k,j)=(q2(i,zz)-qc3d(i,k,j))*rdelt
             enddo
+            pp = pp + 1
           enddo
         endif
       endif
 
       if(present(rqicuten))then
         if ( f_qi ) then
+          pp = 0
           do k=kts,kte
-            zz = kte+1-k
+            zz = kte-pp
             do i=its,ite
               rqicuten(i,k,j)=(q3(i,zz)-qi3d(i,k,j))*rdelt
             enddo
+            pp = pp + 1
           enddo
         endif
       endif
@@ -670,7 +693,7 @@ subroutine cumastrn  &
      &     pssfc,    ldcum,                              &
      &     ktype,    kcbot,    kctop,    ptu,      pqu,&
      &     plu,      plude,    pmfu,     pmfd,     prain,&
-     &     pcte,     phhfl,    lndj,     zgeoh,   dx)
+     &     pcte,     phhfl,    lndj,     zgeoh,    dx)
       implicit none
 !
 !***cumastrn*  master routine for cumulus massflux-scheme
@@ -998,7 +1021,7 @@ subroutine cumastrn  &
            ztau = max(ztmst,ztau)
            ztau = max(360.,ztau)
            ztau = min(10800.,ztau)
-           if(isequil) then
+           if(nonequil) then
              zcape2(jl)= max(0.,zcape2(jl))
              zcape(jl) = max(0.,min(zcape1(jl)-zcape2(jl),5000.))
            else
@@ -1276,15 +1299,10 @@ subroutine cumastrn  &
               zvu(jl,jk) = (zvu(jl,ik)*pmfu(jl,ik) + &
                 zerate*pven(jl,jk)-zderate*zvu(jl,ik))*zmfa
             else
-              if(ktype(jl) == 1 .or. ktype(jl) == 3) then
-                pgf_u   =  -0.7*0.5*(pmfu(jl,ik)*(puen(jl,ik)-puen(jl,jk))+&
+              pgf_u = -pgcoef*0.5*(pmfu(jl,ik)*(puen(jl,ik)-puen(jl,jk))+&
                                    pmfu(jl,jk)*(puen(jl,jk)-puen(jl,jk-1)))
-                pgf_v   =  -0.7*0.5*(pmfu(jl,ik)*(pven(jl,ik)-pven(jl,jk))+&
+              pgf_v = -pgcoef*0.5*(pmfu(jl,ik)*(pven(jl,ik)-pven(jl,jk))+&
                                    pmfu(jl,jk)*(pven(jl,jk)-pven(jl,jk-1)))
-              else
-                pgf_u   = 0.
-                pgf_v   = 0.
-              end if
               zerate = pmfu(jl,jk) - pmfu(jl,ik) + pmfude_rate(jl,jk)
               zderate = pmfude_rate(jl,jk)
               zmfa = 1./max(cmfcmin,pmfu(jl,jk))
@@ -1629,7 +1647,7 @@ subroutine cutypen &
       real     fscale,crirh1,pp
       real     atop1,atop2,abot
       real     tmix,zmix,qmix,pmix
-      real     zlglac,dp,t13
+      real     zlglac,dp
       integer  nk,is,ikb,ikt
 
       real     zqsu,zcor,zdp,zesdp,zalfaw,zfacw,zfaci,zfac,zdsdp,zdqsdt,zdtdp
@@ -1638,8 +1656,6 @@ subroutine cutypen &
       integer  jl,jk,ik,icall,levels
       logical  needreset, lldcum(klon)
 !--------------------------------------------------------------
-      t13 = 1.0/3.0
-!
       do jl=1,klon
         kcbot(jl)=klev
         kctop(jl)=klev
@@ -1795,10 +1811,12 @@ subroutine cutypen &
             else
               lldcum(jl) = .false.
             end if
-          else if(plu(jl,jk) .gt. 0.)then
+          else 
+            if(plu(jl,jk) .gt. 0.)then
               klab(jl,jk)=2
-          else
+            else
               klab(jl,jk)=1
+            end if
           end if
         end if
       end do
@@ -1856,7 +1874,7 @@ subroutine cutypen &
        end do
       end do
 
-      do levels=klevm1-1,klev/2,-1 ! loop starts
+      do levels=klevm1-1,klev/2+1,-1 ! loop starts
         do jk=1,klev
           do jl=1,klon
              plu(jl,jk)=0.0  ! parcel liquid water
@@ -2014,10 +2032,12 @@ subroutine cutypen &
             else
               lldcum(jl) = .false.
             end if
-          else if(plu(jl,jk) .gt. 0.)then
+          else 
+            if(plu(jl,jk) .gt. 0.)then
               klab(jl,jk)=2
-          else
+            else
               klab(jl,jk)=1
+            end if
           end if
         end if
       end do
@@ -2457,7 +2477,7 @@ subroutine cuascn &
                 plude(jl,jk) = plu(jl,jk+1)*zdmfde(jl)
                 pmfu(jl,jk) = pmfu(jl,jk+1) + zdmfen(jl) - zdmfde(jl)
               end if
-              if ( zbuo(jl,jk) > 0.  ) then
+              if ( zbuo(jl,jk) > -0.2  ) then
                 ikb = kcbot(jl)
                 zoentr(jl) = 1.75e-3*(0.3-(min(1.,pqen(jl,jk-1) /    &
                   pqsen(jl,jk-1))-1.))*(pgeoh(jl,jk-1)-pgeoh(jl,jk)) * &
@@ -2505,7 +2525,6 @@ subroutine cuascn &
               zdshrd = 3.e-4
             end if
             ikb=kcbot(jl)
-!            if((paph(jl,ikb)-paph(jl,jk))>zdnoprc) then
             if ( plu(jl,jk) > zdshrd )then
               zwu = min(15.0,sqrt(2.*max(0.1,kup(jl,jk+1))))
               zprcon = zprcdgw/(0.75*zwu)
@@ -3383,8 +3402,6 @@ subroutine cudtdqn(klon,klev,ktopm2,kctop,kdtop,ldcum, &
 ! local variables
     integer  jk , ik , jl
     real     zalv , zzp
-    real     zmfus(klon,klev) , zmfuq(klon,klev) 
-    real     zmfds(klon,klev) , zmfdq(klon,klev)
     real     zdtdt(klon,klev) , zdqdt(klon,klev) , zdp(klon,klev)
     !*    1.0          SETUP AND INITIALIZATIONS
     ! -------------------------
@@ -3392,10 +3409,6 @@ subroutine cudtdqn(klon,klev,ktopm2,kctop,kdtop,ldcum, &
       do jl = 1, klon
         if ( ldcum(jl) ) then
           zdp(jl,jk) = g/(paph(jl,jk+1)-paph(jl,jk))
-          zmfus(jl,jk) = pmfus(jl,jk)
-          zmfds(jl,jk) = pmfds(jl,jk)
-          zmfuq(jl,jk) = pmfuq(jl,jk)
-          zmfdq(jl,jk) = pmfdq(jl,jk)
         end if
       end do
     end do
@@ -3408,11 +3421,11 @@ subroutine cudtdqn(klon,klev,ktopm2,kctop,kdtop,ldcum, &
           if ( ldcum(jl) ) then
             zalv = foelhm(pten(jl,jk))
             zdtdt(jl,jk) = zdp(jl,jk)*rcpd * &
-              (zmfus(jl,jk+1)-zmfus(jl,jk)+zmfds(jl,jk+1) - &
-               zmfds(jl,jk)+alf*plglac(jl,jk)-alf*pdpmel(jl,jk) - &
+              (pmfus(jl,jk+1)-pmfus(jl,jk)+pmfds(jl,jk+1) - &
+               pmfds(jl,jk)+alf*plglac(jl,jk)-alf*pdpmel(jl,jk) - &
                zalv*(pmful(jl,jk+1)-pmful(jl,jk)-plude(jl,jk)-pdmfup(jl,jk)-pdmfdp(jl,jk)))
-            zdqdt(jl,jk) = zdp(jl,jk)*(zmfuq(jl,jk+1) - &
-              zmfuq(jl,jk)+zmfdq(jl,jk+1)-zmfdq(jl,jk)+pmful(jl,jk+1) - &
+            zdqdt(jl,jk) = zdp(jl,jk)*(pmfuq(jl,jk+1) - &
+              pmfuq(jl,jk)+pmfdq(jl,jk+1)-pmfdq(jl,jk)+pmful(jl,jk+1) - &
               pmful(jl,jk)-plude(jl,jk)-pdmfup(jl,jk)-pdmfdp(jl,jk))
           end if
         end do
@@ -3421,10 +3434,10 @@ subroutine cudtdqn(klon,klev,ktopm2,kctop,kdtop,ldcum, &
           if ( ldcum(jl) ) then
             zalv = foelhm(pten(jl,jk))
             zdtdt(jl,jk) = -zdp(jl,jk)*rcpd * &
-              (zmfus(jl,jk)+zmfds(jl,jk)+alf*pdpmel(jl,jk) - &
-               zalv*(pmful(jl,jk)+pdmfup(jl,jk)+pdmfdp(jl,jk)))
-            zdqdt(jl,jk) = -zdp(jl,jk)*(zmfuq(jl,jk) + &
-              zmfdq(jl,jk)+(pmful(jl,jk)+pdmfup(jl,jk)+pdmfdp(jl,jk)))
+              (pmfus(jl,jk)+pmfds(jl,jk)+alf*pdpmel(jl,jk) - &
+               zalv*(pmful(jl,jk)+pdmfup(jl,jk)+pdmfdp(jl,jk)+plude(jl,jk)))
+            zdqdt(jl,jk) = -zdp(jl,jk)*(pmfuq(jl,jk) + plude(jl,jk) + &
+              pmfdq(jl,jk)+(pmful(jl,jk)+pdmfup(jl,jk)+pdmfdp(jl,jk)))
           end if
         end do
       end if
@@ -3858,3 +3871,4 @@ real function foeldcpm(tt)
       end function  foeldcpm
 
 end module module_cu_ntiedtke
+
diff --git a/src/core_atmosphere/physics/physics_wrf/module_mp_wsm6.F b/src/core_atmosphere/physics/physics_wrf/module_mp_wsm6.F
index b95266c7e5..5c52d40f28 100644
--- a/src/core_atmosphere/physics/physics_wrf/module_mp_wsm6.F
+++ b/src/core_atmosphere/physics/physics_wrf/module_mp_wsm6.F
@@ -1,18 +1,4 @@
-!=================================================================================================================
-!module_mp_wsm6.F was originally copied from ./phys/module_mp_wsm6.F from WRF version 3.8.1.
-!Laura D. Fowler (laura@ucar.edu) / 2016-09-23.
-
-!modifications to sourcecode for MPAS:
-!   * replaced the line "#if ( RWORDSIZE == 4 )" with "#ifdef SINGLE_PRECISION".
-!   * commented out the lines:
-!     USE module_utility, ONLY: WRFU_Clock, WRFU_Alarm
-!     USE module_domain, ONLY : HISTORY_ALARM, Is_alarm_tstep
-!   * changed the declaration of refl_10cm to optional since subroutine refl10cm_wsm6 is called
-!     in mpas_atmphys_driver_microphysics.F.
-!     Laura D. Fowler (laura@ucar.edu) / 2016-10-17.
-
-!=================================================================================================================
-#ifdef SINGLE_PRECISION
+#if ( (defined(wrfmodel) ) && ( RWORDSIZE == 4 ) ) || ( ( defined(mpas) ) && defined(SINGLE_PRECISION) )
 #  define VREC vsrec
 #  define VSQRT vssqrt
 #else
@@ -22,8 +8,6 @@
 
 MODULE module_mp_wsm6
 !
-!  USE module_utility, ONLY: WRFU_Clock, WRFU_Alarm
-!  USE module_domain, ONLY : HISTORY_ALARM, Is_alarm_tstep
    USE module_mp_radar
 !
    REAL, PARAMETER, PRIVATE :: dtcldcr     = 120. ! maximum time step for minor loops
@@ -90,6 +74,9 @@ SUBROUTINE wsm6(th, q, qc, qr, qi, qs, qg                        &
                  ,ids,ide, jds,jde, kds,kde                        &
                  ,ims,ime, jms,jme, kms,kme                        &
                  ,its,ite, jts,jte, kts,kte                        &
+#ifdef WRF_CHEM
+                 ,evapprod, rainprod                               &
+#endif
                                                                    )
 !-------------------------------------------------------------------
   IMPLICIT NONE
@@ -145,8 +132,8 @@ SUBROUTINE wsm6(th, q, qc, qr, qi, qs, qg                        &
                                                           re_ice, &
                                                          re_snow
 !+---+-----------------------------------------------------------------+
-  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT), OPTIONAL::     &  ! GT
-                                                       refl_10cm
+  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL,           &   ! GT
+        INTENT(INOUT) ::                               refl_10cm
 !+---+-----------------------------------------------------------------+
 
   REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL,                 &
@@ -155,6 +142,17 @@ SUBROUTINE wsm6(th, q, qc, qr, qi, qs, qg                        &
   REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL,                 &
         INTENT(INOUT) ::                                 graupel, &
                                                       graupelncv
+
+#ifdef WRF_CHEM
+  REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT(INOUT) :: &
+                                                      rainprod,   &
+                                                      evapprod
+! local variable
+  REAL, DIMENSION( its:ite , kts:kte )                 ::         &
+                                                      rainprod2d, &
+                                                      evapprod2d
+#endif
+
 ! LOCAL VAR
   REAL, DIMENSION( its:ite , kts:kte ) ::   t
   REAL, DIMENSION( its:ite , kts:kte, 2 ) ::   qci
@@ -200,6 +198,9 @@ SUBROUTINE wsm6(th, q, qc, qr, qi, qs, qg                        &
                     ,its,ite, jts,jte, kts,kte                     &
                     ,snow,snowncv                                  &
                     ,graupel,graupelncv                            &
+#ifdef WRF_CHEM
+                   ,rainprod2d, evapprod2d                        &
+#endif
                                                                    )
          DO K=kts,kte
          DO I=its,ite
@@ -257,7 +258,14 @@ SUBROUTINE wsm6(th, q, qc, qr, qi, qs, qg                        &
           enddo   
         endif     ! has_reqc, etc...
 !+---+-----------------------------------------------------------------+
-
+#ifdef WRF_CHEM
+        do i=its,ite
+          do k=kts,kte
+            rainprod(i,k,j) = rainprod2d(i,k)
+            evapprod(i,k,j) = evapprod2d(i,k)
+          enddo
+        enddo
+#endif
       ENDDO
   END SUBROUTINE wsm6
 !===================================================================
@@ -276,6 +284,9 @@ SUBROUTINE wsm62D(t, q                                          &
                    ,its,ite, jts,jte, kts,kte                     &
                    ,snow,snowncv                                  &
                    ,graupel,graupelncv                            &
+#ifdef WRF_CHEM
+                   ,rainprod2d, evapprod2d                        &
+#endif
                                                                   )
 !-------------------------------------------------------------------
   IMPLICIT NONE
@@ -367,6 +378,13 @@ SUBROUTINE wsm62D(t, q                                          &
   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL,                  &
         INTENT(INOUT) ::                                 graupel, &
                                                       graupelncv
+
+#ifdef WRF_CHEM
+  REAL, DIMENSION( its:ite , kts:kte ), INTENT(INOUT)  ::         &
+                                                      rainprod2d, &
+                                                      evapprod2d
+#endif
+
 ! LOCAL VAR
   REAL, DIMENSION( its:ite , kts:kte , 3) ::                      &
                                                               rh, &
@@ -994,6 +1012,8 @@ SUBROUTINE wsm62D(t, q                                          &
               acrfac = 2.*rslope3(i,k,1)+2.*diameter*rslope2(i,k,1)            &
                       +diameter**2*rslope(i,k,1)
               praci(i,k) = pi*qci(i,k,2)*n0r*abs(vt2r-vt2i)*acrfac/4.
+              ! reduce collection efficiency (suggested by B. Wilt)
+              praci(i,k) = praci(i,k)*min(max(0.0,qrs(i,k,1)/qci(i,k,2)),1.)**2
               praci(i,k) = min(praci(i,k),qci(i,k,2)/dtcld)
 !-------------------------------------------------------------
 ! piacr: Accretion of rain by cloud ice [HL A19] [LFO 26]
@@ -1002,6 +1022,8 @@ SUBROUTINE wsm62D(t, q                                          &
               piacr(i,k) = pi**2*avtr*n0r*denr*xni(i,k)*denfac(i,k)            &
                           *g6pbr*rslope3(i,k,1)*rslope3(i,k,1)                 &
                           *rslopeb(i,k,1)/24./den(i,k)
+              ! reduce collection efficiency (suggested by B. Wilt)
+              piacr(i,k) = piacr(i,k)*min(max(0.0,qci(i,k,2)/qrs(i,k,1)),1.)**2
               piacr(i,k) = min(piacr(i,k),qrs(i,k,1)/dtcld)
             endif
 !-------------------------------------------------------------
@@ -1033,6 +1055,8 @@ SUBROUTINE wsm62D(t, q                                          &
 !-------------------------------------------------------------
           if(qrs(i,k,2).gt.qcrmin.and.qci(i,k,1).gt.qmin) then
             psacw(i,k) = min(pacrc*n0sfac(i,k)*rslope3(i,k,2)*rslopeb(i,k,2)   &    
+              ! reduce collection efficiency (suggested by B. Wilt)
+                        *min(max(0.0,qrs(i,k,2)/qci(i,k,1)),1.)**2             &
                         *qci(i,k,1)*denfac(i,k),qci(i,k,1)/dtcld)
           endif
 !-------------------------------------------------------------
@@ -1041,6 +1065,8 @@ SUBROUTINE wsm62D(t, q                                          &
 !-------------------------------------------------------------
           if(qrs(i,k,3).gt.qcrmin.and.qci(i,k,1).gt.qmin) then
             pgacw(i,k) = min(pacrg*rslope3(i,k,3)*rslopeb(i,k,3)               &
+              ! reduce collection efficiency (suggested by B. Wilt)
+                        *min(max(0.0,qrs(i,k,3)/qci(i,k,1)),1.)**2             &
                         *qci(i,k,1)*denfac(i,k),qci(i,k,1)/dtcld)
           endif
 !-------------------------------------------------------------
@@ -1062,6 +1088,8 @@ SUBROUTINE wsm62D(t, q                                          &
                       +.5*rslope2(i,k,2)*rslope2(i,k,2)*rslope3(i,k,1)
               pracs(i,k) = pi**2*n0r*n0s*n0sfac(i,k)*abs(vt2r-vt2ave)          &
                           *(dens/den(i,k))*acrfac
+              ! reduce collection efficiency (suggested by B. Wilt)
+              pracs(i,k) = pracs(i,k)*min(max(0.0,qrs(i,k,1)/qrs(i,k,2)),1.)**2
               pracs(i,k) = min(pracs(i,k),qrs(i,k,2)/dtcld)
             endif
 !-------------------------------------------------------------
@@ -1073,6 +1101,8 @@ SUBROUTINE wsm62D(t, q                                          &
                     +.5*rslope2(i,k,1)*rslope2(i,k,1)*rslope3(i,k,2)
             psacr(i,k) = pi**2*n0r*n0s*n0sfac(i,k)*abs(vt2ave-vt2r)            &
                         *(denr/den(i,k))*acrfac
+              ! reduce collection efficiency (suggested by B. Wilt)
+            psacr(i,k) = psacr(i,k)*min(max(0.0,qrs(i,k,2)/qrs(i,k,1)),1.)**2
             psacr(i,k) = min(psacr(i,k),qrs(i,k,1)/dtcld)
           endif
 !-------------------------------------------------------------
@@ -1085,6 +1115,8 @@ SUBROUTINE wsm62D(t, q                                          &
                     +.5*rslope2(i,k,1)*rslope2(i,k,1)*rslope3(i,k,3)
             pgacr(i,k) = pi**2*n0r*n0g*abs(vt2ave-vt2r)*(denr/den(i,k))        &
                         *acrfac
+              ! reduce collection efficiency (suggested by B. Wilt)
+            pgacr(i,k) = pgacr(i,k)*min(max(0.0,qrs(i,k,3)/qrs(i,k,1)),1.)**2
             pgacr(i,k) = min(pgacr(i,k),qrs(i,k,1)/dtcld)
           endif
 !
@@ -1474,6 +1506,12 @@ SUBROUTINE wsm62D(t, q                                          &
         enddo
       enddo
       enddo                  ! big loops
+
+#ifdef WRF_CHEM
+      rainprod2d = praut+pracw+praci+psaci+pgaci+psacw+pgacw+paacw+psaut
+      evapprod2d = -(prevp+psevp+pgevp+psdep+pgdep)
+#endif
+
   END SUBROUTINE wsm62d
 ! ...................................................................
       REAL FUNCTION rgmma(x)
diff --git a/src/core_atmosphere/physics/physics_wrf/module_sf_bem.F b/src/core_atmosphere/physics/physics_wrf/module_sf_bem.F
index 544b802f37..5278ff60b8 100644
--- a/src/core_atmosphere/physics/physics_wrf/module_sf_bem.F
+++ b/src/core_atmosphere/physics/physics_wrf/module_sf_bem.F
@@ -181,8 +181,8 @@ subroutine BEM(nzcanm,nlev,nhourday,dt,bw,bl,dzlev,            &
         real consump(nzcanm)            !Consumption for the a.c. in each floor [W]
 	real hsvent(nzcanm)		!sensible heat generated by natural ventilation [W]
 	real hlvent(nzcanm)		!latent heat generated by natural ventilation [W] 
-        real gsrof                      !heat flux flowing inside the roof [W/m²]
-        real gswal(4,nzcanm)             !heat flux flowing inside the floors [W/m²]
+        real gsrof                      !heat flux flowing inside the roof [W/m^2]
+        real gswal(4,nzcanm)             !heat flux flowing inside the floors [W/m^2]
 
 ! Local:
 ! -----
@@ -993,7 +993,7 @@ subroutine hsinsflux(swsurf,swwin,tin,tw,hsins)
 	real hsins	!internal sensible heat flux [W/m2]
 !Local
 !-----
-	real hc		!heat conduction coefficient [W/°C.m2]
+	real hc		!heat conduction coefficient [W/C.m2]
 !--------------------------------------------------------------------
 
 	if (swsurf.eq.2) then	!vertical surface
@@ -1061,7 +1061,7 @@ subroutine int_rsrad(albwin,albwal,pwin,rswal,&
             enddo
 
 !We suppose that the radiation is spread isotropically within the
-!room when it passes through the windows, so the flux [W/m²] in every 
+!room when it passes through the windows, so the flux [W/m^2] in every 
 !wall is:
 
             surtotwal=0.
@@ -1669,7 +1669,7 @@ subroutine phiequ(nhourday,hsesf,hsequip,hsequ)
 	
 !Output
 !------
-	real hsequ    !sensible heat gain from equipment [Wm¯2]
+	real hsequ    !sensible heat gain from equipment [W/m^2]
 
 !---------------------------------------------------------------------	
 
diff --git a/src/core_atmosphere/physics/physics_wrf/module_sf_bep.F b/src/core_atmosphere/physics/physics_wrf/module_sf_bep.F
index 9434dc8fac..1ba95cd197 100644
--- a/src/core_atmosphere/physics/physics_wrf/module_sf_bep.F
+++ b/src/core_atmosphere/physics/physics_wrf/module_sf_bep.F
@@ -1,20 +1,19 @@
 MODULE module_sf_bep
-
-#ifdef mpas
+#if defined(mpas)
 use mpas_atmphys_utilities, only: physics_error_fatal
 #define FATAL_ERROR(M) call physics_error_fatal( M )
 #else
-#define FATAL_ERROR(M) write(0,*) M ; stop
-#endif
-
+use module_wrf_error
+#define FATAL_ERROR(M) call wrf_error_fatal( M)
 !USE module_model_constants
+#endif
  USE module_sf_urban
 
 ! SGClarke 09/11/2008
 ! Access urban_param.tbl values through calling urban_param_init in module_physics_init
 ! for CASE (BEPSCHEME) select sf_urban_physics
 !
- ! -----------------------------------------------------------------------
+! -----------------------------------------------------------------------
 !  Dimension for the array used in the BEP module
 ! -----------------------------------------------------------------------
 
@@ -25,7 +24,7 @@ MODULE module_sf_bep
       parameter (ndm=2)
 
       integer nz_um           ! Maximum number of vertical levels in the urban grid
-      parameter(nz_um=13)
+      parameter(nz_um=18)
 
       integer ng_u            ! Number of grid levels in the ground
       parameter (ng_u=10)
@@ -64,11 +63,12 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
                       th_phy,rho,p_phy,swdown,glw,                    &
                       gmt,julday,xlong,xlat,                          &
                       declin_urb,cosz_urb2d,omg_urb2d,                &
-                      num_urban_layers,                               &
+                      num_urban_layers,num_urban_hi,                  &
                       trb_urb4d,tw1_urb4d,tw2_urb4d,tgb_urb4d,        &
                       sfw1_urb3d,sfw2_urb3d,sfr_urb3d,sfg_urb3d,      &
+                      lp_urb2d,hi_urb2d,lb_urb2d,hgt_urb2d,           &
                       a_u,a_v,a_t,a_e,b_u,b_v,                        &
-                      b_t,b_e,dlg,dl_u,sf,vl,                         &
+                      b_t,b_e,b_q,dlg,dl_u,sf,vl,                     &
                       rl_up,rs_abs,emiss,grdflx_urb,                  &
                       ids,ide, jds,jde, kds,kde,                      &
                       ims,ime, jms,jme, kms,kme,                      &
@@ -107,6 +107,7 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZ_URB2D
    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: OMG_URB2D
    INTEGER, INTENT(IN  ) :: num_urban_layers
+   INTEGER, INTENT(IN  ) :: num_urban_hi
    REAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: trb_urb4d
    REAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw1_urb4d
    REAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw2_urb4d
@@ -115,6 +116,11 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
    REAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfw2_urb3d
    REAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfr_urb3d
    REAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfg_urb3d
+   REAL, DIMENSION( ims:ime, 1:num_urban_hi, jms:jme ), INTENT(IN) :: hi_urb2d
+   REAL, DIMENSION( ims:ime,jms:jme), INTENT(IN) :: lp_urb2d
+   REAL, DIMENSION( ims:ime,jms:jme), INTENT(IN) :: lb_urb2d
+   REAL, DIMENSION( ims:ime,jms:jme), INTENT(IN) :: hgt_urb2d
+
 !      integer nx,ny,nz              ! Number of points in the mesocsale grid
       real z(ims:ime,kms:kme,jms:jme)            ! Vertical coordinates
       REAL, INTENT(IN )::   DT      ! Time step
@@ -137,20 +143,30 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       real b_v(ims:ime,kms:kme,jms:jme)         ! Explicit component for the momemtum in Y-direction (center)
       real b_t(ims:ime,kms:kme,jms:jme)         ! Explicit component for the temperature
       real b_e(ims:ime,kms:kme,jms:jme)         ! Explicit component for the TKE
+      real b_q(ims:ime,kms:kme,jms:jme)         ! Explicit component for the humidity
       real dlg(ims:ime,kms:kme,jms:jme)         ! Height above ground (L_ground in formula (24) of the BLM paper). 
       real dl_u(ims:ime,kms:kme,jms:jme)        ! Length scale (lb in formula (22) ofthe BLM paper).
 ! urban surface and volumes        
       real sf(ims:ime,kms:kme,jms:jme)           ! surface of the urban grid cells
       real vl(ims:ime,kms:kme,jms:jme)             ! volume of the urban grid cells
 ! urban fluxes
-      real rl_up(ims:ime,jms:jme) ! upward long wave radiation
-      real rs_abs(ims:ime,jms:jme) ! absorbed short wave radiation
-      real emiss(ims:ime,jms:jme)  ! emissivity averaged for urban surfaces
-      real grdflx_urb(ims:ime,jms:jme)  ! ground heat flux for urban areas
+      real rl_up(its:ite,jts:jte) ! upward long wave radiation
+      real rs_abs(its:ite,jts:jte) ! absorbed short wave radiation
+      real emiss(its:ite,jts:jte)  ! emissivity averaged for urban surfaces
+      real grdflx_urb(its:ite,jts:jte)  ! ground heat flux for urban areas
 !------------------------------------------------------------------------
 !     Local
 !------------------------------------------------------------------------
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      real hi_urb(its:ite,1:nz_um,jts:jte)    ! Height histograms of buildings
+      real hi_urb1D(nz_um)                    ! Height histograms of buildings
+      real hb_u(nz_um)                        ! Bulding's heights
+      real ss_urb(nz_um)  ! Probability that a building has an height equal to z
+      real pb_urb(nz_um)  ! Probability that a building has an height greater or equal to z
+      integer nz_urb(nurbm)                   ! Number of layer in the urban grid
+      integer nzurban(nurbm)                  
+
 !    Building parameters      
       real alag_u(nurbm)                      ! Ground thermal diffusivity [m^2 s^-1]
       real alaw_u(nurbm)                      ! Wall thermal diffusivity [m^2 s^-1]
@@ -162,9 +178,18 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       real trini_u(nurbm)                     ! Initial temperature inside the building's roof [K]
       real tgini_u(nurbm)                     ! Initial road temperature
 !
+!   Building materials
+!
+      real csg(ng_u)                          ! Specific heat of the ground material [J m^3 K^-1]
+      real csr(nwr_u)                         ! Specific heat of the roof material [J m^3 K^-1]
+      real csw(nwr_u)                         ! Specific heat of the wall material [J m^3 K^-1]
+      real alag(ng_u)                         ! Ground thermal diffusivity [m^2 s^-1]
+      real alaw(nwr_u)                        ! Wall thermal diffusivity [m^2 s^-1]
+      real alar(nwr_u)                        ! Roof thermal diffusivity [m^2 s^-1]
+!
 ! for twini_u, and trini_u the initial value at the deepest level is kept constant during the simulation
 !
-!    Radiation paramters
+!    Radiation parameters
       real albg_u(nurbm)                      ! Albedo of the ground
       real albw_u(nurbm)                      ! Albedo of the wall
       real albr_u(nurbm)                      ! Albedo of the roof
@@ -172,19 +197,22 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       real emw_u(nurbm)                       ! Emissivity of wall
       real emr_u(nurbm)                       ! Emissivity of roof
 
-!   fww,fwg,fgw,fsw,fsg are the view factors used to compute the long wave
+!   fww_u,fwg_u,fgw_u,fsw_u,fsg_u are the view factors used to compute the long wave
 !   and the short wave radation. 
-      real fww(nz_um,nz_um,ndm,nurbm)         !  from wall to wall
-      real fwg(nz_um,ndm,nurbm)               !  from wall to ground
-      real fgw(nz_um,ndm,nurbm)               !  from ground to wall
-      real fsw(nz_um,ndm,nurbm)               !  from sky to wall
-      real fws(nz_um,ndm,nurbm)               !  from sky to wall
-      real fsg(ndm,nurbm)                     !  from sky to ground
+      real fww_u(nz_um,nz_um,ndm,nurbm)         !  from wall to wall
+      real fwg_u(nz_um,ndm,nurbm)               !  from wall to ground
+      real fgw_u(nz_um,ndm,nurbm)               !  from ground to wall
+      real fsw_u(nz_um,ndm,nurbm)               !  from sky to wall
+      real fws_u(nz_um,ndm,nurbm)               !  from sky to wall
+      real fsg_u(ndm,nurbm)                     !  from sky to ground
 
 !    Roughness parameters
       real z0g_u(nurbm)         ! The ground's roughness length
       real z0r_u(nurbm)         ! The roof's roughness length
 
+!    Roughness parameters
+      real z0(ndm,nz_um)           ! Roughness lengths "profiles"
+
 !    Street parameters
       integer nd_u(nurbm)       ! Number of street direction for each urban class 
       real strd_u(ndm,nurbm)    ! Street length (fix to greater value to the horizontal length of the cells)
@@ -195,9 +223,18 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       real d_b(nz_um,nurbm)     ! Probability that a building has an height h_b
       real ss_u(nz_um,nurbm)  ! Probability that a building has an height equal to z
       real pb_u(nz_um,nurbm)  ! Probability that a building has an height greater or equal to z
-
+!
+!    Street parameters
+!
+      real bs(ndm)                 ! Building width 
+      real ws(ndm)                 ! Street width
+      real drst(ndm)               ! street directions 
+      real strd(ndm)               ! Street lengths 
+      real ss(nz_um)               ! Probability to have a building with height h
+      real pb(nz_um)               ! Probability to have a building with an height equal
 
 !    Grid parameters
+
       integer nz_u(nurbm)       ! Number of layer in the urban grid
       
       real z_u(nz_um)         ! Height of the urban grid levels
@@ -236,7 +273,6 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       real b_e1D(kms:kme)               ! Explicit component of the TKE sources or sinks
       real dlg1D(kms:kme)               ! Height above ground (L_ground in formula (24) of the BLM paper). 
       real dl_u1D(kms:kme)              ! Length scale (lb in formula (22) ofthe BLM paper)
-      real tsk1D                        ! Average of the road surface temperatures
       real time_bep
 ! arrays used to collapse indexes
       integer ind_zwd(nz_um,nwr_u,ndm)
@@ -246,16 +282,16 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       integer ix,iy,iz,iurb,id,iz_u,iw,ig,ir,ix1,iy1,k
       integer it, nint
       integer iii
-      real time_h,tempo,shtot
+      real time_h,tempo
       logical first
       character(len=80) :: text
       data first/.true./
       save first,time_bep 
 
       save alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,                      &
-          albg_u,albw_u,albr_u,emg_u,emw_u,emr_u,fww,fwg,fgw,fsw,fws,fsg,   &
-          z0g_u,z0r_u, nd_u,strd_u,drst_u,ws_u,bs_u,h_b,d_b,ss_u,pb_u,  &
-          nz_u,z_u 
+           albg_u,albw_u,albr_u,emg_u,emw_u,emr_u,                      &
+           z0g_u,z0r_u, nd_u,strd_u,drst_u,ws_u,bs_u,h_b,d_b,ss_u,pb_u, &
+           nz_u,z_u 
 
 !------------------------------------------------------------------------
 !    Calculation of the momentum, heat and turbulent kinetic fluxes
@@ -297,38 +333,73 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
        ind_zd(iz_u,id)=iii
       enddo
       enddo
+
+      if (num_urban_hi.ge.nz_um)then
+          write(*,*)'nz_um too small, please increase to at least ', num_urban_hi+1
+          stop         
+      endif
+
+      do ix=its,ite
+          do iy=jts,jte
+              do iz_u=1,nz_um
+                  hi_urb(ix,iz_u,iy)=0.
+              enddo
+          enddo
+      enddo
+      
       do ix=its,ite
       do iy=jts,jte
        z(ix,kts,iy)=0.
        do iz=kts+1,kte+1
         z(ix,iz,iy)=z(ix,iz-1,iy)+dz8w(ix,iz-1,iy)
-       enddo
+       enddo !iz
+       do iz_u=1,num_urban_hi
+          hi_urb(ix,iz_u,iy)= hi_urb2d(ix,iz_u,iy)
+       enddo !iz_u
       enddo
       enddo
 
+
       if (first) then                           ! True only on first call
+         
          call init_para(alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,&
                 twini_u,trini_u,tgini_u,albg_u,albw_u,albr_u,emg_u,emw_u,&
                 emr_u,z0g_u,z0r_u,nd_u,strd_u,drst_u,ws_u,bs_u,h_b,d_b)
 
 !      Initialisation of the urban parameters and calculation of the view factors
-       call icBEP(alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,          & 
-                 albg_u,albw_u,albr_u,emg_u,emw_u,emr_u,           & 
-                 fww,fwg,fgw,fsw,fws,fsg,                          & 
-                 z0g_u,z0r_u,                                      & 
-                 nd_u,strd_u,drst_u,ws_u,bs_u,h_b,d_b,ss_u,pb_u,   & 
-                 nz_u,z_u,                                         & 
-                 twini_u,trini_u)                                  
-
-       first=.false.
+             
+         call icBEP(nd_u,h_b,d_b,ss_u,pb_u,nz_u,z_u)                                  
+          
+         first=.false.
 
       endif ! first
-      
+
       do ix=its,ite
       do iy=jts,jte
-        if (FRC_URB2D(ix,iy).gt.0.) then    ! Calling BEP only for existing urban classes.
-	
-         iurb=UTYPE_URB2D(ix,iy)
+        if (FRC_URB2D(ix,iy).gt.0.) then    ! Calling BEP only for existing urban classes.	
+           iurb=UTYPE_URB2D(ix,iy)
+
+           hi_urb1D=0.
+           do iz_u=1,nz_um
+              hi_urb1D(iz_u)=hi_urb(ix,iz_u,iy)
+           enddo
+
+           call icBEPHI_XY(hb_u,hi_urb1D,ss_urb,pb_urb,    &
+                           nz_urb(iurb),z_u)
+           
+           call param(iurb,nz_u(iurb),nz_urb(iurb),nzurban(iurb),    &
+                      nd_u(iurb),csg_u,csg,alag_u,alag,csr_u,csr,    &
+                      alar_u,alar,csw_u,csw,alaw_u,alaw,             &
+                      ws_u,ws,bs_u,bs,z0g_u,z0r_u,z0,                &
+                      strd_u,strd,drst_u,drst,ss_u,ss_urb,ss,pb_u,   &
+                      pb_urb,pb,lp_urb2d(ix,iy),                     &
+                      lb_urb2d(ix,iy),hgt_urb2d(ix,iy),FRC_URB2D(ix,iy))  
+!
+!We compute the view factors in the icBEP_XY routine
+!           
+         
+           call icBEP_XY(iurb,fww_u,fwg_u,fgw_u,fsw_u,fws_u,fsg_u,   &
+                         nd_u(iurb),strd,ws,nzurban(iurb),z_u)   
 
        do iz= kts,kte
           ua1D(iz)=u_phy(ix,iz,iy)
@@ -365,13 +436,13 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
          do id=1,ndm
           do ig=1,ng_u
 !           tg1D(id,ig)=tg_u(ix,iy,ind_gd(ig,id))
-           tg1D(id,ig)=tgb_urb4d(ix,ind_gd(ig,id),iy)
+            tg1D(id,ig)=tgb_urb4d(ix,ind_gd(ig,id),iy)
           enddo
           do iz_u=1,nz_um
           do ir=1,nwr_u
 !           tr1D(id,iz_u,ir)=tr_u(ix,iy,ind_zwd(iz_u,ir,id))
             if(ind_zwd(iz_u,ir,id).gt.num_urban_layers)write(*,*)'ind_zwd too big r',ind_zwd(iz_u,ir,id)
-           tr1D(id,iz_u,ir)=trb_urb4d(ix,ind_zwd(iz_u,ir,id),iy)
+            tr1D(id,iz_u,ir)=trb_urb4d(ix,ind_zwd(iz_u,ir,id),iy)
           enddo
           enddo
          enddo
@@ -406,21 +477,22 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
          deltar1D=DECLIN_URB
          ah1D=OMG_URB2D(ix,iy)
 !	 call angle(xlong(ix,iy),xlat(ix,iy),julday,time_h,zr1D,deltar1D,ah1D)
-
+!        write(*,*) 'entro en BEP1D'
          call BEP1D(iurb,kms,kme,kts,kte,z1D,dt,ua1D,va1D,pt1D,da1D,pr1D,pt01D,  &
                    zr1D,deltar1D,ah1D,rs1D,rld1D,                   & 
-                   alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,          & 
-                   albg_u,albw_u,albr_u,emg_u,emw_u,emr_u,          & 
-                   fww,fwg,fgw,fsw,fws,fsg,                         & 
-                   z0g_u,z0r_u,                                     & 
-                   nd_u,strd_u,drst_u,ws_u,bs_u,h_b,d_b,ss_u,pb_u,  & 
-                   nz_u,z_u,                                        & 
+                   alag,alaw,alar,csg,csw,csr,                      & 
+                   albg_u(iurb),albw_u(iurb),albr_u(iurb),          &
+                   emg_u(iurb),emw_u(iurb),emr_u(iurb),             & 
+                   fww_u,fwg_u,fgw_u,fsw_u,                         &                    
+                   fws_u,fsg_u,z0,                                  &                               
+                   nd_u(iurb),strd,drst,ws,bs,ss,pb,                & 
+                   nzurban(iurb),z_u,                               & 
                    tw1D,tg1D,tr1D,sfw1D,sfg1D,sfr1D,                & 
                    a_u1D,a_v1D,a_t1D,a_e1D,                         & 
                    b_u1D,b_v1D,b_t1D,b_e1D,                         & 
-                   dlg1D,dl_u1D,tsk1D,sf1D,vl1D,rl_up(ix,iy),       &
+                   dlg1D,dl_u1D,sf1D,vl1D,rl_up(ix,iy),             &
                    rs_abs(ix,iy),emiss(ix,iy),grdflx_urb(ix,iy))                            
-
+!        write(*,*) 'salgo de BEP1D'
          do id=1,ndm
 	 do iz=1,nz_um
 	  sfw1_urb3d(ix,ind_zd(iz,id),iy)=sfw1D(2*id-1,iz) 
@@ -457,6 +529,20 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
           enddo
           enddo
          enddo
+        
+          sf(ix,kts:kte,iy)=0.
+          vl(ix,kts:kte,iy)=0.
+          a_u(ix,kts:kte,iy)=0.
+          a_v(ix,kts:kte,iy)=0.
+          a_t(ix,kts:kte,iy)=0.
+          a_e(ix,kts:kte,iy)=0.
+          b_u(ix,kts:kte,iy)=0.
+          b_v(ix,kts:kte,iy)=0.
+          b_t(ix,kts:kte,iy)=0.
+          b_e(ix,kts:kte,iy)=0.
+          b_q(ix,kts:kte,iy)=0.
+          dlg(ix,kts:kte,iy)=0.
+          dl_u(ix,kts:kte,iy)=0.
 
         do iz= kts,kte
           sf(ix,iz,iy)=sf1D(iz)
@@ -473,7 +559,6 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
           dl_u(ix,iz,iy)=dl_u1D(iz)
          enddo
          sf(ix,kte+1,iy)=sf1D(kte+1)
-!         tsk(ix,iy)=tsk1D
 !
          endif ! FRC_URB2D
    
@@ -491,16 +576,15 @@ end subroutine BEP
 
       subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,  &  
                       zr,deltar,ah,rs,rld,                            & 
-                      alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,         & 
-                      albg_u,albw_u,albr_u,emg_u,emw_u,emr_u,         & 
-                      fww,fwg,fgw,fsw,fws,fsg,                        & 
-                      z0g_u,z0r_u,                                    & 
-                      nd_u,strd_u,drst_u,ws_u,bs_u,h_b,d_b,ss_u,pb_u, & 
-                      nz_u,z_u,                                       & 
+                      alag,alaw,alar,csg,csw,csr,                     & 
+                      albg,albw,albr,emg,emw,emr,                     & 
+                      fww,fwg,fgw,fsw,fws,fsg,z0,                     &                                             
+                      ndu,strd,drst,ws,bs,ss,pb,                      & 
+                      nzu,z_u,                                        & 
                       tw,tg,tr,sfw,sfg,sfr,                           & 
                       a_u,a_v,a_t,a_e,                                &
                       b_u,b_v,b_t,b_e,                                & 
-                      dlg,dl_u,tsk,sf,vl,rl_up,rs_abs,emiss,grdflx_urb)                             
+                      dlg,dl_u,sf,vl,rl_up,rs_abs,emiss,grdflx_urb)                             
 
 ! ----------------------------------------------------------------------
 ! This routine computes the effects of buildings on momentum, heat and
@@ -573,20 +657,20 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,  &
       integer iurb               ! Current urban class
 
 !    Building parameters      
-      real alag_u(nurbm)         ! Ground thermal diffusivity [m^2 s^-1]
-      real alaw_u(nurbm)         ! Wall thermal diffusivity [m^2 s^-1]
-      real alar_u(nurbm)         ! Roof thermal diffusivity [m^2 s^-1]
-      real csg_u(nurbm)          ! Specific heat of the ground material [J m^3 K^-1]
-      real csw_u(nurbm)          ! Specific heat of the wall material [J m^3 K^-1]
-      real csr_u(nurbm)          ! Specific heat of the roof material [J m^3 K^-1]
+      real alag(ng_u)            ! Ground thermal diffusivity [m^2 s^-1]
+      real alaw(nwr_u)           ! Wall thermal diffusivity [m^2 s^-1]
+      real alar(nwr_u)           ! Roof thermal diffusivity [m^2 s^-1]
+      real csg(ng_u)             ! Specific heat of the ground material [J m^3 K^-1]
+      real csw(nwr_u)            ! Specific heat of the wall material [J m^3 K^-1]
+      real csr(nwr_u)            ! Specific heat of the roof material [J m^3 K^-1]
 
 !    Radiation parameters
-      real albg_u(nurbm)         ! Albedo of the ground
-      real albw_u(nurbm)         ! Albedo of the wall
-      real albr_u(nurbm)         ! Albedo of the roof
-      real emg_u(nurbm)          ! Emissivity of ground
-      real emw_u(nurbm)          ! Emissivity of wall
-      real emr_u(nurbm)          ! Emissivity of roof
+      real albg                  ! Albedo of the ground
+      real albw                  ! Albedo of the wall
+      real albr                  ! Albedo of the roof
+      real emg                   ! Emissivity of ground
+      real emw                   ! Emissivity of wall
+      real emr                   ! Emissivity of roof
 
 !    fww,fwg,fgw,fsw,fsg are the view factors used to compute the long and 
 !    short wave radation. 
@@ -599,24 +683,20 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,  &
       real fsg(ndm,nurbm)              !  from sky to ground
 
 !    Roughness parameters
-      real z0g_u(nurbm)            ! The ground's roughness length
-      real z0r_u(nurbm)            ! The roof's roughness length
+      real z0(ndm,nz_um)           ! Roughness lengths "profiles"
       
 !    Street parameters
-      integer nd_u(nurbm)          ! Number of street direction for each urban class 
-      real strd_u(ndm,nurbm)       ! Street length (set to a greater value then the horizontal length of the cells)
-      real drst_u(ndm,nurbm)       ! Street direction
-      real ws_u(ndm,nurbm)         ! Street width
-      real bs_u(ndm,nurbm)         ! Building width
-      real h_b(nz_um,nurbm)        ! Bulding's heights
-      real d_b(nz_um,nurbm)        ! The probability that a building has an height "h_b"
-      real ss_u(nz_um,nurbm)     ! The probability that a building has an height equal to "z"
-      real pb_u(nz_um,nurbm)     ! The probability that a building has an height greater or equal to "z"
+      integer ndu                  ! Number of street direction for each urban class 
+      real strd(ndm)               ! Street length (set to a greater value then the horizontal length of the cells)
+      real drst(ndm)               ! Street direction
+      real ws(ndm)                 ! Street width
+      real bs(ndm)                 ! Building width
+      real ss(nz_um)               ! The probability that a building has an height equal to "z"
+      real pb(nz_um)               ! The probability that a building has an height greater or equal to "z"
         
 !    Grid parameters
-      integer nz_u(nurbm)     ! Number of layer in the urban grid
-!      real dz_u               ! Urban grid resolution
-      real z_u(nz_um)       ! Height of the urban grid levels
+      integer nzu                  ! Number of layer in the urban grid
+      real z_u(nz_um)              ! Height of the urban grid levels
 
 
 ! ----------------------------------------------------------------------
@@ -655,7 +735,6 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,  &
       real b_e(kms:kme)              ! Explicit component of the TKE sources or sinks
       real dlg(kms:kme)              ! Height above ground (L_ground in formula (24) of the BLM paper). 
       real dl_u(kms:kme)             ! Length scale (lb in formula (22) ofthe BLM paper).
-      real tsk                  ! Average of the road surface temperatures
       
 ! ----------------------------------------------------------------------
 ! LOCAL:
@@ -672,25 +751,6 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,  &
       real pt0_u(nz_um)         ! Reference potential temperature
       real pr_u(nz_um)          ! Air pressure
 
-! Data defining the building and street charateristics
-
-      integer nd                ! Number of street direction for the current urban class
-
-      real alag(ng_u)           ! Ground thermal diffusivity for the current urban class [m^2 s^-1] 
-      real alar(nwr_u)           ! Roof thermal diffusivity for the current urban class [m^2 s^-1]
-      real alaw(nwr_u)           ! Walls thermal diffusivity for the current urban class [m^2 s^-1] 
-      real csg(ng_u)            ! Specific heat of the ground material of the current urban class [J m^3 K^-1]
-      real csr(nwr_u)            ! Specific heat of the roof material for the current urban class [J m^3 K^-1]
-      real csw(nwr_u)            ! Specific heat of the wall material for the current urban class [J m^3 K^-1]
-
-      real z0(ndm,nz_um)      ! Roughness lengths "profiles"
-      real ws(ndm)              ! Street widths of the current urban class
-      real bs(ndm)              ! Building widths of the current urban class
-      real strd(ndm)            ! Street lengths for the current urban class
-      real drst(ndm)            ! Street directions for the current urban class
-      real ss(nz_um)          ! Probability to have a building with height h
-      real pb(nz_um)          ! Probability to have a building with an height equal
-
 ! Solar radiation at each level of the "urban grid"
 
       real rsg(ndm)             ! Short wave radiation from the ground
@@ -727,11 +787,8 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,  &
       real rl_up ! longwave radiation emitted by urban surface to the atmosphere 
       real emiss ! mean emissivity of the urban surface
       real grdflx_urb ! ground heat flux
-      real shtot,aaa
-      real dt_int ! internal time step
-      integer nt_int ! number of internal time step
-      integer iz,id, it_int
-      integer iwrong,iw,ix,iy
+      integer iz,id
+      integer iw,ix,iy
 
 ! ----------------------------------------------------------------------
 ! END VARIABLES DEFINITIONS
@@ -742,53 +799,49 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,  &
       do iz=kts,kte
          dz(iz)=z(iz+1)-z(iz)
       end do
-      call param(iurb,nz_u(iurb),nd_u(iurb),         &
-                       csg_u,csg,alag_u,alag,csr_u,csr,             &
-                       alar_u,alar,csw_u,csw,alaw_u,alaw,           &
-                       ws_u,ws,bs_u,bs,z0g_u,z0r_u,z0,              &
-                       strd_u,strd,drst_u,drst,ss_u,ss,pb_u,pb)
 
 ! Interpolation on the "urban grid"
-      call interpol(kms,kme,kts,kte,nz_u(iurb),z,z_u,ua,ua_u)
-      call interpol(kms,kme,kts,kte,nz_u(iurb),z,z_u,va,va_u)
-      call interpol(kms,kme,kts,kte,nz_u(iurb),z,z_u,pt,pt_u)
-      call interpol(kms,kme,kts,kte,nz_u(iurb),z,z_u,pt0,pt0_u)
-      call interpol(kms,kme,kts,kte,nz_u(iurb),z,z_u,pr,pr_u)
-      call interpol(kms,kme,kts,kte,nz_u(iurb),z,z_u,da,da_u)
+      call interpol(kms,kme,kts,kte,nzu,z,z_u,ua,ua_u)
+      call interpol(kms,kme,kts,kte,nzu,z,z_u,va,va_u)
+      call interpol(kms,kme,kts,kte,nzu,z,z_u,pt,pt_u)
+      call interpol(kms,kme,kts,kte,nzu,z,z_u,pt0,pt0_u)
+      call interpol(kms,kme,kts,kte,nzu,z,z_u,pr,pr_u)
+      call interpol(kms,kme,kts,kte,nzu,z,z_u,da,da_u)
 
                    
 ! Compute the modification of the radiation due to the buildings
 
-      call modif_rad(iurb,nd_u(iurb),nz_u(iurb),z_u,ws, &
-                    drst,strd,ss,pb,                              &
-                    tw,tg,albg_u(iurb),albw_u(iurb),              &
-                    emw_u(iurb),emg_u(iurb),                      &
-                    fww,fwg,fgw,fsw,fsg,                          &
-                    zr,deltar,ah,                                 &
+      call modif_rad(iurb,ndu,nzu,z_u,ws,               &
+                    drst,strd,ss,pb,                    &
+                    tw,tg,albg,albw,emw,emg,            &
+                    fww,fwg,fgw,fsw,fsg,                &
+                    zr,deltar,ah,                       &
                     rs,rld,rsw,rsg,rlw,rlg)                       
  
 ! calculation of the urban albedo and the upward long wave radiation
-       call upward_rad(nd_u(iurb),iurb,nz_u(iurb),ws,bs,sigma,fsw,fsg,pb,ss,   &
-                       tg,emg_u(iurb),albg_u(iurb),rlg,rsg,sfg,                & 
-                       tw,emw_u(iurb),albw_u(iurb),rlw,rsw,sfw,                & 
-                       tr,emr_u(iurb),albr_u(iurb),rld,rs,sfr,                 & 
+       
+       call upward_rad(ndu,nzu,ws,bs,                   &
+                       sigma,pb,ss,                     &
+                       tg,emg,albg,rlg,rsg,sfg,         & 
+                       tw,emw,albw,rlw,rsw,sfw,         & 
+                       tr,emr,albr,rld,rs,sfr,          & 
                        rs_abs,rl_up,emiss,grdflx_urb)               
         
 ! Compute the surface temperatures
      
 
-      call surf_temp(nz_u(iurb),nd_u(iurb),pr_u,dt,ss,                  & 
-                    rs,rld,rsg,rlg,rsw,rlw,                             &
-                    tg,alag,csg,emg_u(iurb),albg_u(iurb),ptg,sfg,gfg,  &
-                    tr,alar,csr,emr_u(iurb),albr_u(iurb),ptr,sfr,gfr,  &
-                    tw,alaw,csw,emw_u(iurb),albw_u(iurb),ptw,sfw,gfw)  
+      call surf_temp(nzu,ndu,pr_u,dt,ss,                & 
+                    rs,rld,rsg,rlg,rsw,rlw,             &
+                    tg,alag,csg,emg,albg,ptg,sfg,gfg,   &
+                    tr,alar,csr,emr,albr,ptr,sfr,gfr,   &
+                    tw,alaw,csw,emw,albw,ptw,sfw,gfw)  
       
       
 ! Compute the implicit and explicit components of the sources or sinks on the "urban grid"
        
-      call buildings(nd_u(iurb),nz_u(iurb),z0,ua_u,va_u,                & 
-                     pt_u,pt0_u,ptg,ptr,da_u,ptw,drst,                  &                      
-                     uva_u,vva_u,uvb_u,vvb_u,tva_u,tvb_u,evb_u,         & 
+      call buildings(ndu,nzu,z0,ua_u,va_u,                       & 
+                     pt_u,pt0_u,ptg,ptr,da_u,ptw,drst,           &                      
+                     uva_u,vva_u,uvb_u,vvb_u,tva_u,tvb_u,evb_u,  & 
                      uhb_u,vhb_u,thb_u,ehb_u,ss,dt)                        
  
          
@@ -798,13 +851,13 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,  &
 !  
 ! 
  
-      do id=1,nd_u(iurb)         
+      do id=1,ndu         
          sfg(id)=-da_u(1)*cp_u*thb_u(id,1)
-         do iz=2,nz_u(iurb)
+         do iz=2,nzu
             sfr(id,iz)=-da_u(iz)*cp_u*thb_u(id,iz)
          enddo
          
-         do iz=1,nz_u(iurb)
+         do iz=1,nzu
             sfw(2*id-1,iz)=-da_u(iz)*cp_u*(tvb_u(2*id-1,iz)+     &
                 tva_u(2*id-1,iz)*pt_u(iz))
             sfw(2*id,iz)=-da_u(iz)*cp_u*(tvb_u(2*id,iz)+         &
@@ -814,31 +867,27 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,  &
       
 ! calculation of the urban albedo and the upward long wave radiation
           
-!       call upward_rad(nd_u(iurb),iurb,nz_u(iurb),ws,bs,sigma,fsw,fsg,pb,ss,  &
-!                       tg,emg_u(iurb),albg_u(iurb),rlg,rsg,                & 
-!                       tw,emw_u(iurb),albw_u(iurb),rlw,rsw,                & 
-!                       tr,emr_u(iurb),albr_u(iurb),rld,rs,                  & 
-!                       rs_abs,rl_up,emiss)             
+!!       call upward_rad(ndu,nzu,ws,bs,                      &
+!!                       sigma,pb,ss,                        &
+!!                       tg,emg,albg,rlg,rsg,sfg,            & 
+!!                       tw,emw,albw,rlw,rsw,sfw,            & 
+!!                       tr,emr,albr,rld,rs,sfr,             & 
+!!                       rs_abs,rl_up,emiss,grdflx_urb)             
 
 ! Interpolation on the "mesoscale grid"
 
-      call urban_meso(nd_u(iurb),kms,kme,kts,kte,nz_u(iurb),z,dz,z_u,pb,ss,bs,ws,sf,  & 
-                     vl,uva_u,vva_u,uvb_u,vvb_u,tva_u,tvb_u,evb_u,       &
-                     uhb_u,vhb_u,thb_u,ehb_u,                            &
+      call urban_meso(ndu,kms,kme,kts,kte,nzu,z,dz,z_u,pb,ss,bs,ws,sf, & 
+                     vl,uva_u,vva_u,uvb_u,vvb_u,tva_u,tvb_u,evb_u,     &
+                     uhb_u,vhb_u,thb_u,ehb_u,                          &
                      a_u,a_v,a_t,a_e,b_u,b_v,b_t,b_e)                    
        
 
 ! computation of the mean road temperature tsk (this value could be used 
 ! to replace the surface temperature in the radiation routines, if needed).
 
-!      tsk=0.
-!      do id=1,nd_u(iurb)
-!         tsk=tsk+tg(id,ng_u)/nd_u(iurb)
-!      enddo
-
 ! Calculation of the length scale taking into account the buildings effects
 
-      call interp_length(nd_u(iurb),kms,kme,kts,kte,nz_u(iurb),z_u,z,ss,ws,bs,dlg,dl_u)
+      call interp_length(ndu,kms,kme,kts,kte,nzu,z_u,z,ss,ws,bs,dlg,dl_u)
 
       return
       end subroutine BEP1D
@@ -846,11 +895,12 @@ end subroutine BEP1D
 ! ===6=8===============================================================72
 ! ===6=8===============================================================72
 
-       subroutine param(iurb,nz,nd,                                   &
+       subroutine param(iurb,nzu,nzurb,nzurban,ndu,                   &
                        csg_u,csg,alag_u,alag,csr_u,csr,               &
                        alar_u,alar,csw_u,csw,alaw_u,alaw,             &
                        ws_u,ws,bs_u,bs,z0g_u,z0r_u,z0,                &  
-                       strd_u,strd,drst_u,drst,ss_u,ss,pb_u,pb)        
+                       strd_u,strd,drst_u,drst,ss_u,ss_urb,ss,pb_u,   &
+                       pb_urb,pb,lp_urb,lb_urb,hgt_urb,frc_urb)        
 
 ! ----------------------------------------------------------------------
 !    This routine prepare some usefull parameters       
@@ -863,8 +913,9 @@ subroutine param(iurb,nz,nd,                                   &
 ! INPUT:
 ! ----------------------------------------------------------------------
       integer iurb                 ! Current urban class
-      integer nz                   ! Number of vertical urban levels in the current class
-      integer nd                   ! Number of street direction for the current urban class
+      integer nzu                  ! Number of vertical urban levels in the current class
+      integer nzurb                ! Number of vertical urban levels in the current class
+      integer ndu                  ! Number of street direction for the current urban class
       real alag_u(nurbm)           ! Ground thermal diffusivity [m^2 s^-1]
       real alar_u(nurbm)           ! Roof thermal diffusivity [m^2 s^-1]
       real alaw_u(nurbm)           ! Wall thermal diffusivity [m^2 s^-1]
@@ -879,7 +930,13 @@ subroutine param(iurb,nz,nd,                                   &
       real z0r_u(nurbm)            ! The roof's roughness length
       real ss_u(nz_um,nurbm)     ! The probability that a building has an height equal to "z"
       real pb_u(nz_um,nurbm)     ! The probability that a building has an height greater or equal to "z"
-
+      real ss_urb(nz_um)     ! The probability that a building has an height equal to "z"
+      real pb_urb(nz_um)     ! The probability that a building has an height greater or equal to "z"
+      real lp_urb                ! Building plan area density
+      real lb_urb                ! Building surface area to plan area ratio
+      real hgt_urb               ! Average building height weighted by building plan area [m]
+      real frc_urb               ! Urban fraction
+     
 ! ----------------------------------------------------------------------
 ! OUTPUT:
 ! ----------------------------------------------------------------------
@@ -896,17 +953,18 @@ subroutine param(iurb,nz,nd,                                   &
       real z0(ndm,nz_um)      ! Roughness lengths "profiles"
       real ss(nz_um)          ! Probability to have a building with height h
       real pb(nz_um)          ! Probability to have a building with an height equal
+      integer nzurban
 
 ! ----------------------------------------------------------------------
 ! LOCAL:
 ! ----------------------------------------------------------------------
-      integer id,ig,ir,iw,iz
+      integer id,ig,ir,iw,iz,ihu
 
 ! ----------------------------------------------------------------------
 ! END VARIABLES DEFINITIONS
 ! ----------------------------------------------------------------------     
 !
-!Initialize the variables
+!Initialize
 !
       ss=0.
       pb=0.
@@ -921,11 +979,39 @@ subroutine param(iurb,nz,nd,                                   &
       bs=0.
       strd=0.
       drst=0.
+      nzurban=0
       
-      do iz=1,nz+1
-         ss(iz)=ss_u(iz,iurb)
-         pb(iz)=pb_u(iz,iurb)
-      end do
+      ihu=0
+
+       do iz=1,nz_um
+          if (ss_urb(iz)/=0.) then
+             ihu=1
+             exit
+          else
+             continue
+          endif
+       enddo
+           
+       if (ihu==1) then
+          do iz=1,nzurb+1
+             ss(iz)=ss_urb(iz)
+             pb(iz)=pb_urb(iz)
+          enddo
+          nzurban=nzurb
+       else
+          do iz=1,nzu+1
+             ss(iz)=ss_u(iz,iurb)
+             pb(iz)=pb_u(iz,iurb)
+          end do 
+          nzurban=nzu
+       endif
+
+       do id=1,ndu
+        z0(id,1)=z0g_u(iurb)
+        do iz=2,nzurban+1
+           z0(id,iz)=z0r_u(iurb)
+        enddo
+       enddo
                  
        do ig=1,ng_u
         csg(ig)=csg_u(iurb)
@@ -941,22 +1027,38 @@ subroutine param(iurb,nz,nd,                                   &
         csw(iw)=csw_u(iurb)
         alaw(iw)=alaw_u(iurb)
        enddo
-       
-       do id=1,nd
-        z0(id,1)=z0g_u(iurb)
-        do iz=2,nz+1
-         z0(id,iz)=z0r_u(iurb)
-        enddo
-       enddo
       
-       do id=1,nd
-        ws(id)=ws_u(id,iurb)
-        bs(id)=bs_u(id,iurb)
+       do id=1,ndu
         strd(id)=strd_u(id,iurb)
         drst(id)=drst_u(id,iurb)     
        enddo
-
-       
+    
+       do id=1,ndu
+          if ((hgt_urb<=0.).OR.(lp_urb<=0.).OR.(lb_urb<=0.)) then
+             ws(id)=ws_u(id,iurb)
+             bs(id)=bs_u(id,iurb)
+          else if ((lp_urb/frc_urb<1.).and.(lp_urb<lb_urb)) then
+                  bs(id)=2.*hgt_urb*lp_urb/(lb_urb-lp_urb)
+                  ws(id)=2.*hgt_urb*lp_urb*((frc_urb/lp_urb)-1.)/(lb_urb-lp_urb)
+               else
+                  ws(id)=ws_u(id,iurb)
+                  bs(id)=bs_u(id,iurb) 
+          endif
+       enddo
+       do id=1,ndu
+          if ((bs(id)<=1.).OR.(bs(id)>=150.)) then
+!            write(*,*) 'WARNING, WIDTH OF THE BUILDING WRONG',id,bs(id)
+!            write(*,*) 'WIDTH OF THE STREET',id,ws(id)
+             bs(id)=bs_u(id,iurb)
+             ws(id)=ws_u(id,iurb)
+          endif
+          if ((ws(id)<=1.).OR.(ws(id)>=150.)) then
+!            write(*,*) 'WARNING, WIDTH OF THE STREET WRONG',id,ws(id)
+!            write(*,*) 'WIDTH OF THE BUILDING',id,bs(id)
+             bs(id)=bs_u(id,iurb)
+             ws(id)=ws_u(id,iurb)
+          endif
+       enddo
        return
        end subroutine param
        
@@ -984,13 +1086,14 @@ subroutine interpol(kms,kme,kts,kte,nz_u,z,z_u,c,c_u)
 ! Data relative to the "urban grid"
       integer nz_u          ! Number of levels
 !!    real z_u(nz_u+1)      ! Altitude of the cell interface
-      real z_u(nz_um)      ! Altitude of the cell interface
+      real z_u(nz_um)       ! Altitude of the cell interface
 ! ----------------------------------------------------------------------
 ! OUTPUT:
 ! ----------------------------------------------------------------------
 !!    real c_u(nz_u)        ! Interpolated paramters in the "urban grid"
-      real c_u(nz_um)        ! Interpolated paramters in the "urban grid"
+      real c_u(nz_um)       ! Interpolated paramters in the "urban grid"
 
+       
 ! LOCAL:
 ! ----------------------------------------------------------------------
       integer iz_u,iz
@@ -1016,9 +1119,9 @@ end subroutine interpol
 ! ===6=8===============================================================72     
 
       subroutine modif_rad(iurb,nd,nz_u,z,ws,drst,strd,ss,pb,    &
-                          tw,tg,albg,albw,emw,emg,                     &
-                          fww,fwg,fgw,fsw,fsg,                         &
-                          zr,deltar,ah,                                &    
+                          tw,tg,albg,albw,emw,emg,               &
+                          fww,fwg,fgw,fsw,fsg,                   &
+                          zr,deltar,ah,                          &    
                           rs,rl,rsw,rsg,rlw,rlg)                       
  
 ! ----------------------------------------------------------------------
@@ -1074,7 +1177,7 @@ subroutine modif_rad(iurb,nd,nz_u,z,ws,drst,strd,ss,pb,    &
 
 !  Calculation of the shadow effects
 
-      call shadow_mas(nd,nz_u,zr,deltar,ah,drst,ws,ss,pb,z,  &
+      call shadow_mas(nd,nz_u,zr,deltar,ah,drst,ws,ss,pb,z,           &
                      rs,rsw,rsg)
 
 ! Calculation of the reflection effects          
@@ -1656,7 +1759,7 @@ end subroutine interp_length
 ! ===6=8===============================================================72
 ! ===6=8===============================================================72   
 
-      subroutine shadow_mas(nd,nz_u,zr,deltar,ah,drst,ws,ss,pb,z,    &
+      subroutine shadow_mas(nd,nz_u,zr,deltar,ah,drst,ws,ss,pb,z,         &
                            rs,rsw,rsg)
         
 ! ----------------------------------------------------------------------
@@ -1735,20 +1838,18 @@ subroutine shadow_mas(nd,nz_u,zr,deltar,ah,drst,ws,ss,pb,z,    &
             do iz=1,nz_u
                rsw(2*id-1,iz)=0.
                rsw(2*id,iz)=0.          
-            if(pb(iz+1).gt.0.)then       
+            if(pb(iz+1).gt.0.)then           
                do jz=1,nz_u                    
                 if(abs(sin(aae)).gt.1.e-10)then
                   call shade_wall(z(iz),z(iz+1),z(jz+1),phix,aae,   &    
                       ws(id),rd)                  
                   rsw(2*id-1,iz)=rsw(2*id-1,iz)+rs*rd*ss(jz+1)/pb(iz+1)
-                  
                 endif
               
                 if(abs(sin(aaw)).gt.1.e-10)then
                   call shade_wall(z(iz),z(iz+1),z(jz+1),phix,aaw,   &    
                       ws(id),rd)
-                  rsw(2*id,iz)=rsw(2*id,iz)+rs*rd*ss(jz+1)/pb(iz+1)   
-                                
+                  rsw(2*id,iz)=rsw(2*id,iz)+rs*rd*ss(jz+1)/pb(iz+1)                  
                 endif
                enddo             
             endif  
@@ -1908,7 +2009,7 @@ subroutine long_rad(iurb,nz_u,id,emw,emg,                  &
         bbb(i)=fsw(i,id,iurb)*rl+emg*fgw(i,id,iurb)*sigma*tg(id,ng_u)**4
         do j=1,nz_u
          bbb(i)=bbb(i)+pb(j+1)*emw*sigma*fww(j,i,id,iurb)*       &
-               tw(2*id,j,nwr_u)**4+                                 &
+               tw(2*id,j,nwr_u)**4+                              &
                fww(j,i,id,iurb)*rl*(1.-pb(j+1))
         enddo
         
@@ -1936,7 +2037,7 @@ subroutine long_rad(iurb,nz_u,id,emw,emg,                  &
 
         do j=1,nz_u
          bbb(i)=bbb(i)+pb(j+1)*emw*sigma*fww(j,i-nz_u,id,iurb)*  &   
-                tw(2*id-1,j,nwr_u)**4+                              &   
+                tw(2*id-1,j,nwr_u)**4+                           &   
                 fww(j,i-nz_u,id,iurb)*rl*(1.-pb(j+1))
         enddo
        
@@ -1957,7 +2058,7 @@ subroutine long_rad(iurb,nz_u,id,emw,emg,                  &
        
        do i=1,nz_u
         bbb(2*nz_u+1)=bbb(2*nz_u+1)+emw*sigma*fwg(i,id,iurb)*pb(i+1)*    &
-                      (tw(2*id-1,i,nwr_u)**4+tw(2*id,i,nwr_u)**4)+             &
+                      (tw(2*id-1,i,nwr_u)**4+tw(2*id,i,nwr_u)**4)+       &
                       2.*fwg(i,id,iurb)*(1.-pb(i+1))*rl                  
        enddo
    
@@ -2552,65 +2653,19 @@ end subroutine flux_flat
 ! ===6=8===============================================================72
 ! ===6=8===============================================================72
 
-      subroutine icBEP (alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,        &
-                       albg_u,albw_u,albr_u,emg_u,emw_u,emr_u,         &
-                       fww,fwg,fgw,fsw,fws,fsg,                        &
-                       z0g_u,z0r_u,                                    &
-                       nd_u,strd_u,drst_u,ws_u,bs_u,h_b,d_b,ss_u,pb_u, &
-                       nz_u,z_u,                                  &
-                       twini_u,trini_u)                               
-
-
-      implicit none 
-      
-   
-!    Building parameters      
-      real alag_u(nurbm)      ! Ground thermal diffusivity [m^2 s^-1]
-      real alaw_u(nurbm)      ! Wall thermal diffusivity [m^2 s^-1]
-      real alar_u(nurbm)      ! Roof thermal diffusivity [m^2 s^-1]
-      real csg_u(nurbm)       ! Specific heat of the ground material [J m^3 K^-1]
-      real csw_u(nurbm)       ! Specific heat of the wall material [J m^3 K^-1]
-      real csr_u(nurbm)       ! Specific heat of the roof material [J m^3 K^-1]
-      real twini_u(nurbm)     ! Temperature inside the buildings behind the wall [K]
-      real trini_u(nurbm)     ! Temperature inside the buildings behind the roof [K]
-
-!    Radiation parameters
-      real albg_u(nurbm)      ! Albedo of the ground
-      real albw_u(nurbm)      ! Albedo of the wall
-      real albr_u(nurbm)      ! Albedo of the roof
-      real emg_u(nurbm)       ! Emissivity of ground
-      real emw_u(nurbm)       ! Emissivity of wall
-      real emr_u(nurbm)       ! Emissivity of roof
+      subroutine icBEP (nd_u,h_b,d_b,ss_u,pb_u,nz_u,z_u)                               
 
-!    Roughness parameters
-      real z0g_u(nurbm)       ! The ground's roughness length      
-      real z0r_u(nurbm)       ! The roof's roughness length     
+      implicit none       
+        
 
 !    Street parameters
       integer nd_u(nurbm)     ! Number of street direction for each urban class
-
-      real strd_u(ndm,nurbm)  ! Street length (fix to greater value to the horizontal length of the cells)
-      real drst_u(ndm,nurbm)  ! Street direction [degree]
-      real ws_u(ndm,nurbm)    ! Street width [m]
-      real bs_u(ndm,nurbm)    ! Building width [m]
       real h_b(nz_um,nurbm)   ! Bulding's heights [m]
       real d_b(nz_um,nurbm)   ! The probability that a building has an height h_b
 ! -----------------------------------------------------------------------
 !     Output
 !------------------------------------------------------------------------
 
-
-
-!   fww,fwg,fgw,fsw,fsg are the view factors used to compute the long wave
-!   and the short wave radation. They are the part of radiation from a surface
-!   or from the sky to another surface.
-      real fww(nz_um,nz_um,ndm,nurbm)        !  from wall to wall
-      real fwg(nz_um,ndm,nurbm)              !  from wall to ground
-      real fgw(nz_um,ndm,nurbm)              !  from ground to wall
-      real fsw(nz_um,ndm,nurbm)              !  from sky to wall
-      real fws(nz_um,ndm,nurbm)              !  from wall to sky
-      real fsg(ndm,nurbm)                    !  from sky to ground
-
       real ss_u(nz_um,nurbm)     ! The probability that a building has an height equal to z
       real pb_u(nz_um,nurbm)     ! The probability that a building has an height greater or equal to z
         
@@ -2637,17 +2692,11 @@ subroutine icBEP (alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,        &
 !
 !Initialize variables
 !
-      nz_u=0
       z_u=0.
+      nz_u=0
       ss_u=0.
       pb_u=0.
-      fww=0.
-      fwg=0.
-      fgw=0.
-      fsw=0.
-      fws=0.
-      fsg=0. 
-        
+
 ! Computation of the urban levels height
 
       z_u(1)=0.
@@ -2686,10 +2735,6 @@ subroutine icBEP (alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,        &
 
          do id=1,nd_u(iurb)
 
-            call view_factors(iurb,nz_u(iurb),id,strd_u(id,iurb),   &    
-                            z_u,ws_u(id,iurb),                      &    
-                            fww,fwg,fgw,fsg,fsw,fws) 
-
             do iz_u=1,nz_u(iurb)
                ss_u(iz_u,iurb)=0.
                do ilu=1,nz_um
@@ -3130,12 +3175,14 @@ subroutine angle(along,alat,day,realt,zr,deltar,ah)
       return
 
       END SUBROUTINE angle
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!====6=8===============================================================72         
+!====6=8===============================================================72 
 
-      subroutine upward_rad(nd_u,iurb,nz_u,ws,bs,sigma,fsw,fsg,pb,ss,           &
-                       tg,emg_u,albg_u,rlg,rsg,sfg,                          & 
-                       tw,emw_u,albw_u,rlw,rsw,sfw,                          & 
-                       tr,emr_u,albr_u,rld,rs, sfr,                            & 
+      subroutine upward_rad(ndu,nzu,ws,bs,sigma,pb,ss,                     &
+                       tg,emg_u,albg_u,rlg,rsg,sfg,                        & 
+                       tw,emw_u,albw_u,rlw,rsw,sfw,                        & 
+                       tr,emr_u,albr_u,rld,rs, sfr,                        & 
                        rs_abs,rl_up,emiss,grdflx_urb)
 !
 ! IN this surboutine we compute the upward longwave flux, and the albedo
@@ -3150,11 +3197,11 @@ subroutine upward_rad(nd_u,iurb,nz_u,ws,bs,sigma,fsw,fsg,pb,ss,           &
       real rlw(2*ndm,nz_um)         ! Long wave radiation at the walls for a given canyon direction [W/m2]
       real rsg(ndm)                   ! Short wave radiation at the canyon for a given canyon direction [W/m2]
       real rlg(ndm)                   ! Long wave radiation at the ground for a given canyon direction [W/m2]
-      real rs                        ! Short wave radiation at the horizontal surface from the sun [W/m²]  
-      real sfw(2*ndm,nz_um)      ! Sensible heat flux from walls [W/m²]
-      real sfg(ndm)              ! Sensible heat flux from ground (road) [W/m²]
-      real sfr(ndm,nz_um)      ! Sensible heat flux from roofs [W/m²]                      
-      real rld                        ! Long wave radiation from the sky [W/m²]
+      real rs                        ! Short wave radiation at the horizontal surface from the sun [W/m2]  
+      real sfw(2*ndm,nz_um)      ! Sensible heat flux from walls [W/m2]
+      real sfg(ndm)              ! Sensible heat flux from ground (road) [W/m2]
+      real sfr(ndm,nz_um)      ! Sensible heat flux from roofs [W/m2]                      
+      real rld                        ! Long wave radiation from the sky [W/m2]
       real albg_u                    ! albedo of the ground/street
       real albw_u                    ! albedo of the walls
       real albr_u                    ! albedo of the roof 
@@ -3162,20 +3209,17 @@ subroutine upward_rad(nd_u,iurb,nz_u,ws,bs,sigma,fsw,fsg,pb,ss,           &
       real bs(ndm)
                         ! building size
       real pb(nz_um)                ! Probability to have a building with an height equal or higher   
-      integer nz_u
+      integer nzu
       real ss(nz_um)                ! Probability to have a building of a given height
       real sigma                       
       real emg_u                       ! emissivity of the street
       real emw_u                       ! emissivity of the wall
       real emr_u                       ! emissivity of the roof
-      real fsw(nz_um,ndm,nurbm)        ! View factors from sky to wall                
-      real fsg(ndm,nurbm)                      ! groud to sky view factor
       real tw(2*ndm,nz_um,nwr_u)  ! Temperature in each layer of the wall [K]
       real tr(ndm,nz_um,nwr_u)  ! Temperature in each layer of the roof [K]
       real tg(ndm,ng_u)          ! Temperature in each layer of the ground [K]
-      integer iurb ! urban class
       integer id ! street direction
-      integer nd_u ! number of street directions
+      integer ndu ! number of street directions
 !OUTPUT/INPUT
       real rs_abs  ! absrobed solar radiationfor this street direction
       real rl_up   ! upward longwave radiation for this street direction
@@ -3188,15 +3232,31 @@ subroutine upward_rad(nd_u,iurb,nz_u,ws,bs,sigma,fsw,fsg,pb,ss,           &
       integer ix,iy,iwrong
 
          iwrong=1
-      do iz=1,nz_u+1
-      do id=1,nd_u
+      do iz=1,nzu+1
+      do id=1,ndu
       do iw=1,nwr_u
         if(tr(id,iz,iw).lt.100.)then
               write(*,*)'in upward_rad ',iz,id,iw,tr(id,iz,iw) 
               iwrong=0
         endif
+        if(tw(2*id-1,iz,iw).lt.100.) then
+           write(*,*)'in upward_rad ',iz,id,iw,tw(2*id-1,iz,iw) 
+           iwrong=0
+        endif
+        if(tw(2*id,iz,iw).lt.100.) then
+           write(*,*)'in upward_rad ',iz,id,iw,tw(2*id,iz,iw) 
+           iwrong=0
+        endif
       enddo
       enddo
+      enddo
+      do id=1,ndu
+      do iw=1,ng_u
+          if(tg(id,iw).lt.100.) then
+            write(*,*)'in upward_rad ',id,iw,tg(id,iw) 
+            iwrong=0
+          endif
+      enddo   
       enddo
            if(iwrong.eq.0)stop
 
@@ -3207,29 +3267,29 @@ subroutine upward_rad(nd_u,iurb,nz_u,ws,bs,sigma,fsw,fsg,pb,ss,           &
       emiss=0.
       rl_emit=0.
       grdflx_urb=0.
-      do id=1,nd_u          
-       rl_emit=rl_emit-( emg_u*sigma*(tg(id,ng_u)**4.)+(1-emg_u)*rlg(id))*ws(id)/(ws(id)+bs(id))/nd_u
-       rl_inc=rl_inc+rlg(id)*ws(id)/(ws(id)+bs(id))/nd_u       
-       rs_abs=rs_abs+(1.-albg_u)*rsg(id)*ws(id)/(ws(id)+bs(id))/nd_u
+      do id=1,ndu          
+       rl_emit=rl_emit-( emg_u*sigma*(tg(id,ng_u)**4.)+(1-emg_u)*rlg(id))*ws(id)/(ws(id)+bs(id))/ndu
+       rl_inc=rl_inc+rlg(id)*ws(id)/(ws(id)+bs(id))/ndu       
+       rs_abs=rs_abs+(1.-albg_u)*rsg(id)*ws(id)/(ws(id)+bs(id))/ndu
          gfl=(1.-albg_u)*rsg(id)+emg_u*rlg(id)-emg_u*sigma*(tg(id,ng_u)**4.)+sfg(id)
-         grdflx_urb=grdflx_urb-gfl*ws(id)/(ws(id)+bs(id))/nd_u  
+         grdflx_urb=grdflx_urb-gfl*ws(id)/(ws(id)+bs(id))/ndu  
  
-          do iz=2,nz_u
-            rl_emit=rl_emit-(emr_u*sigma*(tr(id,iz,nwr_u)**4.)+(1-emr_u)*rld)*ss(iz)*bs(id)/(ws(id)+bs(id))/nd_u
-            rl_inc=rl_inc+rld*ss(iz)*bs(id)/(ws(id)+bs(id))/nd_u            
-            rs_abs=rs_abs+(1.-albr_u)*rs*ss(iz)*bs(id)/(ws(id)+bs(id))/nd_u
+          do iz=2,nzu
+            rl_emit=rl_emit-(emr_u*sigma*(tr(id,iz,nwr_u)**4.)+(1-emr_u)*rld)*ss(iz)*bs(id)/(ws(id)+bs(id))/ndu
+            rl_inc=rl_inc+rld*ss(iz)*bs(id)/(ws(id)+bs(id))/ndu            
+            rs_abs=rs_abs+(1.-albr_u)*rs*ss(iz)*bs(id)/(ws(id)+bs(id))/ndu
             gfl=(1.-albr_u)*rs+emr_u*rld-emr_u*sigma*(tr(id,iz,nwr_u)**4.)+sfr(id,iz)
-            grdflx_urb=grdflx_urb-gfl*ss(iz)*bs(id)/(ws(id)+bs(id))/nd_u
+            grdflx_urb=grdflx_urb-gfl*ss(iz)*bs(id)/(ws(id)+bs(id))/ndu
          enddo
            
-         do iz=1,nz_u            
+         do iz=1,nzu            
             rl_emit=rl_emit-(emw_u*sigma*( tw(2*id-1,iz,nwr_u)**4.+tw(2*id,iz,nwr_u)**4. )+          &
-               (1-emw_u)*( rlw(2*id-1,iz)+rlw(2*id,iz) ) )*dz_u*pb(iz+1)/(ws(id)+bs(id))/nd_u
-            rl_inc=rl_inc+(( rlw(2*id-1,iz)+rlw(2*id,iz) ) )*dz_u*pb(iz+1)/(ws(id)+bs(id))/nd_u
-            rs_abs=rs_abs+((1.-albw_u)*( rsw(2*id-1,iz)+rsw(2*id,iz) ) )*dz_u*pb(iz+1)/(ws(id)+bs(id))/nd_u 
+               (1-emw_u)*( rlw(2*id-1,iz)+rlw(2*id,iz) ) )*dz_u*pb(iz+1)/(ws(id)+bs(id))/ndu
+            rl_inc=rl_inc+(( rlw(2*id-1,iz)+rlw(2*id,iz) ) )*dz_u*pb(iz+1)/(ws(id)+bs(id))/ndu
+            rs_abs=rs_abs+((1.-albw_u)*( rsw(2*id-1,iz)+rsw(2*id,iz) ) )*dz_u*pb(iz+1)/(ws(id)+bs(id))/ndu 
             gfl=(1.-albw_u)*(rsw(2*id-1,iz)+rsw(2*id,iz)) +emw_u*( rlw(2*id-1,iz)+rlw(2*id,iz) )   &
              -emw_u*sigma*( tw(2*id-1,iz,nwr_u)**4.+tw(2*id,iz,nwr_u)**4. )+(sfw(2*id-1,iz)+sfw(2*id,iz))            
-            grdflx_urb=grdflx_urb-gfl*dz_u*pb(iz+1)/(ws(id)+bs(id))/nd_u
+            grdflx_urb=grdflx_urb-gfl*dz_u*pb(iz+1)/(ws(id)+bs(id))/ndu
          enddo
           
       enddo
@@ -3243,4 +3303,186 @@ END SUBROUTINE upward_rad
 
 !====6=8===============================================================72         
 !====6=8===============================================================72 
+! ===6=8===============================================================72
+! ===6=8===============================================================72
+
+      subroutine icBEP_XY(iurb,fww_u,fwg_u,fgw_u,fsw_u,             &
+                          fws_u,fsg_u,ndu,strd,ws,nzu,z_u)                               
+
+      implicit none       
+        
+!    Street parameters
+      integer ndu     ! Number of street direction for each urban class
+      integer iurb
+
+      real strd(ndm)        ! Street length (fix to greater value to the horizontal length of the cells)
+      real ws(ndm)          ! Street width [m]
+
+!    Grid parameters
+      integer nzu          ! Number of layer in the urban grid
+      real z_u(nz_um)       ! Height of the urban grid levels
+! -----------------------------------------------------------------------
+!     Output
+!------------------------------------------------------------------------
+
+!   fww_u,fwg_u,fgw_u,fsw_u,fsg_u are the view factors used to compute the long wave
+!   and the short wave radation. They are the part of radiation from a surface
+!   or from the sky to another surface.
+
+      real fww_u(nz_um,nz_um,ndm,nurbm)         !  from wall to wall
+      real fwg_u(nz_um,ndm,nurbm)               !  from wall to ground
+      real fgw_u(nz_um,ndm,nurbm)               !  from ground to wall
+      real fsw_u(nz_um,ndm,nurbm)               !  from sky to wall
+      real fws_u(nz_um,ndm,nurbm)               !  from sky to wall
+      real fsg_u(ndm,nurbm)                     !  from sky to ground
+
+! -----------------------------------------------------------------------
+!     Local
+!------------------------------------------------------------------------
+
+      integer id
+
+! -----------------------------------------------------------------------
+!     This routine compute the view factors
+!------------------------------------------------------------------------
+!
+!Initialize
+!
+      fww_u=0.
+      fwg_u=0.
+      fgw_u=0.
+      fsw_u=0.
+      fws_u=0.
+      fsg_u=0.
+      
+      do id=1,ndu
+
+            call view_factors(iurb,nzu,id,strd(id),z_u,ws(id),  &    
+                              fww_u,fwg_u,fgw_u,fsg_u,fsw_u,fws_u) 
+      
+      enddo               
+      return       
+      end subroutine icBEP_XY
+! ===6=8===============================================================72
+! ===6=8===============================================================72
+
+      subroutine icBEPHI_XY(hb_u,hi_urb1D,ss_u,pb_u,nzu,z_u)
+
+      implicit none   
+!-----------------------------------------------------------------------
+!    Inputs
+!-----------------------------------------------------------------------
+!    Street parameters
+!
+      real hi_urb1D(nz_um)    ! The probability that a building has an height h_b
+!
+!     Grid parameters
+!
+      real z_u(nz_um)         ! Height of the urban grid levels
+! -----------------------------------------------------------------------
+!     Output
+!------------------------------------------------------------------------
+
+      real ss_u(nz_um)   ! The probability that a building has an height equal to z
+      real pb_u(nz_um)         ! The probability that a building has an height greater or equal to z
+!        
+!    Grid parameters
+!
+      integer nzu                ! Number of layer in the urban grid
+
+! -----------------------------------------------------------------------
+!     Local
+!------------------------------------------------------------------------
+      real hb_u(nz_um)        ! Bulding's heights [m]
+      integer iz_u,id,ilu
+
+      real dtot
+      real hbmax
+
+!------------------------------------------------------------------------
+
+!Initialize variables
+!
+      
+      nzu=0
+      ss_u=0.
+      pb_u=0.
+      
+! Normalisation of the building density
+
+         dtot=0.
+         hb_u=0.
+
+         do ilu=1,nz_um
+            dtot=dtot+hi_urb1D(ilu)
+         enddo
+         
+         do ilu=1,nz_um
+            if (hi_urb1D(ilu)<0.) then
+!              write(*,*) 'WARNING, HI_URB1D(ilu) < 0 IN BEP'
+               go to 20
+            endif
+         enddo
+
+         if (dtot.gt.0.) then
+            continue
+         else
+!           write(*,*) 'WARNING, HI_URB1D <= 0 IN BEP'
+            go to 20
+         endif
+
+         do ilu=1,nz_um
+            hi_urb1D(ilu)=hi_urb1D(ilu)/dtot
+         enddo
+         
+         hb_u(1)=dz_u   
+         do ilu=2,nz_um
+            hb_u(ilu)=dz_u+hb_u(ilu-1)
+         enddo
+           
+
+! Compute pb and ss 
+      
+            
+         hbmax=0.
+       
+         do ilu=1,nz_um
+            if (hi_urb1D(ilu)>0.and.hi_urb1D(ilu)<=1.) then
+                hbmax=hb_u(ilu)
+            endif
+         enddo
+         
+         do iz_u=1,nz_um-1
+            if(z_u(iz_u+1).gt.hbmax)go to 10
+         enddo
+
+10       continue 
+        
+         nzu=iz_u+1
+
+         if ((nzu+1).gt.nz_um) then 
+             write(*,*) 'error, nz_um has to be increased to at least',nzu+1
+             stop
+         endif
+
+            do iz_u=1,nzu
+               ss_u(iz_u)=0.
+               do ilu=1,nz_um
+                  if(z_u(iz_u).le.hb_u(ilu)                      &    
+                    .and.z_u(iz_u+1).gt.hb_u(ilu))then            
+                        ss_u(iz_u)=ss_u(iz_u)+hi_urb1D(ilu)
+                  endif 
+               enddo
+            enddo
+
+            pb_u(1)=1.
+            do iz_u=1,nzu
+               pb_u(iz_u+1)=max(0.,pb_u(iz_u)-ss_u(iz_u))
+            enddo
+
+20    continue    
+      return
+      end subroutine icBEPHI_XY
+! ===6=8===============================================================72
+! ===6=8===============================================================72
 END MODULE module_sf_bep
diff --git a/src/core_atmosphere/physics/physics_wrf/module_sf_bep_bem.F b/src/core_atmosphere/physics/physics_wrf/module_sf_bep_bem.F
index 5235fd3723..d9344a1427 100644
--- a/src/core_atmosphere/physics/physics_wrf/module_sf_bep_bem.F
+++ b/src/core_atmosphere/physics/physics_wrf/module_sf_bep_bem.F
@@ -1,13 +1,12 @@
 MODULE module_sf_bep_bem
-
-#ifdef mpas
+#if defined(mpas)
 use mpas_atmphys_utilities, only: physics_error_fatal
 #define FATAL_ERROR(M) call physics_error_fatal( M )
 #else
-#define FATAL_ERROR(M) write(0,*) M ; stop
-#endif
-
+use module_wrf_error
+#define FATAL_ERROR(M) call wrf_error_fatal( M )
 !USE module_model_constants
+#endif
  USE module_sf_urban
  USE module_sf_bem
 
@@ -26,7 +25,7 @@ MODULE module_sf_bep_bem
       parameter (ndm=2)
 
       integer nz_um           ! Maximum number of vertical levels in the urban grid
-      parameter(nz_um=13)
+      parameter(nz_um=18)
 
       integer ng_u            ! Number of grid levels in the ground
       parameter (ng_u=10)
@@ -40,10 +39,10 @@ MODULE module_sf_bep_bem
       parameter (ngb_u=10)
 
       real dz_u                ! Urban grid resolution
-      parameter (dz_u=5.) 
+      parameter (dz_u=5.)
 
       integer nbui_max         !maximum number of types of buildings in an urban class
-      parameter (nbui_max=4)   !must be less or equal than nz_um 
+      parameter (nbui_max=15)   !must be less or equal than nz_um 
 
 !---------------------------------------------------------------------------------
 !Parameters of the windows. The glasses of windows are considered without films  -
@@ -87,13 +86,14 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
                       th_phy,rho,p_phy,swdown,glw,                                 &
                       gmt,julday,xlong,xlat,                                       &
                       declin_urb,cosz_urb2d,omg_urb2d,                             &
-                      num_urban_layers,                                            &
+                      num_urban_layers,num_urban_hi,                               &
                       trb_urb4d,tw1_urb4d,tw2_urb4d,tgb_urb4d,                     &
                       tlev_urb3d,qlev_urb3d,tw1lev_urb3d,tw2lev_urb3d,             &
                       tglev_urb3d,tflev_urb3d,sf_ac_urb3d,lf_ac_urb3d,             &
                       cm_ac_urb3d,sfvent_urb3d,lfvent_urb3d,                       &
                       sfwin1_urb3d,sfwin2_urb3d,                                   &
                       sfw1_urb3d,sfw2_urb3d,sfr_urb3d,sfg_urb3d,                   &
+                      lp_urb2d,hi_urb2d,lb_urb2d,hgt_urb2d,                        &
                       a_u,a_v,a_t,a_e,b_u,b_v,                                     &
                       b_t,b_e,b_q,dlg,dl_u,sf,vl,                                  &
                       rl_up,rs_abs,emiss,grdflx_urb,qv_phy,                        &
@@ -134,6 +134,7 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZ_URB2D
    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: OMG_URB2D
    INTEGER, INTENT(IN  ) :: num_urban_layers
+   INTEGER, INTENT(IN  ) :: num_urban_hi
    REAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: trb_urb4d
    REAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw1_urb4d
    REAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw2_urb4d
@@ -158,11 +159,14 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
    REAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfw2_urb3d
    REAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfr_urb3d
    REAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfg_urb3d
+   REAL, DIMENSION( ims:ime, 1:num_urban_hi, jms:jme ), INTENT(IN) :: hi_urb2d
+   REAL, DIMENSION( ims:ime,jms:jme), INTENT(IN) :: lp_urb2d
+   REAL, DIMENSION( ims:ime,jms:jme), INTENT(IN) :: lb_urb2d
+   REAL, DIMENSION( ims:ime,jms:jme), INTENT(IN) :: hgt_urb2d
 
    real z(ims:ime,kms:kme,jms:jme)            ! Vertical coordinates
    REAL, INTENT(IN )::   DT      ! Time step
 
-!      
 !------------------------------------------------------------------------
 !     Output
 !------------------------------------------------------------------------ 
@@ -184,14 +188,21 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       real sf(ims:ime,kms:kme,jms:jme)           ! surface of the urban grid cells
       real vl(ims:ime,kms:kme,jms:jme)             ! volume of the urban grid cells
 ! urban fluxes
-      real rl_up(ims:ime,jms:jme) ! upward long wave radiation
-      real rs_abs(ims:ime,jms:jme) ! absorbed short wave radiation
-      real emiss(ims:ime,jms:jme)  ! emissivity averaged for urban surfaces
-      real grdflx_urb(ims:ime,jms:jme)  ! ground heat flux for urban areas
+      real rl_up(its:ite,jts:jte) ! upward long wave radiation
+      real rs_abs(its:ite,jts:jte) ! absorbed short wave radiation
+      real emiss(its:ite,jts:jte)  ! emissivity averaged for urban surfaces
+      real grdflx_urb(its:ite,jts:jte)  ! ground heat flux for urban areas
 !------------------------------------------------------------------------
 !     Local
 !------------------------------------------------------------------------
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      real hi_urb(its:ite,1:nz_um,jts:jte) ! Height histograms of buildings
+      real hi_urb1D(nz_um)                 ! Height histograms of buildings
+      real ss_urb(nz_um,nurbm)             ! Probability that a building has an height equal to z
+      real pb_urb(nz_um)                   ! Probability that a building has an height greater or equal to z
+      real hb_u(nz_um)                     ! Bulding's heights
+      integer nz_urb(nurbm)                ! Number of layer in the urban grid
+      integer nzurban(nurbm)
+
 !    Building parameters      
       real alag_u(nurbm)                      ! Ground thermal diffusivity [m^2 s^-1]
       real alaw_u(nurbm)                      ! Wall thermal diffusivity [m^2 s^-1]
@@ -202,10 +213,48 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       real twini_u(nurbm)                     ! Initial temperature inside the building's wall [K]
       real trini_u(nurbm)                     ! Initial temperature inside the building's roof [K]
       real tgini_u(nurbm)                     ! Initial road temperature
+
+!
+!   Building materials
+!
+
+      real csg(ng_u)           ! Specific heat of the ground material [J m^3 K^-1]
+      real csw(nwr_u)          ! Specific heat of the wall material for the current urban class [J m^3 K^-1]
+      real csr(nwr_u)          ! Specific heat of the roof material for the current urban class [J m^3 K^-1]
+      real csgb(ngb_u)         ! Specific heat of the ground material below the buildings at each ground levels[J m^3 K^-1]
+      real csf(nf_u)           ! Specific heat of the floors materials in the buildings at each levels[J m^3 K^-1]
+      real alar(nwr_u+1)       ! Roof thermal diffusivity for the current urban class [W/m K]
+      real alaw(nwr_u+1)       ! Walls thermal diffusivity for the current urban class [W/m K]
+      real alag(ng_u)          ! Ground thermal diffusivity for the current urban class [m^2 s^-1] 
+      real alagb(ngb_u+1)      ! Ground thermal diffusivity below the building at each wall layer [W/m K]
+      real alaf(nf_u+1)        ! Floor thermal diffusivity at each wall layers [W/m K]  
+      real dzr(nwr_u)          ! Layer sizes in the roofs [m]
+      real dzf(nf_u)           ! Layer sizes in the floors[m]
+      real dzw(nwr_u)          ! Layer sizes in the walls [m]
+      real dzgb(ngb_u)         ! Layer sizes in the ground below the buildings [m]
+
+!
+!New street and radiation parameters
+!
+
+      real bs(ndm)              ! Building width for the current urban class
+      real ws(ndm)              ! Street widths of the current urban class
+      real strd(ndm)            ! Street lengths for the current urban class
+      real drst(ndm)            ! street directions for the current urban class
+      real ss(nz_um)            ! Probability to have a building with height h
+      real pb(nz_um)            ! Probability to have a building with an height equal
+!
+!New roughness and buildings parameters
+!
+      real z0(ndm,nz_um)        ! Roughness lengths "profiles"
+      real bs_urb(ndm,nurbm)      ! Building width
+      real ws_urb(ndm,nurbm)      ! Street width
+
 !
 ! for twini_u, and trini_u the initial value at the deepest level is kept constant during the simulation
 !
 !    Radiation paramters
+
       real albg_u(nurbm)                      ! Albedo of the ground
       real albw_u(nurbm)                      ! Albedo of the wall
       real albr_u(nurbm)                      ! Albedo of the roof
@@ -215,14 +264,14 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       real emw_u(nurbm)                       ! Emissivity of wall
       real emr_u(nurbm)                       ! Emissivity of roof
 
-!   fww,fwg,fgw,fsw,fsg are the view factors used to compute the long wave
-!   and the short wave radation. 
-      real fww(nz_um,nz_um,ndm,nurbm)         !  from wall to wall
-      real fwg(nz_um,ndm,nurbm)               !  from wall to ground
-      real fgw(nz_um,ndm,nurbm)               !  from ground to wall
-      real fsw(nz_um,ndm,nurbm)               !  from sky to wall
-      real fws(nz_um,ndm,nurbm)               !  from sky to wall
-      real fsg(ndm,nurbm)                     !  from sky to ground
+!   fww_u,fwg_u,fgw_u,fsw_u,fsg_u are the view factors used to compute the long wave
+!   and the short wave radiation. 
+      real fww_u(nz_um,nz_um,ndm,nurbm)         !  from wall to wall
+      real fwg_u(nz_um,ndm,nurbm)               !  from wall to ground
+      real fgw_u(nz_um,ndm,nurbm)               !  from ground to wall
+      real fsw_u(nz_um,ndm,nurbm)               !  from sky to wall
+      real fws_u(nz_um,ndm,nurbm)               !  from sky to wall
+      real fsg_u(ndm,nurbm)                     !  from sky to ground
 
 !    Roughness parameters
       real z0g_u(nurbm)         ! The ground's roughness length
@@ -244,8 +293,7 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       integer nz_u(nurbm)       ! Number of layer in the urban grid
       
       real z_u(nz_um)         ! Height of the urban grid levels
-
-!   MT
+!FS
       real cop_u(nurbm)
       real pwin_u(nurbm)
       real beta_u(nurbm)
@@ -275,6 +323,7 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       real rs1D                    ! solar radiation
       real rld1D                   ! downward flux of the longwave radiation
 
+
       real tw1D(2*ndm,nz_um,nwr_u,nbui_max) ! temperature in each layer of the wall
       real tg1D(ndm,ng_u)                   ! temperature in each layer of the ground
       real tr1D(ndm,nz_um,nwr_u)   ! temperature in each layer of the roof
@@ -293,7 +342,7 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       real sfwin1D(2*ndm,nz_um,nbui_max)     ! sensible heat flux from windows
       real consumlev1D(nz_um,nz_um)       ! consumption due to the air conditioning systems
       real qv1D(kms:kme)                  ! specific humidity
-      real meso_urb                       ! constant to link meso and urban scales [m¯2]
+      real meso_urb                       ! constant to link meso and urban scales [m-2]
       real d_urb(nz_um)    
       real sf_ac
       integer ibui,nbui
@@ -319,6 +368,7 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       real b_q1D(kms:kme)               ! Explicit component of the Humidity sources or sinks
       real dlg1D(kms:kme)               ! Height above ground (L_ground in formula (24) of the BLM paper). 
       real dl_u1D(kms:kme)              ! Length scale (lb in formula (22) ofthe BLM paper)
+
       real time_bep
 ! arrays used to collapse indexes
       integer ind_zwd(nbui_max,nz_um,nwr_u,ndm)
@@ -335,34 +385,36 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       integer ix,iy,iz,iurb,id,iz_u,iw,ig,ir,ix1,iy1,k
       integer it, nint
       integer iii
-      real tempo
+     
       logical first
       character(len=80) :: text
       data first/.true./
       save first,time_bep 
 
-      save alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,                      &
-          albg_u,albw_u,albr_u,emg_u,emw_u,emr_u,fww,fwg,fgw,fsw,fws,fsg, &
-          z0g_u,z0r_u, nd_u,strd_u,drst_u,ws_u,bs_u,h_b,d_b,ss_u,pb_u,  &
-          nz_u,z_u,albwin_u,emwind_u ,                                  &
-          cop_u, pwin_u, beta_u, sw_cond_u, time_on_u, time_off_u, targtemp_u,  &
-          gaptemp_u, targhum_u, gaphum_u, perflo_u, hsesf_u, hsequip
+      save alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,                       &
+           albg_u,albw_u,albr_u,emg_u,emw_u,emr_u,                       &
+           z0g_u,z0r_u, nd_u,strd_u,drst_u,ws_u,bs_u,h_b,d_b,ss_u,pb_u,  &
+           nz_u,z_u,albwin_u,emwind_u,cop_u,pwin_u,beta_u,sw_cond_u,     &
+           time_on_u,time_off_u,targtemp_u,gaptemp_u,targhum_u,gaphum_u, &
+           perflo_u,hsesf_u,hsequip 
 
 !------------------------------------------------------------------------
 !    Calculation of the momentum, heat and turbulent kinetic fluxes
-!     produced by builgings
+!     produced by buildings
 !
-! Reference:
+! References:
 ! Martilli, A., Clappier, A., Rotach, M.W.:2002, 'AN URBAN SURFACE EXCHANGE
 ! PARAMETERISATION FOR MESOSCALE MODELS', Boundary-Layer Meteorolgy 104:
 ! 261-304
 !
 ! F. Salamanca and A. Martilli, 2009: 'A new Building Energy Model coupled 
-! with an Urban Canopy Parameterization for urban climate simulations_part II. 
+! with an Urban Canopy Parameterization for urban climate simulations-part II. 
 ! Validation with one dimension off-line simulations'. Theor Appl Climatol
 ! DOI 10.1007/s00704-009-0143-8 
 !------------------------------------------------------------------------
+!
 !prepare the arrays to collapse indexes
+
       if(num_urban_layers.lt.nbui_max*nz_um*ndm*max(nwr_u,ng_u))then
         write(*,*)'num_urban_layers too small, please increase to at least ', nbui_max*nz_um*ndm*max(nwr_u,ng_u)
         stop
@@ -425,7 +477,7 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       enddo
       enddo
       enddo
-      
+
       iii=0
       do ig=1,ng_u
       do id=1,ndm
@@ -433,7 +485,7 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
        ind_gd(ig,id)=iii
       enddo
       enddo
-      
+
       iii=0
       do ibui=1,nbui_max
       do iz_u=1,nz_um
@@ -443,7 +495,7 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       enddo
       enddo
       enddo
-      
+  
       iii=0
       do iz_u=1,nz_um
       do iw=1,nwr_u
@@ -453,7 +505,7 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       enddo
       enddo
       enddo
-      
+     
 !
 !New indexes for BEM
 !
@@ -464,7 +516,7 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
          ind_zdf(iz_u,id)=iii
       enddo ! id
       enddo ! iz_u
-      
+
       iii=0
       do ibui=1,nbui_max  !Type of building
       do iz_u=1,nz_um     !vertical levels
@@ -483,7 +535,7 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       enddo !id
       enddo !iz_u
       enddo !ibui
-      
+
       iii=0
       do ibui=1,nbui_max!type of building
       do iw=1,ngb_u !layers in the wall (ground below a building)
@@ -493,7 +545,7 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       enddo !id
       enddo !iw 
       enddo !ibui    
-      
+
       iii=0
       do ibui=1,nbui_max !type of building
       do iw=1,nf_u !layers in the wall (floor)
@@ -505,10 +557,21 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
       enddo !iz_u
       enddo !iw
       enddo !ibui
-      
 !
 !End of new indexes
-!      
+!   
+      if (num_urban_hi.ge.nz_um)then
+          write(*,*)'nz_um too small, please increase to at least ', num_urban_hi+1
+          stop         
+      endif
+   
+      do ix=its,ite
+      do iy=jts,jte
+      do iz_u=1,nz_um
+          hi_urb(ix,iz_u,iy)=0.
+      enddo
+      enddo
+      enddo
 
       do ix=its,ite
       do iy=jts,jte
@@ -516,21 +579,31 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
        do iz=kts+1,kte+1
         z(ix,iz,iy)=z(ix,iz-1,iy)+dz8w(ix,iz-1,iy)
        enddo
+       iii=0
+       do iz_u=1,num_urban_hi
+          hi_urb(ix,iz_u,iy)= hi_urb2d(ix,iz_u,iy)
+          if (hi_urb(ix,iz_u,iy)/=0.) then
+             iii=iii+1
+          endif
+       enddo !iz_u
+       if (iii.gt.nbui_max) then
+          write(*,*) 'nbui_max too small, please increase to at least ',iii
+          stop
+       endif
       enddo
       enddo
 
       if (first) then                           ! True only on first call
+
          call init_para(alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,&
                 twini_u,trini_u,tgini_u,albg_u,albw_u,albr_u,albwin_u,emg_u,emw_u,&
-                emr_u,emwind_u,z0g_u,z0r_u,nd_u,strd_u,drst_u,ws_u,bs_u,h_b,d_b,&
-                cop_u, pwin_u, beta_u, sw_cond_u, time_on_u, time_off_u, &
-                targtemp_u, gaptemp_u, targhum_u, gaphum_u, perflo_u, hsesf_u, hsequip)
+                emr_u,emwind_u,z0g_u,z0r_u,nd_u,strd_u,drst_u,ws_u,bs_u,h_b,d_b,  &
+                cop_u,pwin_u,beta_u,sw_cond_u,time_on_u,time_off_u,targtemp_u,    &
+                gaptemp_u,targhum_u,gaphum_u,perflo_u,hsesf_u,hsequip)
 
 !Initialisation of the urban parameters and calculation of the view factor
-       call icBEP(fww,fwg,fgw,fsw,fws,fsg,                         & 
-                 z0g_u,z0r_u,                                      & 
-                 nd_u,strd_u,ws_u,bs_u,h_b,d_b,ss_u,pb_u,          & 
-                 nz_u,z_u)                                  
+
+       call icBEP(nd_u,h_b,d_b,ss_u,pb_u,nz_u,z_u)                                  
 
        first=.false.
 
@@ -541,18 +614,44 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
         if (FRC_URB2D(ix,iy).gt.0.) then    ! Calling BEP only for existing urban classes.
 	
          iurb=UTYPE_URB2D(ix,iy)
+
+         hi_urb1D=0.
+         do iz_u=1,nz_um
+            hi_urb1D(iz_u)=hi_urb(ix,iz_u,iy)
+         enddo
+
+         call icBEPHI_XY(iurb,hb_u,hi_urb1D,ss_urb,pb_urb,    &
+                         nz_urb(iurb),z_u)
+
+         call param(iurb,nz_u(iurb),nz_urb(iurb),nzurban(iurb),      &
+                    nd_u(iurb),csg_u,csg,alag_u,alag,csr_u,csr,      &
+                    alar_u,alar,csw_u,csw,alaw_u,alaw,               &
+                    ws_u,ws_urb,ws,bs_u,bs_urb,bs,z0g_u,z0r_u,z0,    &
+                    strd_u,strd,drst_u,drst,ss_u,ss_urb,ss,pb_u,     &
+                    pb_urb,pb,dzw,dzr,dzf,csf,alaf,dzgb,csgb,alagb,  &
+                    lp_urb2d(ix,iy),lb_urb2d(ix,iy),                 &
+                    hgt_urb2d(ix,iy),FRC_URB2D(ix,iy))
+         
+!
+!We compute the view factors in the icBEP_XY routine
+!  
+
+         call icBEP_XY(iurb,fww_u,fwg_u,fgw_u,fsw_u,fws_u,fsg_u,   &
+                         nd_u(iurb),strd,ws,nzurban(iurb),z_u)   
+
          ibui=0
          nlev=0
          nbui=0
          d_urb=0.
          do iz=1,nz_um		   
-         if(ss_u(iz,iurb).gt.0) then		
+         if(ss_urb(iz,iurb).gt.0) then		
            ibui=ibui+1		                
            nlev(ibui)=iz-1
-           d_urb(ibui)=ss_u(iz,iurb)
+           d_urb(ibui)=ss_urb(iz,iurb)
            nbui=ibui
 	 endif	  
          end do  !iz
+
          if (nbui.gt.nbui_max) then
             write (*,*) 'nbui_max must be increased to',nbui
             stop
@@ -564,7 +663,7 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
 	  pt1D(iz)=th_phy(ix,iz,iy)
 	  da1D(iz)=rho(ix,iz,iy)
 	  pr1D(iz)=p_phy(ix,iz,iy)
-!	  pt01D(iz)=th_phy(ix,iz,iy)
+!!	  pt01D(iz)=th_phy(ix,iz,iy)
 	  pt01D(iz)=300.
 	  z1D(iz)=z(ix,iz,iy)
           qv1D(iz)=qv_phy(ix,iz,iy)
@@ -584,6 +683,8 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
          do iz_u=1,nz_um
          do iw=1,nwr_u
          do ibui=1,nbui_max
+!!        tw1D(2*id-1,iz_u,iw)=tw1_u(ix,iy,ind_zwd(iz_u,iw,id))
+!!        tw1D(2*id,iz_u,iw)=tw2_u(ix,iy,ind_zwd(iz_u,iw,id))
           tw1D(2*id-1,iz_u,iw,ibui)=tw1_urb4d(ix,ind_zwd(ibui,iz_u,iw,id),iy)
           tw1D(2*id,iz_u,iw,ibui)=tw2_urb4d(ix,ind_zwd(ibui,iz_u,iw,id),iy)
          enddo
@@ -593,10 +694,12 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
 	
          do id=1,ndm
           do ig=1,ng_u
+!!          tg1D(id,ig)=tg_u(ix,iy,ind_gd(ig,id))
             tg1D(id,ig)=tgb_urb4d(ix,ind_gd(ig,id),iy)
           enddo
           do iz_u=1,nz_um
           do ir=1,nwr_u
+!!          tr1D(id,iz_u,ir)=tr_u(ix,iy,ind_zwd(iz_u,ir,id))
             tr1D(id,iz_u,ir)=trb_urb4d(ix,ind_zrd(iz_u,ir,id),iy)
           enddo
           enddo
@@ -662,6 +765,8 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
          do id=1,ndm
 	 do iz=1,nz_um
          do ibui=1,nbui_max !type of building
+!!	  sfw1D(2*id-1,iz)=sfw1(ix,iy,ind_zd(iz,id))
+!!	  sfw1D(2*id,iz)=sfw2(ix,iy,ind_zd(iz,id))
 	  sfw1D(2*id-1,iz,ibui)=sfw1_urb3d(ix,ind_zd(ibui,iz,id),iy)
 	  sfw1D(2*id,iz,ibui)=sfw2_urb3d(ix,ind_zd(ibui,iz,id),iy)
          enddo
@@ -669,11 +774,13 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
 	 enddo
 	 
 	 do id=1,ndm
+!!	  sfg1D(id)=sfg(ix,iy,id)
 	  sfg1D(id)=sfg_urb3d(ix,id,iy)
 	 enddo
 	 
 	 do id=1,ndm
 	 do iz=1,nz_um
+!!	  sfr1D(id,iz)=sfr(ix,iy,ind_zd(iz,id))
 	  sfr1D(id,iz)=sfr_urb3d(ix,ind_zdf(iz,id),iy)
 	 enddo
 	 enddo
@@ -683,19 +790,21 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
 
          zr1D=acos(COSZ_URB2D(ix,iy))
          deltar1D=DECLIN_URB
-         ah1D=OMG_URB2D(ix,iy)       
+         ah1D=OMG_URB2D(ix,iy)
 
          call BEP1D(iurb,kms,kme,kts,kte,z1D,dt,ua1D,va1D,pt1D,da1D,pr1D,pt01D,  &
-                   zr1D,deltar1D,ah1D,rs1D,rld1D,                   & 
-                   alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,          & 
-                   albg_u,albw_u,albr_u,albwin_u,emg_u,emw_u,emr_u, & 
-                   emwind_u,fww,fwg,fgw,fsw,fws,fsg,                & 
-                   z0g_u,z0r_u,                                     & 
-                   nd_u,strd_u,drst_u,ws_u,bs_u,h_b,d_b,ss_u,pb_u,  & 
-                   nz_u,z_u,                                        & 
-                   cop_u,pwin_u,beta_u,sw_cond_u,time_on_u,         &
-                   time_off_u,targtemp_u,gaptemp_u,targhum_u,       &
-                   gaphum_u, perflo_u, hsesf_u, hsequip,            &
+                   zr1D,deltar1D,ah1D,rs1D,rld1D,alagb,             & 
+                   alag,alaw,alar,alaf,csgb,csg,csw,csr,csf,        & 
+                   dzr,dzf,dzw,dzgb,                                &
+                   albg_u(iurb),albw_u(iurb),albr_u(iurb),          &
+                   albwin_u(iurb),emg_u(iurb),emw_u(iurb),          &
+                   emr_u(iurb),emwind_u(iurb),fww_u,fwg_u,          &
+                   fgw_u,fsw_u,fws_u,fsg_u,z0,                      & 
+                   nd_u(iurb),strd,drst,ws,bs_urb,bs,ss,pb,         & 
+                   nzurban(iurb),z_u,cop_u,pwin_u,beta_u,           & 
+                   sw_cond_u,time_on_u,time_off_u,targtemp_u,       &
+                   gaptemp_u,targhum_u,gaphum_u,perflo_u,           &
+                   hsesf_u,hsequip,                                 &
                    tw1D,tg1D,tr1D,sfw1D,sfg1D,sfr1D,                & 
                    a_u1D,a_v1D,a_t1D,a_e1D,                         & 
                    b_u1D,b_v1D,b_t1D,b_ac1D,b_e1D,b_q1D,            & 
@@ -704,15 +813,16 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
                    qv1D,tlev1D,qlev1D,sflev1D,lflev1D,consumlev1D,  &
                    sfvlev1D,lfvlev1D,twlev1D,tglev1D,tflev1D,sfwin1D,&
                    ix,iy)                            
-
-         do id=1,ndm ! direction 
+ 
+         do ibui=1,nbui_max !type of building
 	    do iz=1,nz_um   !vertical levels
-               do ibui=1,nbui_max !type of building
+               do id=1,ndm ! direction
 	          sfw1_urb3d(ix,ind_zd(ibui,iz,id),iy)=sfw1D(2*id-1,iz,ibui) 
 	          sfw2_urb3d(ix,ind_zd(ibui,iz,id),iy)=sfw1D(2*id,iz,ibui) 
 	       enddo
 	    enddo
          enddo
+ 
 	 do id=1,ndm
 	  sfg_urb3d(ix,id,iy)=sfg1D(id) 
 	 enddo
@@ -723,10 +833,10 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
 	 enddo
 	 enddo
          
-         do id=1,ndm
+         do ibui=1,nbui_max
          do iz_u=1,nz_um
          do iw=1,nwr_u
-         do ibui=1,nbui_max
+         do id=1,ndm
           tw1_urb4d(ix,ind_zwd(ibui,iz_u,iw,id),iy)=tw1D(2*id-1,iz_u,iw,ibui)
           tw2_urb4d(ix,ind_zwd(ibui,iz_u,iw,id),iy)=tw1D(2*id,iz_u,iw,ibui)
          enddo
@@ -747,59 +857,62 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
 !
 !Outputs of BEM
 !
+        
          do ibui=1,nbui_max !type of building
          do iz_u=1,nz_um !vertical levels
             tlev_urb3d(ix,ind_bd(ibui,iz_u),iy)=tlev1D(iz_u,ibui)  
             qlev_urb3d(ix,ind_bd(ibui,iz_u),iy)=qlev1D(iz_u,ibui)  
          enddo !iz_u
          enddo !ibui
-         do id=1,ndm !direction
-         do iz_u=1,nz_um !vertical levels
+ 
          do ibui=1,nbui_max !type of building
+         do iz_u=1,nz_um !vertical levels
+            do id=1,ndm !direction
                tw1lev_urb3d(ix,ind_wd(ibui,iz_u,id),iy)=twlev1D(2*id-1,iz_u,ibui)
                tw2lev_urb3d(ix,ind_wd(ibui,iz_u,id),iy)=twlev1D(2*id,iz_u,ibui)
                sfwin1_urb3d(ix,ind_wd(ibui,iz_u,id),iy)=sfwin1D(2*id-1,iz_u,ibui)
                sfwin2_urb3d(ix,ind_wd(ibui,iz_u,id),iy)=sfwin1D(2*id,iz_u,ibui)
-            enddo !ibui  
+            enddo !id  
          enddo !iz_u
-         enddo !id
+         enddo !ibui
         
-         do id=1,ndm !direction
+         do ibui=1,nbui_max  !type of building
             do iw=1,ngb_u !layers in the walls
-               do ibui=1,nbui_max  !type of building
+               do id=1,ndm !direction
                   tglev_urb3d(ix,ind_gbd(ibui,iw,id),iy)=tglev1D(id,iw,ibui)
-               enddo !ibui
+               enddo !id
             enddo !iw
-         enddo !id
+         enddo !ibui
 
-         do id=1,ndm   !direction 
+         do ibui=1,nbui_max  !type of building  
             do iw=1,nf_u !layer in the walls
                do iz_u=1,nz_um-1 !verticals levels
-                  do ibui=1,nbui_max  !type of building
+                  do id=1,ndm   !direction
                      tflev_urb3d(ix,ind_fbd(ibui,iw,iz_u,id),iy)=tflev1D(id,iw,iz_u,ibui)
-                  enddo !ibui
+                  enddo !id
                enddo !iz_u
              enddo !iw
-         enddo !id
+         enddo !ibui
+ 
          sf_ac_urb3d(ix,iy)=0.
          lf_ac_urb3d(ix,iy)=0.
          cm_ac_urb3d(ix,iy)=0.
          sfvent_urb3d(ix,iy)=0.
          lfvent_urb3d(ix,iy)=0.
 
-         meso_urb=(1./4.)*FRC_URB2D(ix,iy)/((bs_u(1,iurb)+ws_u(1,iurb))*bs_u(2,iurb))+ &
-                  (1./4.)*FRC_URB2D(ix,iy)/((bs_u(2,iurb)+ws_u(2,iurb))*bs_u(1,iurb))
+         meso_urb=(1./4.)*FRC_URB2D(ix,iy)/((bs_urb(1,iurb)+ws_urb(1,iurb))*bs_urb(2,iurb))+ &
+                  (1./4.)*FRC_URB2D(ix,iy)/((bs_urb(2,iurb)+ws_urb(2,iurb))*bs_urb(1,iurb))
 
-                  
+         
          ibui=0
          nlev=0
          nbui=0
          d_urb=0.
          do iz=1,nz_um		   
-         if(ss_u(iz,iurb).gt.0) then		
+         if(ss_urb(iz,iurb).gt.0) then		
            ibui=ibui+1		                
            nlev(ibui)=iz-1
-           d_urb(ibui)=ss_u(iz,iurb)
+           d_urb(ibui)=ss_urb(iz,iurb)
            nbui=ibui
 	 endif	  
          end do  !iz
@@ -813,20 +926,36 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
                lfvent_urb3d(ix,iy)=lfvent_urb3d(ix,iy)+meso_urb*d_urb(ibui)*lfvlev1D(iz_u,ibui)            
          enddo !iz_u
          enddo !ibui
+
 !
 !Add the latent heat exchanged throughout the ventilation in the lf_ac_urb3d output variable. 
-!it is only a print variable
+!it is only a rint variable
 !
 !        lf_ac_urb3d(ix,iy)=lf_ac_urb3d(ix,iy)+lfvent_urb3d(ix,iy)
 !
 
          lf_ac_urb3d(ix,iy)=lf_ac_urb3d(ix,iy)-lfvent_urb3d(ix,iy)        
 
+
 !
 !End outputs of bem
 !
 
         sf_ac=0.
+        sf(ix,kts:kte,iy)=0.
+        vl(ix,kts:kte,iy)=0.
+        a_u(ix,kts:kte,iy)=0.
+        a_v(ix,kts:kte,iy)=0.
+        a_t(ix,kts:kte,iy)=0.
+        a_e(ix,kts:kte,iy)=0.
+        b_u(ix,kts:kte,iy)=0.
+        b_v(ix,kts:kte,iy)=0.
+        b_t(ix,kts:kte,iy)=0.
+        b_e(ix,kts:kte,iy)=0.
+        b_q(ix,kts:kte,iy)=0.
+        dlg(ix,kts:kte,iy)=0.
+        dl_u(ix,kts:kte,iy)=0.
+
         do iz= kts,kte
           sf(ix,iz,iy)=sf1D(iz)
           vl(ix,iz,iy)=vl1D(iz)
@@ -842,32 +971,38 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy,      &
           b_q(ix,iz,iy)=b_q1D(iz)
           dlg(ix,iz,iy)=dlg1D(iz)
           dl_u(ix,iz,iy)=dl_u1D(iz)
-         enddo
-         sf(ix,kte+1,iy)=sf1D(kte+1)
+        enddo
+        sf(ix,kte+1,iy)=sf1D(kte+1)
 
          endif ! FRC_URB2D
    
       enddo  ! iy
       enddo  ! ix
 
+
         time_bep=time_bep+dt
 
+      print*, 'ss_urb', ss_urb
+      print*, 'pb_urb', pb_urb
+      print*, 'nz_urb', nz_urb
+      print*, 'd_urb',  d_urb
+            
       return
       end subroutine BEP_BEM
             
 ! ===6=8===============================================================72
 
       subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,   &  
-                      zr,deltar,ah,rs,rld,                             & 
-                      alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,          & 
-                      albg_u,albw_u,albr_u,albwin_u,emg_u,emw_u,emr_u, & 
-                      emwind_u,fww,fwg,fgw,fsw,fws,fsg,                & 
-                      z0g_u,z0r_u,                                     & 
-                      nd_u,strd_u,drst_u,ws_u,bs_u,h_b,d_b,ss_u,pb_u,  & 
-                      nz_u,z_u,                                        & 
-                      cop_u,pwin_u,beta_u,sw_cond_u,time_on_u,         &
-                      time_off_u,targtemp_u,gaptemp_u,targhum_u,       &
-                      gaphum_u, perflo_u, hsesf_u, hsequip,            &
+                      zr,deltar,ah,rs,rld,alagb,                       & 
+                      alag,alaw,alar,alaf,csgb,csg,csw,csr,csf,        & 
+                      dzr,dzf,dzw,dzgb,                                &
+                      albg,albw,albr,albwin,emg,emw,emr,               & 
+                      emwind,fww,fwg,fgw,fsw,fws,fsg,z0,               & 
+                      ndu,strd,drst,ws,bs_u,bs,ss,pb,                  & 
+                      nzu,z_u,cop_u,pwin_u,beta_u,sw_cond_u,           & 
+                      time_on_u,time_off_u,targtemp_u,                 &
+                      gaptemp_u,targhum_u,gaphum_u,perflo_u,           &
+                      hsesf_u,hsequip,                                 &
                       tw,tg,tr,sfw,sfg,sfr,                            & 
                       a_u,a_v,a_t,a_e,                                 &
                       b_u,b_v,b_t,b_ac,b_e,b_q,                        & 
@@ -923,6 +1058,7 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,   &
 
 ! Data relative to the "mesoscale grid"
 
+!!    integer nz                 ! Number of vertical levels
       integer kms,kme,kts,kte
       real z(kms:kme)               ! Altitude above the ground of the cell interfaces.
       real ua(kms:kme)                ! Wind speed in the x direction
@@ -943,23 +1079,15 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,   &
 
       integer iurb               ! Current urban class
 
-!    Building parameters      
-      real alag_u(nurbm)         ! Ground thermal diffusivity [m^2 s^-1]
-      real alaw_u(nurbm)         ! Wall thermal diffusivity [m^2 s^-1]
-      real alar_u(nurbm)         ! Roof thermal diffusivity [m^2 s^-1]
-      real csg_u(nurbm)          ! Specific heat of the ground material [J m^3 K^-1]
-      real csw_u(nurbm)          ! Specific heat of the wall material [J m^3 K^-1]
-      real csr_u(nurbm)          ! Specific heat of the roof material [J m^3 K^-1]
-
 !    Radiation parameters
-      real albg_u(nurbm)         ! Albedo of the ground
-      real albw_u(nurbm)         ! Albedo of the wall
-      real albr_u(nurbm)         ! Albedo of the roof
-      real albwin_u(nurbm)       ! Albedo of the windows
-      real emwind_u(nurbm)       ! Emissivity of windows
-      real emg_u(nurbm)          ! Emissivity of ground
-      real emw_u(nurbm)          ! Emissivity of wall
-      real emr_u(nurbm)          ! Emissivity of roof
+      real albg                  ! Albedo of the ground
+      real albw                  ! Albedo of the wall
+      real albr                  ! Albedo of the roof
+      real albwin                ! Albedo of the windows
+      real emwind                ! Emissivity of windows
+      real emg                   ! Emissivity of ground
+      real emw                   ! Emissivity of wall
+      real emr                   ! Emissivity of roof
 
 !    fww,fwg,fgw,fsw,fsg are the view factors used to compute the long and 
 !    short wave radation. 
@@ -970,27 +1098,15 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,   &
       real fsw(nz_um,ndm,nurbm)        !  from sky to wall
       real fws(nz_um,ndm,nurbm)        !  from wall to sky
       real fsg(ndm,nurbm)              !  from sky to ground
-
-!    Roughness parameters
-      real z0g_u(nurbm)            ! The ground's roughness length
-      real z0r_u(nurbm)            ! The roof's roughness length
       
 !    Street parameters
-      integer nd_u(nurbm)          ! Number of street direction for each urban class 
-      real strd_u(ndm,nurbm)       ! Street length (set to a greater value then the horizontal length of the cells)
-      real drst_u(ndm,nurbm)       ! Street direction
-      real ws_u(ndm,nurbm)         ! Street width
+      integer ndu                  ! Number of street direction for each urban class 
       real bs_u(ndm,nurbm)         ! Building width
-      real h_b(nz_um,nurbm)        ! Bulding's heights
-      real d_b(nz_um,nurbm)        ! The probability that a building has an height "h_b"
-      real ss_u(nz_um,nurbm)     ! The probability that a building has an height equal to "z"
-      real pb_u(nz_um,nurbm)     ! The probability that a building has an height greater or equal to "z"
         
 !    Grid parameters
-      integer nz_u(nurbm)     ! Number of layer in the urban grid
+      integer nzu           ! Number of layer in the urban grid
       real z_u(nz_um)       ! Height of the urban grid levels
-
-!   MT
+!FS
       real cop_u(nurbm)
       real pwin_u(nurbm)
       real beta_u(nurbm)
@@ -1043,6 +1159,7 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,   &
       real b_q(kms:kme)              ! Explicit component of the humidity sources or sinks
       real dlg(kms:kme)              ! Height above ground (L_ground in formula (24) of the BLM paper). 
       real dl_u(kms:kme)             ! Length scale (lb in formula (22) ofthe BLM paper).
+    
       
 ! ----------------------------------------------------------------------
 ! LOCAL:
@@ -1139,12 +1256,12 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,   &
       real alaf(nf_u+1)     ! Floor thermal diffusivity at each wall layers [W/m K]     
       real alagb(ngb_u+1)   ! Ground thermal diffusivity below the building at each wall layer [W/m K] 
 
-      real sfrb(ndm,nbui_max)        ! Sensible heat flux from roofs [W/m²]
-      real gfrb(ndm,nbui_max)        ! Heat flux flowing inside the roofs [W/m²]
-      real sfwb1D(2*ndm,nz_um)    !Sensible heat flux from the walls [W/m²] 
-      real sfwin(2*ndm,nz_um,nbui_max)!Sensible heat flux from windows [W/m²]
-      real sfwinb1D(2*ndm,nz_um)  !Sensible heat flux from windows [W/m²]
-      real gfwb1D(2*ndm,nz_um)    !Heat flux flowing inside the walls [W/m²]
+      real sfrb(ndm,nbui_max)        ! Sensible heat flux from roofs [W/m2]
+      real gfrb(ndm,nbui_max)        ! Heat flux flowing inside the roofs [W/m2]
+      real sfwb1D(2*ndm,nz_um)    !Sensible heat flux from the walls [W/m2] 
+      real sfwin(2*ndm,nz_um,nbui_max)!Sensible heat flux from windows [W/m2]
+      real sfwinb1D(2*ndm,nz_um)  !Sensible heat flux from windows [W/m2]
+      real gfwb1D(2*ndm,nz_um)    !Heat flux flowing inside the walls [W/m2]
 
       real qlev(nz_um,nbui_max)      !specific humidity [kg/kg]
       real qlevb1D(nz_um)         !specific humidity [kg/kg] 
@@ -1187,59 +1304,53 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,   &
 
 ! Fix some usefull parameters for the computation of the sources or sinks
 !
-!initialize inside param
+!initialize the variables inside the param routine
 !
-!      ss=0.
-!      pb=0.
 
       do iz=kts,kte
          dz(iz)=z(iz+1)-z(iz)
       end do
-      call param(iurb,nz_u(iurb),nd_u(iurb),                          &
-                       csg_u,csg,alag_u,alag,csr_u,csr,               &
-                       alar_u,alar,csw_u,csw,alaw_u,alaw,             &
-                       ws_u,ws,bs_u,bs,z0g_u,z0r_u,z0,                &
-                       strd_u,strd,drst_u,drst,ss_u,ss,pb_u,pb,       &
-                       dzw,dzr,dzf,csf,alaf,dzgb,csgb,alagb)
 
 ! Interpolation on the "urban grid"
 
-      call interpol(kms,kme,kts,kte,nz_u(iurb),z,z_u,ua,ua_u)
-      call interpol(kms,kme,kts,kte,nz_u(iurb),z,z_u,va,va_u)
-      call interpol(kms,kme,kts,kte,nz_u(iurb),z,z_u,pt,pt_u)
-      call interpol(kms,kme,kts,kte,nz_u(iurb),z,z_u,pt0,pt0_u)
-      call interpol(kms,kme,kts,kte,nz_u(iurb),z,z_u,pr,pr_u)
-      call interpol(kms,kme,kts,kte,nz_u(iurb),z,z_u,da,da_u)
-      call interpol(kms,kme,kts,kte,nz_u(iurb),z,z_u,qv,qv_u)
+      call interpol(kms,kme,kts,kte,nzu,z,z_u,ua,ua_u)
+      call interpol(kms,kme,kts,kte,nzu,z,z_u,va,va_u)
+      call interpol(kms,kme,kts,kte,nzu,z,z_u,pt,pt_u)
+      call interpol(kms,kme,kts,kte,nzu,z,z_u,pt0,pt0_u)
+      call interpol(kms,kme,kts,kte,nzu,z,z_u,pr,pr_u)
+      call interpol(kms,kme,kts,kte,nzu,z,z_u,da,da_u)
+      call interpol(kms,kme,kts,kte,nzu,z,z_u,qv,qv_u)
                    
 ! Compute the modification of the radiation due to the buildings
+      
 
       call averaging_temp(tw,twlev,ss,pb,tw_av,twlev_av, &
                           sfw_av,sfwind_av,sfw,sfwin)
-      call modif_rad(iurb,nd_u(iurb),nz_u(iurb),z_u,ws,           &
-                    drst,strd,ss,pb,                              &
-                    tw_av,tg,twlev_av,albg_u(iurb),albw_u(iurb),  &
-                    emw_u(iurb),emg_u(iurb),pwin_u(iurb),albwin_u(iurb),  &
-                    emwind_u(iurb),fww,fwg,fgw,fsw,fsg,           &
-                    zr,deltar,ah,                                 &
-                    rs,rld,rsw,rsg,rlw,rlg)                       
+     
+
+      call modif_rad(iurb,ndu,nzu,z_u,ws,           &
+                    drst,strd,ss,pb,                &
+                    tw_av,tg,twlev_av,albg,albw,    &
+                    emw,emg,pwin_u(iurb),albwin,    &
+                    emwind,fww,fwg,fgw,fsw,fsg,     &
+                    zr,deltar,ah,                   &
+                    rs,rld,rsw,rsg,rlw,rlg)  
 
 ! calculation of the urban albedo and the upward long wave radiation
 
-       call upward_rad(nd_u(iurb),nz_u(iurb),ws,bs,sigma,pb,ss,                &
-                       tg,emg_u(iurb),albg_u(iurb),rlg,rsg,sfg,                & 
-                       tw_av,emw_u(iurb),albw_u(iurb),rlw,rsw,sfw_av,          & 
-                       tr,emr_u(iurb),albr_u(iurb),emwind_u(iurb),             &
-                       albwin_u(iurb),twlev_av,pwin_u(iurb),sfwind_av,rld,rs,sfr,      & 
+       call upward_rad(ndu,nzu,ws,bs,sigma,pb,ss,                 &
+                       tg,emg,albg,rlg,rsg,sfg,                   & 
+                       tw_av,emw,albw,rlw,rsw,sfw_av,             & 
+                       tr,emr,albr,emwind,                        &
+                       albwin,twlev_av,pwin_u(iurb),sfwind_av,rld,rs,sfr, & 
                        rs_abs,rl_up,emiss,grdflx_urb)               
-
+        
 ! Compute the surface temperatures
-      
-      call surf_temp(nd_u(iurb),pr_u,dt,              & 
-                    rld,rsg,rlg,                      &
-                    tg,alag,csg,emg_u(iurb),albg_u(iurb),ptg,sfg,gfg)
-
 
+      call surf_temp(ndu,pr_u,dt,                   & 
+                    rld,rsg,rlg,                    &
+                    tg,alag,csg,emg,albg,ptg,sfg,gfg)
+      
 ! Call the BEM (Building Energy Model) routine 
        
        do iz=1,nz_um !Compute the outdoor temperature 
@@ -1254,7 +1365,7 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,   &
        gfrb=0.     !Heat flux flowing inside the roof
        sfwb1D=0.   !Sensible heat flux from walls
        sfwinb1D=0. !Sensible heat flux from windows
-       gfwb1D=0.   !Heat flux flowing inside the walls[W/m²]
+       gfwb1D=0.   !Heat flux flowing inside the walls[W/m2]
 
 
        twb1D=0.    !Wall temperature
@@ -1276,7 +1387,7 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,   &
        ptw=0.        !Wall potential temperature
        ptwin=0.      !Window potential temperature
        ptr=0.        !Roof potential temperature
-       
+
        do iz=1,nz_um		   
          if(ss(iz).gt.0) then		
            ibui=ibui+1		                
@@ -1289,23 +1400,24 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,   &
               enddo
            enddo
 	 endif	  
-       end do  !iz    
+       end do  !iz
+     
 !--------------------------------------------------------------------------------
 !Loop over BEM  -----------------------------------------------------------------
 !--------------------------------------------------------------------------------
 !--------------------------------------------------------------------------------
-   
-       nhourday=ah/PI*180./15.+12.
-       if (nhourday >= 24) nhourday = nhourday - 24
-       if (nhourday < 0)  nhourday = nhourday + 24
+        nhourday=ah/PI*180./15.+12.
+        if (nhourday >= 24) nhourday = nhourday - 24
+        if (nhourday < 0)  nhourday = nhourday + 24
 
         do ibui=1,nbui
+
          
           do iz=1,nz_um
              qlevb1D(iz)=qlev(iz,ibui)
              tlevb1D(iz)=tlev(iz,ibui) 
           enddo
-             
+          
           do id=1,ndm
 
              do ily=1,nwr_u
@@ -1314,18 +1426,18 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,   &
              do ily=1,ngb_u
                 tglevb1D(ily)=tglev(id,ily,ibui) 
              enddo
-              
+
              do ily=1,nf_u
              do iz=1,nz_um-1
                tflevb1D(ily,iz)=tflev(id,ily,iz,ibui)
              enddo
              enddo
-            
+
              do iz=1,nz_um
                 sfwinb1D(2*id-1,iz)=sfwin(2*id-1,iz,ibui)
                 sfwinb1D(2*id,iz)=sfwin(2*id,iz,ibui)
              enddo
-            
+
              do iz=1,nz_um
                 do ily=1,nwr_u
                    twb1D(2*id-1,ily,iz)=tw(2*id-1,iz,ily,ibui)
@@ -1336,22 +1448,171 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,   &
                 twlevb1D(2*id-1,iz)=twlev(2*id-1,iz,ibui)
                 twlevb1D(2*id,iz)=twlev(2*id,iz,ibui)
              enddo
-          enddo   
-
-          call BEM(nz_um,nlev(ibui),nhourday,dt,bs_u(1,iurb),                   &
-                   bs_u(2,iurb),dz_u,nwr_u,nf_u,nwr_u,ngb_u,sfwb1D,gfwb1D,      &
-                   sfwinb1D,sfrb(1,ibui),gfrb(1,ibui),                          &
-                   latent,sigma,albw_u(iurb),albwin_u(iurb),albr_u(iurb),       &
-     	           emr_u(iurb),emw_u(iurb),emwind_u(iurb),rsw,rlw,r,cp_u,       &
-     	           da_u,tmp_u,qv_u,pr_u,rs,rld,dzw,csw,alaw,pwin_u(iurb),       &
-                   cop_u(iurb),beta_u(iurb),sw_cond_u(iurb),time_on_u(iurb),    &
-                   time_off_u(iurb),targtemp_u(iurb),gaptemp_u(iurb),           &
-                   targhum_u(iurb),gaphum_u(iurb),perflo_u(iurb),hsesf_u(iurb), &
-                   hsequip,                                                     &
-     	           dzf,csf,alaf,dzgb,csgb,alagb,dzr,csr,                        &
-     	           alar,tlevb1D,qlevb1D,twb1D,twlevb1D,tflevb1D,tglevb1D,       &
-     	           trb1D,sflev1D,lflev1D,consumlev1D,sfvlev1D,lfvlev1D)
-                    
+          enddo
+       
+         !print*,'nz_um',nz_um
+         !print*,'nlev(ibui)',nlev(ibui)
+         !print*,'nhourday',nhourday
+         !print*,'dt',dt
+         !print*, 'bs_u(1,iurb)',bs_u(1,iurb)
+         !print*, 'bs_u(2,iurb)',bs_u(2,iurb)
+         !print*, 'dz_u',dz_u
+         !print*, 'nwr_u',nwr_u
+         !print*, 'nf_u',nf_u
+         !print*, 'nwr_u', nwr_u
+         !print*, 'ngb_u',ngb_u
+         !print*, 'sfwb1D',sfwb1D
+         !print*, 'gfwb1D',gfwb1D
+         !print*, 'sfwinb1D',sfwinb1D
+         !print*, 'sfrb(1,ibui)',sfrb(1,ibui)
+         !print*, 'gfrb(1,ibui)',gfrb(1,ibui)
+         !print*, 'latent',latent
+         !print*,  'sigma',sigma
+         !print*, 'albw_u(iurb)',albw
+         !print*, 'albwin_u(iurb)',albwin
+         !print*, 'albr_u(iurb)',albr
+         !print*, 'emr_u(iurb)',emr
+         !print*, 'emw_u(iurb)',emw
+         !print*, 'emwind_u(iurb)',emwind
+         !print*, 'rsw',rsw
+         !print*, 'rlw',rlw
+         !print*, 'r',r
+         !print*, 'cp_u',cp_u
+         !print*, 'da_u',da_u
+         !print*, 'tmp_u',tmp_u
+         !print*, 'qv_u',qv_u
+         !print*, 'pr_u',pr_u
+         !print*, 'rs',rs
+         !print*, 'rld',rld
+         !print*, 'dzw',dzw
+         !print*, 'csw',csw
+         !print*, 'alaw',alaw
+         !print*, 'pwin_u',pwin_u
+         !print*, 'cop_u(iurb)',cop_u(iurb)
+         !print*, 'beta_u(iurb)',beta_u(iurb)
+         !print*, 'sw_cond_u(iurb)',sw_cond_u(iurb)
+         !print*, 'time_on_u(iurb)',time_on_u(iurb)
+         !print*, 'time_off_u(iurb)',time_off_u(iurb)
+         !print*, 'targtemp_u(iurb)',targtemp_u(iurb)
+         !print*, 'gaptemp_u(iurb)',gaptemp_u(iurb)
+         !print*, 'targhum_u(iurb)',targhum_u(iurb)
+         !print*, 'gaphum_u(iurb)',gaphum_u(iurb)
+         !print*, 'perflo_u(iurb)',perflo_u(iurb)
+         !print*, 'hsesf_u(iurb)',hsesf_u(iurb)
+         !print*, 'hsequip',hsequip
+         !print*, 'dzf',dzf
+         !print*, 'csf',csf
+         !print*, 'alaf',alaf
+         !print*, 'dzgb',dzgb
+         !print*, 'csgb',csgb
+         !print*, 'alagb',alagb
+         !print*, 'dzr',dzr
+         !print*, 'csr',csr
+         !print*, 'alar',alar
+         !print*, 'tlevb1D',tlevb1D
+         !print*, 'qlevb1D',qlevb1D
+         !print*, 'twb1D',twb1D
+         !print*, 'twlevb1D',twlevb1D
+         !print*, 'tflevb1D',tflevb1D
+         !print*, 'tglevb1D',tglevb1D
+         !print*, 'trb1D',trb1D
+         !print*, 'sflev1D',sflev1D
+         !print*, 'lflev1D',lflev1D
+         !print*, 'consumlev1D',consumlev1D
+         !print*, 'sfvlev1D',sfvlev1D
+         !print*, 'lfvlev1D',lfvlev1D
+
+
+
+
+     
+         
+          call BEM(nz_um,nlev(ibui),nhourday,dt,bs_u(1,iurb),                &
+                   bs_u(2,iurb),dz_u,nwr_u,nf_u,nwr_u,ngb_u,sfwb1D,gfwb1D,   &
+                   sfwinb1D,sfrb(1,ibui),gfrb(1,ibui),                       &
+                   latent,sigma,albw,albwin,albr,                            &
+     	           emr,emw,emwind,rsw,rlw,r,cp_u,                            &
+     	           da_u,tmp_u,qv_u,pr_u,rs,rld,dzw,csw,alaw,pwin_u(iurb),    &
+                   cop_u(iurb),beta_u(iurb),sw_cond_u(iurb),time_on_u(iurb), &
+                   time_off_u(iurb),targtemp_u(iurb),gaptemp_u(iurb),        &
+                   targhum_u(iurb),gaphum_u(iurb),perflo_u(iurb),            &
+                   hsesf_u(iurb),hsequip,                                    &
+     	           dzf,csf,alaf,dzgb,csgb,alagb,dzr,csr,                     &
+     	           alar,tlevb1D,qlevb1D,twb1D,twlevb1D,tflevb1D,tglevb1D,    &
+     	           trb1D,sflev1D,lflev1D,consumlev1D,sfvlev1D,lfvlev1D)      
+
+         !print*,'nz_um A',nz_um
+         !print*,'nlev(ibui) A',nlev(ibui)
+         !print*,'nhourday A',nhourday
+         !print*,'dt A',dt
+         !print*, 'bs_u(1,iurb) A',bs_u(1,iurb)
+         !print*, 'bs_u(2,iurb) A',bs_u(2,iurb)
+         !print*, 'dz_u A',dz_u
+         !print*, 'nwr_u A',nwr_u
+         !print*, 'nf_u A',nf_u
+         !print*, 'nwr_u A', nwr_u
+         !print*, 'ngb_u A',ngb_u
+         !print*, 'sfwb1D A',sfwb1D
+         !print*, 'gfwb1D A',gfwb1D
+         !print*, 'sfwinb1D A',sfwinb1D
+         !print*, 'sfrb(1,ibui) A',sfrb(1,ibui)
+         !print*, 'gfrb(1,ibui) A',gfrb(1,ibui)
+         !print*, 'latent A',latent
+         !print*,  'sigma A',sigma
+         !print*, 'albw_u(iurb) A',albw
+         !print*, 'albwin_u(iurb) A',albwin
+         !print*, 'albr_u(iurb) A',albr
+         !print*, 'emr_u(iurb) A',emr
+         !print*, 'emw_u(iurb) A',emw
+         !print*, 'emwind_u(iurb) A',emwind
+         !print*, 'rsw A',rsw
+         !print*, 'rlw A',rlw
+         !print*, 'r A',r
+         !print*, 'cp_u A',cp_u
+         !print*, 'da_u A',da_u
+         !print*, 'tmp_u A',tmp_u
+         !print*, 'qv_u A',qv_u
+         !print*, 'pr_u A',pr_u
+         !print*, 'rs A',rs
+         !print*, 'rld A',rld
+         !print*, 'dzw A',dzw
+         !print*, 'csw A',csw
+         !print*, 'alaw A',alaw
+         !print*, 'pwin_u A',pwin_u
+         !print*, 'cop_u(iurb) A',cop_u(iurb)
+         !print*, 'beta_u(iurb) A',beta_u(iurb)
+         !print*, 'sw_cond_u(iurb) A',sw_cond_u(iurb)
+         !print*, 'time_on_u(iurb) A',time_on_u(iurb)
+         !!print*, 'time_off_u(iurb) A',time_off_u(iurb)
+         !print*, 'targtemp_u(iurb) A',targtemp_u(iurb)
+         !print*, 'gaptemp_u(iurb) A ',gaptemp_u(iurb)
+         !print*, 'targhum_u(iurb) A ',targhum_u(iurb)
+         !print*, 'gaphum_u(iurb) A',gaphum_u(iurb)
+         !print*, 'perflo_u(iurb) A',perflo_u(iurb)
+         !print*, 'hsesf_u(iurb) A',hsesf_u(iurb)
+         !print*, 'hsequip A',hsequip
+         !print*, 'dzf A',dzf
+         !print*, 'csf A',csf
+         !print*, 'alaf A',alaf
+         !print*, 'dzgb A',dzgb
+         !print*, 'csgb A',csgb
+         !print*, 'alagb A',alagb
+         !print*, 'dzr A',dzr
+         !print*, 'csr A',csr
+         !print*, 'alar A',alar
+         !print*, 'tlevb1D A',tlevb1D
+         !print*, 'qlevb1D A',qlevb1D
+         !print*, 'twb1D A',twb1D
+         !print*, 'twlevb1D A',twlevb1D
+         !print*, 'tflevb1D A',tflevb1D
+         !print*, 'tglevb1D A',tglevb1D
+         !print*, 'trb1D A',trb1D
+         !print*, 'sflev1D A',sflev1D
+         !print*, 'lflev1D A',lflev1D
+         !print*, 'consumlev1D A',consumlev1D
+         !print*, 'sfvlev1D A',sfvlev1D
+         !print*, 'lfvlev1D A',lfvlev1D
+
         
 !
 !Temporal modifications
@@ -1385,12 +1646,18 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,   &
               enddo
               enddo
            
+!!            do iz=1,nz_um
+!!               sfwin(2*id-1,iz,ibui)=sfwinb1D(2*id-1,iz)
+!!               sfwin(2*id,iz,ibui)=sfwinb1D(2*id,iz)
+!!            enddo
 
              do iz=1,nz_um
                 do ily=1,nwr_u
                    tw(2*id-1,iz,ily,ibui)=twb1D(2*id-1,ily,iz)
                    tw(2*id,iz,ily,ibui)=twb1D(2*id,ily,iz)
                 enddo
+!!              sfw(2*id-1,iz,ibui)=sfwb1D(2*id-1,iz)
+!!              sfw(2*id,iz,ibui)=sfwb1D(2*id,iz)
                 gfw(2*id-1,iz,ibui)=gfwb1D(2*id-1,iz)
                 gfw(2*id,iz,ibui)=gfwb1D(2*id,iz)
                 twlev(2*id-1,iz,ibui)=twlevb1D(2*id-1,iz)
@@ -1398,15 +1665,17 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,   &
              enddo
            enddo       
 
-        enddo !ibui     
-
+        enddo !ibui   
+        
 !-----------------------------------------------------------------------------
 !End loop over BEM -----------------------------------------------------------
 !-----------------------------------------------------------------------------
 !-----------------------------------------------------------------------------
 
        ibui=0
-       do iz=1,nz_um		   
+
+       do iz=1,nz_um	
+	   
          if(ss(iz).gt.0) then		
            ibui=ibui+1	
            do id=1,ndm	
@@ -1421,7 +1690,7 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,   &
        enddo !iz
 
 !Compute the potential temperature for the vertical surfaces of the buildings
-      
+
        do id=1,ndm
           do iz=1,nz_um
              do ibui=1,nbui
@@ -1433,43 +1702,44 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0,   &
           enddo
        enddo
              
+        
 ! Compute the implicit and explicit components of the sources or sinks on the "urban grid"
      
-      call buildings(iurb,nd_u(iurb),nz_u(iurb),z0,ua_u,va_u,                 & 
+      call buildings(iurb,ndu,nzu,z0,ua_u,va_u,                               & 
                      pt_u,pt0_u,ptg,ptr,da_u,ptw,ptwin,pwin_u(iurb),drst,     &                      
                      uva_u,vva_u,uvb_u,vvb_u,tva_u,tvb_u,evb_u,qvb_u,qhb_u,   & 
                      uhb_u,vhb_u,thb_u,ehb_u,ss,dt,sfw,sfg,sfr,               &
                      sfwin,pb,bs_u,dz_u,sflev,lflev,sfvlev,lfvlev,tvb_ac)  
-     
+      
 ! Calculation of the sensible heat fluxes for the ground, the wall and roof
 ! Sensible Heat Flux = density * Cp_U * ( A* potential temperature + B )
 ! where A and B are the implicit and explicit components of the heat sources or sinks.
-
       
 ! Interpolation on the "mesoscale grid"
 
-      call urban_meso(nd_u(iurb),kms,kme,kts,kte,nz_u(iurb),z,dz,z_u,pb,ss,bs,ws,sf, & 
-                     vl,uva_u,vva_u,uvb_u,vvb_u,tva_u,tvb_u,evb_u,                   &
-                     uhb_u,vhb_u,thb_u,ehb_u,qhb_u,qvb_u,                            &
+      call urban_meso(ndu,kms,kme,kts,kte,nzu,z,dz,z_u,pb,ss,bs,ws,sf, & 
+                     vl,uva_u,vva_u,uvb_u,vvb_u,tva_u,tvb_u,evb_u,     &
+                     uhb_u,vhb_u,thb_u,ehb_u,qhb_u,qvb_u,              &
                      a_u,a_v,a_t,a_e,b_u,b_v,b_t,b_e,b_q,tvb_ac,b_ac)                    
        
 
 ! Calculation of the length scale taking into account the buildings effects
 
-      call interp_length(nd_u(iurb),kms,kme,kts,kte,nz_u(iurb),z_u,z,ss,ws,bs,dlg,dl_u)
-
+      call interp_length(ndu,kms,kme,kts,kte,nzu,z_u,z,ss,ws,bs,dlg,dl_u)
+      
       return
       end subroutine BEP1D
 
 ! ===6=8===============================================================72
 ! ===6=8===============================================================72
 
-       subroutine param(iurb,nz,nd,                                   &
+       subroutine param(iurb,nzu,nzurb,nzurban,ndu,                   &
                        csg_u,csg,alag_u,alag,csr_u,csr,               &
                        alar_u,alar,csw_u,csw,alaw_u,alaw,             &
-                       ws_u,ws,bs_u,bs,z0g_u,z0r_u,z0,                &  
-                       strd_u,strd,drst_u,drst,ss_u,ss,pb_u,pb,       &
-                       dzw,dzr,dzf,csf,alaf,dzgb,csgb,alagb)        
+                       ws_u,ws_urb,ws,bs_u,bs_urb,bs,z0g_u,z0r_u,z0,  &  
+                       strd_u,strd,drst_u,drst,ss_u,ss_urb,ss,pb_u,   &
+                       pb_urb,pb,dzw,dzr,dzf,csf,alaf,dzgb,csgb,alagb,&
+                       lp_urb,lb_urb,hgt_urb,frc_urb)        
 
 ! ----------------------------------------------------------------------
 !    This routine prepare some usefull parameters       
@@ -1482,8 +1752,9 @@ subroutine param(iurb,nz,nd,                                   &
 ! INPUT:
 ! ----------------------------------------------------------------------
       integer iurb                 ! Current urban class
-      integer nz                   ! Number of vertical urban levels in the current class
-      integer nd                   ! Number of street direction for the current urban class
+      integer nzu                  ! Number of vertical urban levels in the current class
+      integer ndu                  ! Number of street direction for the current urban class
+      integer nzurb                ! Number of vertical urban levels in the current class
       real alag_u(nurbm)           ! Ground thermal diffusivity [m^2 s^-1]
       real alar_u(nurbm)           ! Roof thermal diffusivity [m^2 s^-1]
       real alaw_u(nurbm)           ! Wall thermal diffusivity [m^2 s^-1]
@@ -1498,7 +1769,10 @@ subroutine param(iurb,nz,nd,                                   &
       real z0r_u(nurbm)            ! The roof's roughness length
       real ss_u(nz_um,nurbm)       ! The probability that a building has an height equal to "z"
       real pb_u(nz_um,nurbm)       ! The probability that a building has an height greater or equal to "z"
-     
+      real lp_urb                ! Building plan area density
+      real lb_urb                ! Building surface area to plan area ratio
+      real hgt_urb               ! Average building height weighted by building plan area [m]
+      real frc_urb               ! Urban fraction
 
 ! ----------------------------------------------------------------------
 ! OUTPUT:
@@ -1512,6 +1786,7 @@ subroutine param(iurb,nz,nd,                                   &
       real z0(ndm,nz_um)      ! Roughness lengths "profiles"
       real ss(nz_um)          ! Probability to have a building with height h
       real pb(nz_um)          ! Probability to have a building with an height greater or equal to "z"
+      integer nzurban
 
 !-----------------------------------------------------------------------------
 !INPUT/OUTPUT
@@ -1533,19 +1808,28 @@ subroutine param(iurb,nz,nd,                                   &
       real alaw(nwr_u+1)    ! Wall thermal diffusivity at each wall levels [W/ m K]
       real alaf(nf_u+1)     ! Floor thermal diffusivity at each wall levels [W/m K]
       real alagb(ngb_u+1)   ! Ground thermal diffusivity below the building at each wall levels [W/m K]
+      real bs_urb(ndm,nurbm)         ! Building width
+      real ws_urb(ndm,nurbm)         ! Street width
+      real ss_urb(nz_um,nurbm)       ! The probability that a building has an height equal to "z"
+      real pb_urb(nz_um)             ! Probability that a building has an height greater or equal to z
 ! ----------------------------------------------------------------------
 ! LOCAL:
 ! ----------------------------------------------------------------------
-      integer id,ig,ir,iw,iz,iflo
+      integer id,ig,ir,iw,iz,iflo,ihu
 ! ----------------------------------------------------------------------
 ! END VARIABLES DEFINITIONS
 ! ----------------------------------------------------------------------  
-!Define the layer sizes in the walls
-        
+!
+!Initialize variables
+!
       ss=0.
       pb=0.
       csg=0.
       alag=0.
+      csgb=0.
+      alagb=0.
+      csf=0.
+      alaf=0.
       csr=0.
       alar=0.
       csw=0.
@@ -1553,24 +1837,52 @@ subroutine param(iurb,nz,nd,                                   &
       z0=0.
       ws=0.
       bs=0.
+      bs_urb=0.
+      ws_urb=0.
       strd=0.
       drst=0.
-      csgb=0.
-      alagb=0.
-      csf=0.
-      alaf=0.
- 
+      nzurban=0
+
+!Define the layer sizes in the walls
+
       dzgb=(/0.2,0.12,0.08,0.05,0.03,0.02,0.02,0.01,0.005,0.0025/)
       dzr=(/0.02,0.02,0.02,0.02,0.02,0.02,0.02,0.01,0.005,0.0025/)   
       dzw=(/0.02,0.02,0.02,0.02,0.02,0.02,0.02,0.01,0.005,0.0025/)
-      dzf=(/0.02,0.02,0.02,0.02,0.02,0.02,0.02,0.02,0.02,0.02/)   
+      dzf=(/0.02,0.02,0.02,0.02,0.02,0.02,0.02,0.02,0.02,0.02/) 
+  
+       ihu=0
+
+       do iz=1,nz_um
+          if (ss_urb(iz,iurb)/=0.) then
+             ihu=1
+             exit
+          else
+             continue
+          endif
+       enddo
+
+       if (ihu==1) then
+          do iz=1,nzurb+1
+             ss(iz)=ss_urb(iz,iurb)
+             pb(iz)=pb_urb(iz)
+          enddo
+          nzurban=nzurb
+       else
+          do iz=1,nzu+1
+             ss(iz)=ss_u(iz,iurb)
+             pb(iz)=pb_u(iz,iurb)
+             ss_urb(iz,iurb)=ss_u(iz,iurb)
+             pb_urb(iz)=pb_u(iz,iurb)
+          end do 
+          nzurban=nzu
+       endif
       
       do ig=1,ngb_u
         csgb(ig) = csg_u(iurb)
         alagb(ig)= csg_u(iurb)*alag_u(iurb)
       enddo
       alagb(ngb_u+1)= csg_u(iurb)*alag_u(iurb)
-      
+
       do iflo=1,nf_u
         csf(iflo) = csw_u(iurb)
         alaf(iflo)= csw_u(iurb)*alaw_u(iurb) 
@@ -1590,32 +1902,60 @@ subroutine param(iurb,nz,nd,                                   &
       alaw(nwr_u+1)=csw_u(iurb)*alaw_u(iurb) 
 
 !------------------------------------------------------------------------  
-        
-      do iz=1,nz+1
-         ss(iz)=ss_u(iz,iurb)
-         pb(iz)=pb_u(iz,iurb)
-      end do
                  
        do ig=1,ng_u
         csg(ig)=csg_u(iurb)
         alag(ig)=alag_u(iurb)
        enddo
        
-       do id=1,nd
-        z0(id,1)=z0g_u(iurb)
-        do iz=2,nz+1
-         z0(id,iz)=z0r_u(iurb)
+       do id=1,ndu
+          z0(id,1)=z0g_u(iurb)
+        do iz=2,nzurban+1
+           z0(id,iz)=z0r_u(iurb)
         enddo
        enddo
       
-       do id=1,nd
-        ws(id)=ws_u(id,iurb)
-        bs(id)=bs_u(id,iurb)
-        strd(id)=strd_u(id,iurb)
-        drst(id)=drst_u(id,iurb)     
+       do id=1,ndu
+          strd(id)=strd_u(id,iurb)
+          drst(id)=drst_u(id,iurb)     
        enddo
 
-       
+       do id=1,ndu
+          if ((hgt_urb<=0.).OR.(lp_urb<=0.).OR.(lb_urb<=0.)) then
+              ws(id)=ws_u(id,iurb)
+              bs(id)=bs_u(id,iurb)
+              bs_urb(id,iurb)=bs_u(id,iurb)
+              ws_urb(id,iurb)=ws_u(id,iurb)
+          else if ((lp_urb/frc_urb<1.).and.(lp_urb<lb_urb)) then
+                  bs(id)=2.*hgt_urb*lp_urb/(lb_urb-lp_urb)
+                  ws(id)=2.*hgt_urb*lp_urb*((frc_urb/lp_urb)-1.)/(lb_urb-lp_urb)
+                  bs_urb(id,iurb)=bs(id)
+                  ws_urb(id,iurb)=ws(id)
+               else
+                  ws(id)=ws_u(id,iurb)
+                  bs(id)=bs_u(id,iurb)
+                  bs_urb(id,iurb)=bs_u(id,iurb)
+                  ws_urb(id,iurb)=ws_u(id,iurb)
+          endif
+       enddo
+       do id=1,ndu
+          if ((bs(id)<=1.).OR.(bs(id)>=150.)) then
+!            write(*,*) 'WARNING, WIDTH OF THE BUILDING WRONG',id,bs(id)
+!            write(*,*) 'WIDTH OF THE STREET',id,ws(id)
+             bs(id)=bs_u(id,iurb)
+             ws(id)=ws_u(id,iurb)
+             bs_urb(id,iurb)=bs_u(id,iurb)
+             ws_urb(id,iurb)=ws_u(id,iurb)
+          endif
+          if ((ws(id)<=1.).OR.(ws(id)>=150.)) then
+!            write(*,*) 'WARNING, WIDTH OF THE STREET WRONG',id,ws(id)
+!            write(*,*) 'WIDTH OF THE BUILDING',id,bs(id)
+             ws(id)=ws_u(id,iurb)
+             bs(id)=bs_u(id,iurb)
+             bs_urb(id,iurb)=bs_u(id,iurb)
+             ws_urb(id,iurb)=ws_u(id,iurb)
+          endif
+       enddo
        return
        end subroutine param
        
@@ -1642,12 +1982,15 @@ subroutine interpol(kms,kme,kts,kte,nz_u,z,z_u,c,c_u)
       real c(kms:kme)            ! Parameter which has to be interpolated
 ! Data relative to the "urban grid"
       integer nz_u          ! Number of levels
+!!    real z_u(nz_u+1)      ! Altitude of the cell interface
       real z_u(nz_um)      ! Altitude of the cell interface
+
 ! ----------------------------------------------------------------------
 ! OUTPUT:
 ! ----------------------------------------------------------------------
-      real c_u(nz_um)        ! Interpolated paramters in the "urban grid"
-       
+!!    real c_u(nz_u)        ! Interpolated paramters in the "urban grid"
+      real c_u(nz_um)        ! Interpolated paramters in the "urban grid"      
+ 
 ! LOCAL:
 ! ----------------------------------------------------------------------
       integer iz_u,iz
@@ -1672,7 +2015,7 @@ end subroutine interpol
 ! ===6=8===============================================================72       
 ! ===6=8===============================================================72    
 
-      subroutine  averaging_temp(tw,twlev,ss,pb,tw_av,twlev_av,&
+      subroutine  averaging_temp(tw,twlev,ss,pb,tw_av,twlev_av,       &
                                  sfw_av,sfwind_av,sfw,sfwin) 
 
       implicit none
@@ -1719,7 +2062,7 @@ subroutine  averaging_temp(tw,twlev,ss,pb,tw_av,twlev_av,&
            nbui=ibui		               
          endif
       enddo
-
+      
       do id=1,ndm
          do iz=1,nz_um-1
             if (pb(iz+1).gt.0) then
@@ -1818,8 +2161,8 @@ subroutine modif_rad(iurb,nd,nz_u,z,ws,drst,strd,ss,pb,    &
 
 !  Calculation of the shadow effects
 
-      call shadow_mas(nd,nz_u,zr,deltar,ah,drst,ws,ss,pb,z,  &
-                      rs,rsw,rsg)
+      call shadow_mas(nd,nz_u,zr,deltar,ah,drst,ws,ss,pb,z,        &
+                     rs,rsw,rsg)
 
 ! Calculation of the reflection effects          
       do id=1,nd
@@ -1838,7 +2181,7 @@ end subroutine modif_rad
 ! ===6=8===============================================================72  
 ! ===6=8===============================================================72     
 
-      subroutine surf_temp(nd,pr,dt,rl,rsg,rlg,  &
+      subroutine surf_temp(nd,pr,dt,rl,rsg,rlg,              &
                            tg,alag,csg,emg,albg,ptg,sfg,gfg) 
 
 ! ----------------------------------------------------------------------
@@ -1850,7 +2193,7 @@ subroutine surf_temp(nd,pr,dt,rl,rsg,rlg,  &
 ! ----------------------------------------------------------------------
 ! INPUT:
 ! ----------------------------------------------------------------------
-      
+
       integer nd                ! Number of street direction for the current urban class
       real alag(ng_u)           ! Ground thermal diffusivity for the current urban class [m^2 s^-1] 
 
@@ -1862,23 +2205,23 @@ subroutine surf_temp(nd,pr,dt,rl,rsg,rlg,  &
       real emg                  ! Emissivity of ground for the current urban class
 
       real pr(nz_um)            ! Air pressure
+      
       real rl                   ! Downward flux of the longwave radiation
       real rlg(ndm)             ! Long wave radiation at the ground
+     
       real rsg(ndm)             ! Short wave radiation at the ground
+      
       real sfg(ndm)             ! Sensible heat flux from ground (road)
 
       real gfg(ndm)             ! Heat flux transferred from the surface of the ground (road) toward the interior
 
       real tg(ndm,ng_u)         ! Temperature in each layer of the ground [K]
 
-      
-
 ! ----------------------------------------------------------------------
 ! OUTPUT:
 ! ----------------------------------------------------------------------
       real ptg(ndm)             ! Ground potential temperatures 
 
-
 ! ----------------------------------------------------------------------
 ! LOCAL:
 ! ----------------------------------------------------------------------
@@ -1888,7 +2231,6 @@ subroutine surf_temp(nd,pr,dt,rl,rsg,rlg,  &
 
       real tg_tmp(ng_u)
 
-
       real dzg_u(ng_u)          ! Layer sizes in the ground
       
       data dzg_u /0.2,0.12,0.08,0.05,0.03,0.02,0.02,0.01,0.005,0.0025/
@@ -2040,10 +2382,7 @@ subroutine buildings(iurb,nd,nz,z0,ua_u,va_u,pt_u,pt0_u,       &
            nbui=ibui		               
          endif
       enddo
-      if (nbui.gt.nbui_max) then
-         write(*,*) 'nbui_max must be increased to',nbui
-         stop
-      endif
+
       do id=1,nd
 
 !        Calculation at the ground surfaces
@@ -2360,7 +2699,7 @@ end subroutine urban_meso
 ! ===6=8===============================================================72 
 ! ===6=8===============================================================72 
 
-      subroutine interp_length(nd,kms,kme,kts,kte,nz_u,z_u,z,ss,ws,bs, &
+      subroutine interp_length(nd,kms,kme,kts,kte,nz_u,z_u,z,ss,ws,bs,              &
                              dlg,dl_u)
 
 ! ----------------------------------------------------------------------     
@@ -2524,18 +2863,18 @@ subroutine shadow_mas(nd,nz_u,zr,deltar,ah,drst,ws,ss,pb,z,    &
             do iz=1,nz_u
                rsw(2*id-1,iz)=0.
                rsw(2*id,iz)=0.          
-            if (pb(iz+1).gt.0.) then          
+            if(pb(iz+1).gt.0.)then          
                do jz=1,nz_u                    
                 if(abs(sin(aae)).gt.1.e-10)then
                   call shade_wall(z(iz),z(iz+1),z(jz+1),phix,aae,   &    
                       ws(id),rd)                  
-                 rsw(2*id-1,iz)=rsw(2*id-1,iz)+rs*rd*ss(jz+1)/pb(iz+1)
+                  rsw(2*id-1,iz)=rsw(2*id-1,iz)+rs*rd*ss(jz+1)/pb(iz+1)
                 endif
               
                 if(abs(sin(aaw)).gt.1.e-10)then
                   call shade_wall(z(iz),z(iz+1),z(jz+1),phix,aaw,   &    
                       ws(id),rd)
-                 rsw(2*id,iz)=rsw(2*id,iz)+rs*rd*ss(jz+1)/pb(iz+1)                  
+                  rsw(2*id,iz)=rsw(2*id,iz)+rs*rd*ss(jz+1)/pb(iz+1)                  
                 endif
                enddo             
             endif  
@@ -2696,6 +3035,7 @@ subroutine long_rad(iurb,nz_u,id,emw,emg,emwin,pwin,twlev,&
                   fww(j-nz_u,i,id,iurb)*pb(j-nz_u+1)
         enddo
         
+!!      aaa(i,2*nz_u+1)=-(1.-emg)*fgw(i,id,iurb)*pb(i+1)
         aaa(i,2*nz_u+1)=-(1.-emg)*fgw(i,id,iurb)
         
         bbb(i)=fsw(i,id,iurb)*rl+emg*fgw(i,id,iurb)*sigma*tg(id,ng_u)**4
@@ -2721,6 +3061,7 @@ subroutine long_rad(iurb,nz_u,id,emw,emg,emwin,pwin,twlev,&
         
         aaa(i,i)=1.
         
+!!      aaa(i,2*nz_u+1)=-(1.-emg)*fgw(i-nz_u,id,iurb)*pb(i-nz_u+1)
         aaa(i,2*nz_u+1)=-(1.-emg)*fgw(i-nz_u,id,iurb)
         
         bbb(i)=fsw(i-nz_u,id,iurb)*rl+  &     
@@ -2967,7 +3308,7 @@ subroutine gaussj(a,n,b,np)
          endif
          
          if(a(icol,icol).eq.0) FATAL_ERROR('singular matrix in gaussj')
-         
+ 
          pivinv=1./a(icol,icol)
          a(icol,icol)=1
          
@@ -3058,6 +3399,7 @@ subroutine soil_temp(nz,dz,temp,pt,ala,cs,                       &
       do iz=2,nz
          cddz(iz)=2.*ala(iz)/(dz(iz)+dz(iz-1))
       enddo
+!        cddz(nz+1)=ala(nz+1)/dz(nz)
        
       a(1,1)=0.
       a(1,2)=1.
@@ -3084,6 +3426,7 @@ subroutine soil_temp(nz,dz,temp,pt,ala,cs,                       &
 
       rt=(1.-alb)*rs+em*rl-em*sigma*(tsig**4)
                         
+!      gf=-cddz(nz)*(temp(nz)-temp(nz-1))*cs(nz)
        gf=(1.-alb)*rs+em*rl-em*sigma*(tsig**4)+sf                                   
       return
       end subroutine soil_temp
@@ -3174,8 +3517,8 @@ subroutine flux_wall(ua,va,pt,da,ptw,ptwin,uva,vva,uvb,vvb,  &
       real uvb                  ! U (wind component)   Vertical surfaces, B (explicit) term
       real vva                  ! V (wind component)   Vertical surfaces, A (implicit) term
       real vvb                  ! V (wind component)   Vertical surfaces, B (explicit) term
-!     real tva                  ! Temperature          Vertical surfaces, A (implicit) term
-!     real tvb                  ! Temperature          Vertical surfaces, B (explicit) term
+      real tva                  ! Temperature          Vertical surfaces, A (implicit) term
+      real tvb                  ! Temperature          Vertical surfaces, B (explicit) term
       real evb                  ! Energy (TKE)         Vertical surfaces, B (explicit) term
       real sfw                  ! Surfaces fluxes from the walls
       real sfwin                ! Surfaces fluxes from the windows
@@ -3270,8 +3613,8 @@ subroutine flux_flat(dz,z0,ua,va,pt,pt0,ptg,                     &
       real uhb                  ! U (wind component) Horizontal surfaces, B (explicit) term
       real vhb                  ! V (wind component) Horizontal surfaces, B (explicit) term
 !     real thb                  ! Temperature        Horizontal surfaces, B (explicit) term
-!     real tva                  ! Temperature          Vertical surfaces, A (implicit) term
-!     real tvb                  ! Temperature          Vertical surfaces, B (explicit) term
+      real tva                  ! Temperature          Vertical surfaces, A (implicit) term
+      real tvb                  ! Temperature          Vertical surfaces, B (explicit) term
       real ehb                  ! Energy (TKE)       Horizontal surfaces, B (explicit) term
       real sf
 
@@ -3313,6 +3656,13 @@ subroutine flux_flat(dz,z0,ua,va,pt,pt0,ptg,                     &
 
       zz=dz/2.
    
+!        if(tstar.lt.0.)then
+!         wstar=(-ustar*tstar*g*hii/pt)**(1./3.)
+!        else
+!         wstar=0.
+!        endif
+!        
+!      if (utot.le.0.7*wstar) utot=max(0.7*wstar,0.00001)
 
       utot=max(utot,0.01)
           
@@ -3356,47 +3706,18 @@ end subroutine flux_flat
 ! ===6=8===============================================================72
 ! ===6=8===============================================================72
 
-      subroutine icBEP (fww,fwg,fgw,fsw,fws,fsg,                       &
-                       z0g_u,z0r_u,                                    &
-                       nd_u,strd_u,ws_u,bs_u,h_b,d_b,ss_u,pb_u,        &
-                       nz_u,z_u)                               
-
+      subroutine icBEP (nd_u,h_b,d_b,ss_u,pb_u,nz_u,z_u)                               
 
-      implicit none 
-      
-   
-!    Building parameters      
-
-!    Radiation parameters
-
-!    Roughness parameters
-      real z0g_u(nurbm)       ! The ground's roughness length      
-      real z0r_u(nurbm)       ! The roof's roughness length     
+      implicit none     
 
 !    Street parameters
       integer nd_u(nurbm)     ! Number of street direction for each urban class
-
-      real strd_u(ndm,nurbm)  ! Street length (fix to greater value to the horizontal length of the cells)
-      real ws_u(ndm,nurbm)    ! Street width [m]
-      real bs_u(ndm,nurbm)    ! Building width [m]
       real h_b(nz_um,nurbm)   ! Bulding's heights [m]
       real d_b(nz_um,nurbm)   ! The probability that a building has an height h_b
 ! -----------------------------------------------------------------------
 !     Output
 !------------------------------------------------------------------------
 
-
-
-!   fww,fwg,fgw,fsw,fsg are the view factors used to compute the long wave
-!   and the short wave radation. They are the part of radiation from a surface
-!   or from the sky to another surface.
-      real fww(nz_um,nz_um,ndm,nurbm)        !  from wall to wall
-      real fwg(nz_um,ndm,nurbm)              !  from wall to ground
-      real fgw(nz_um,ndm,nurbm)              !  from ground to wall
-      real fsw(nz_um,ndm,nurbm)              !  from sky to wall
-      real fws(nz_um,ndm,nurbm)              !  from wall to sky
-      real fsg(ndm,nurbm)                    !  from sky to ground
-
       real ss_u(nz_um,nurbm)     ! The probability that a building has an height equal to z
       real pb_u(nz_um,nurbm)     ! The probability that a building has an height greater or equal to z
         
@@ -3414,28 +3735,19 @@ subroutine icBEP (fww,fwg,fgw,fsw,fws,fsg,                       &
       real dtot
       real hbmax
 
-!------------------------------------------------------------------------
-     
-
 ! -----------------------------------------------------------------------
 !     This routine initialise the urban paramters for the BEP module
 !------------------------------------------------------------------------
 !
-!Initialize some variables
+!Initialize variables
 !
-       nz_u=0
-       z_u=0.    
-       ss_u=0.
-       pb_u=0.
-       fww=0.
-       fwg=0.
-       fgw=0.
-       fsw=0.
-       fws=0.
-       fsg=0.
+      nz_u=0
+      z_u=0.
+      ss_u=0.
+      pb_u=0.
 
 ! Computation of the urban levels height
-
+ 
       z_u(1)=0.
      
       do iz_u=1,nz_um-1
@@ -3472,10 +3784,6 @@ subroutine icBEP (fww,fwg,fgw,fsw,fws,fsg,                       &
 
          do id=1,nd_u(iurb)
 
-            call view_factors(iurb,nz_u(iurb),id,strd_u(id,iurb),   &    
-                            z_u,ws_u(id,iurb),                      &    
-                            fww,fwg,fgw,fsg,fsw,fws) 
-
             do iz_u=1,nz_u(iurb)
                ss_u(iz_u,iurb)=0.
                do ilu=1,nz_um
@@ -3728,9 +4036,9 @@ end subroutine fnrms
      
       SUBROUTINE init_para(alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,&
         twini_u,trini_u,tgini_u,albg_u,albw_u,albr_u,albwin_u,emg_u,emw_u,&
-        emr_u,emwind_u,z0g_u,z0r_u,nd_u,strd_u,drst_u,ws_u,bs_u,h_b,d_b, &
-        cop_u, pwin_u, beta_u, sw_cond_u, time_on_u, time_off_u, &
-        targtemp_u, gaptemp_u, targhum_u, gaphum_u, perflo_u, hsesf_u, hsequip)
+        emr_u,emwind_u,z0g_u,z0r_u,nd_u,strd_u,drst_u,ws_u,bs_u,h_b,d_b,  &
+        cop_u,pwin_u,beta_u,sw_cond_u,time_on_u,time_off_u,targtemp_u,    &
+        gaptemp_u, targhum_u,gaphum_u,perflo_u,hsesf_u,hsequip)
 
 ! initialization routine, where the variables from the table are read
 
@@ -3774,7 +4082,6 @@ SUBROUTINE init_para(alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,&
 
       integer i,iu
       integer nurb ! number of urban classes used
-
       real, intent(out) :: cop_u(nurbm)
       real, intent(out) :: pwin_u(nurbm)
       real, intent(out) :: beta_u(nurbm)
@@ -3790,10 +4097,11 @@ SUBROUTINE init_para(alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,&
       real, intent(out) :: hsequip(24)
 
 !
-!We initialize
-!
-        h_b=0.
-        d_b=0.
+!Initialize some variables
+!  
+     
+       h_b=0.
+       d_b=0.
 
        nurb=ICATE
        do iu=1,nurb                         
@@ -3820,7 +4128,7 @@ SUBROUTINE init_para(alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,&
        z0r_u=Z0R_TBL
        z0g_u=Z0G_TBL
        nd_u=NUMDIR_TBL
-!MT BEM
+!FS
        cop_u = cop_tbl
        pwin_u = pwin_tbl
        beta_u = beta_tbl
@@ -3837,7 +4145,7 @@ SUBROUTINE init_para(alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,&
 
        do iu=1,icate
               if(ndm.lt.nd_u(iu))then
-                write(*,*)'ndm too small in module_sf_bep, please increase to at least ', nd_u(iu)
+                write(*,*)'ndm too small in module_sf_bep_bem, please increase to at least ', nd_u(iu)
                 write(*,*)'remember also that num_urban_layers should be equal or greater than nz_um*ndm*nwr-u!'
                 stop
               endif
@@ -3872,13 +4180,16 @@ SUBROUTINE init_para(alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,&
        
        return
        end subroutine init_para
-! ===6================================================================72
-! ===6================================================================72
-      subroutine upward_rad(nd_u,nz_u,ws,bs,sigma,pb,ss,                     &
-                       tg,emg_u,albg_u,rlg,rsg,sfg,                          & 
-                       tw,emw_u,albw_u,rlw,rsw,sfw,                          & 
-                       tr,emr_u,albr_u,emwind,albwind,twlev,pwin,            &
-                       sfwind,rld,rs, sfr,                                   & 
+!==============================================================
+!==============================================================
+!====6=8===============================================================72         
+!====6=8===============================================================72 
+
+      subroutine upward_rad(ndu,nzu,ws,bs,sigma,pb,ss,                &
+                       tg,emg_u,albg_u,rlg,rsg,sfg,                   & 
+                       tw,emw_u,albw_u,rlw,rsw,sfw,                   & 
+                       tr,emr_u,albr_u,emwind,albwind,twlev,pwin,     &
+                       sfwind,rld,rs, sfr,                            & 
                        rs_abs,rl_up,emiss,grdflx_urb)
 !
 ! IN this surboutine we compute the upward longwave flux, and the albedo
@@ -3893,11 +4204,11 @@ subroutine upward_rad(nd_u,nz_u,ws,bs,sigma,pb,ss,                     &
       real rlw(2*ndm,nz_um)         ! Long wave radiation at the walls for a given canyon direction [W/m2]
       real rsg(ndm)                   ! Short wave radiation at the canyon for a given canyon direction [W/m2]
       real rlg(ndm)                   ! Long wave radiation at the ground for a given canyon direction [W/m2]
-      real rs                        ! Short wave radiation at the horizontal surface from the sun [W/m²]  
-      real sfw(2*ndm,nz_um)      ! Sensible heat flux from walls [W/m²]
-      real sfg(ndm)              ! Sensible heat flux from ground (road) [W/m²]
-      real sfr(ndm,nz_um)      ! Sensible heat flux from roofs [W/m²]                      
-      real rld                        ! Long wave radiation from the sky [W/m²]
+      real rs                        ! Short wave radiation at the horizontal surface from the sun [W/m2]  
+      real sfw(2*ndm,nz_um)      ! Sensible heat flux from walls [W/m2]
+      real sfg(ndm)              ! Sensible heat flux from ground (road) [W/m2]
+      real sfr(ndm,nz_um)      ! Sensible heat flux from roofs [W/m2]                      
+      real rld                        ! Long wave radiation from the sky [W/m2]
       real albg_u                    ! albedo of the ground/street
       real albw_u                    ! albedo of the walls
       real albr_u                    ! albedo of the roof 
@@ -3905,7 +4216,7 @@ subroutine upward_rad(nd_u,nz_u,ws,bs,sigma,pb,ss,                     &
       real bs(ndm)
                         ! building size
       real pb(nz_um)                ! Probability to have a building with an height equal or higher   
-      integer nz_u
+      integer nzu
       real ss(nz_um)                ! Probability to have a building of a given height
       real sigma                       
       real emg_u                       ! emissivity of the street
@@ -3915,7 +4226,7 @@ subroutine upward_rad(nd_u,nz_u,ws,bs,sigma,pb,ss,                     &
       real tr(ndm,nz_um,nwr_u)  ! Temperature in each layer of the roof [K]
       real tg(ndm,ng_u)          ! Temperature in each layer of the ground [K]
       integer id ! street direction
-      integer nd_u ! number of street directions
+      integer ndu ! number of street directions
 !
 !New variables BEM
 !
@@ -3924,7 +4235,7 @@ subroutine upward_rad(nd_u,nz_u,ws,bs,sigma,pb,ss,                     &
       real twlev(2*ndm,nz_um)   !Averaged Temperature of the windows 
       real pwin                 !Coverage area fraction of the windows
       real gflwin               !Heat stored for the windows
-      real sfwind(2*ndm,nz_um)  !Sensible heat flux from windows [W/m²]
+      real sfwind(2*ndm,nz_um)  !Sensible heat flux from windows [W/m2]
 
 !OUTPUT/INPUT
       real rs_abs  ! absrobed solar radiationfor this street direction
@@ -3938,8 +4249,8 @@ subroutine upward_rad(nd_u,nz_u,ws,bs,sigma,pb,ss,                     &
       integer ix,iy,iwrong
 
          iwrong=1
-      do iz=1,nz_u+1
-      do id=1,nd_u
+      do iz=1,nzu+1
+      do id=1,ndu
       do iw=1,nwr_u
         if(tr(id,iz,iw).lt.100.)then
               write(*,*)'in upward_rad ',iz,id,iw,tr(id,iz,iw) 
@@ -3957,32 +4268,32 @@ subroutine upward_rad(nd_u,nz_u,ws,bs,sigma,pb,ss,                     &
       emiss=0.
       rl_emit=0.
       grdflx_urb=0.
-      do id=1,nd_u          
-       rl_emit=rl_emit-( emg_u*sigma*(tg(id,ng_u)**4.)+(1-emg_u)*rlg(id))*ws(id)/(ws(id)+bs(id))/nd_u
-       rl_inc=rl_inc+rlg(id)*ws(id)/(ws(id)+bs(id))/nd_u       
-       rs_abs=rs_abs+(1.-albg_u)*rsg(id)*ws(id)/(ws(id)+bs(id))/nd_u
+      do id=1,ndu          
+       rl_emit=rl_emit-( emg_u*sigma*(tg(id,ng_u)**4.)+(1-emg_u)*rlg(id))*ws(id)/(ws(id)+bs(id))/ndu
+       rl_inc=rl_inc+rlg(id)*ws(id)/(ws(id)+bs(id))/ndu       
+       rs_abs=rs_abs+(1.-albg_u)*rsg(id)*ws(id)/(ws(id)+bs(id))/ndu
          gfl=(1.-albg_u)*rsg(id)+emg_u*rlg(id)-emg_u*sigma*(tg(id,ng_u)**4.)+sfg(id)
-         grdflx_urb=grdflx_urb-gfl*ws(id)/(ws(id)+bs(id))/nd_u  
+         grdflx_urb=grdflx_urb-gfl*ws(id)/(ws(id)+bs(id))/ndu  
  
-          do iz=2,nz_u
-            rl_emit=rl_emit-(emr_u*sigma*(tr(id,iz,nwr_u)**4.)+(1-emr_u)*rld)*ss(iz)*bs(id)/(ws(id)+bs(id))/nd_u
-            rl_inc=rl_inc+rld*ss(iz)*bs(id)/(ws(id)+bs(id))/nd_u            
-            rs_abs=rs_abs+(1.-albr_u)*rs*ss(iz)*bs(id)/(ws(id)+bs(id))/nd_u
+          do iz=2,nzu
+            rl_emit=rl_emit-(emr_u*sigma*(tr(id,iz,nwr_u)**4.)+(1-emr_u)*rld)*ss(iz)*bs(id)/(ws(id)+bs(id))/ndu
+            rl_inc=rl_inc+rld*ss(iz)*bs(id)/(ws(id)+bs(id))/ndu            
+            rs_abs=rs_abs+(1.-albr_u)*rs*ss(iz)*bs(id)/(ws(id)+bs(id))/ndu
             gfl=(1.-albr_u)*rs+emr_u*rld-emr_u*sigma*(tr(id,iz,nwr_u)**4.)+sfr(id,iz)
-            grdflx_urb=grdflx_urb-gfl*ss(iz)*bs(id)/(ws(id)+bs(id))/nd_u
+            grdflx_urb=grdflx_urb-gfl*ss(iz)*bs(id)/(ws(id)+bs(id))/ndu
          enddo
            
-         do iz=1,nz_u 
+         do iz=1,nzu 
            
             rl_emit=rl_emit-(emw_u*(1.-pwin)*sigma*(tw(2*id-1,iz)**4.+tw(2*id,iz)**4.)+ &
                             (emwind*pwin*sigma*(twlev(2*id-1,iz)**4.+twlev(2*id,iz)**4.))+ &
                 ((1.-emw_u)*(1.-pwin)+pwin*(1.-emwind))*(rlw(2*id-1,iz)+rlw(2*id,iz)))* &
-                            dz_u*pb(iz+1)/(ws(id)+bs(id))/nd_u
+                            dz_u*pb(iz+1)/(ws(id)+bs(id))/ndu
 
-            rl_inc=rl_inc+((rlw(2*id-1,iz)+rlw(2*id,iz)))*dz_u*pb(iz+1)/(ws(id)+bs(id))/nd_u
+            rl_inc=rl_inc+((rlw(2*id-1,iz)+rlw(2*id,iz)))*dz_u*pb(iz+1)/(ws(id)+bs(id))/ndu
 
             rs_abs=rs_abs+(((1.-albw_u)*(1.-pwin)+(1.-albwind)*pwin)*(rsw(2*id-1,iz)+rsw(2*id,iz)))*&
-                          dz_u*pb(iz+1)/(ws(id)+bs(id))/nd_u 
+                          dz_u*pb(iz+1)/(ws(id)+bs(id))/ndu 
 
             gfl=(1.-albw_u)*(rsw(2*id-1,iz)+rsw(2*id,iz)) +emw_u*( rlw(2*id-1,iz)+rlw(2*id,iz) )   &
              -emw_u*sigma*( tw(2*id-1,iz)**4.+tw(2*id,iz)**4. )+(sfw(2*id-1,iz)+sfw(2*id,iz))   
@@ -3991,7 +4302,7 @@ subroutine upward_rad(nd_u,nz_u,ws,bs,sigma,pb,ss,                     &
              -emwind*sigma*( twlev(2*id-1,iz)**4.+twlev(2*id,iz)**4.)+(sfwind(2*id-1,iz)+sfwind(2*id,iz)) 
                
            
-            grdflx_urb=grdflx_urb-(gfl*(1.-pwin)+pwin*gflwin)*dz_u*pb(iz+1)/(ws(id)+bs(id))/nd_u
+            grdflx_urb=grdflx_urb-(gfl*(1.-pwin)+pwin*gflwin)*dz_u*pb(iz+1)/(ws(id)+bs(id))/ndu
 
          enddo
           
@@ -4105,4 +4416,184 @@ subroutine foncs(fonc,x,aa,bb,cc,alf,delt,gam)
 	end subroutine foncs
 !====================================================================72
 !====================================================================72  
+
+      subroutine icBEP_XY(iurb,fww_u,fwg_u,fgw_u,fsw_u,             &
+                          fws_u,fsg_u,ndu,strd,ws,nzu,z_u)                               
+
+      implicit none       
+        
+!    Street parameters
+      integer ndu     ! Number of street direction for each urban class
+      integer iurb
+
+      real strd(ndm)        ! Street length (fix to greater value to the horizontal length of the cells)
+      real ws(ndm)          ! Street width [m]
+
+!    Grid parameters
+      integer nzu          ! Number of layer in the urban grid
+      real z_u(nz_um)       ! Height of the urban grid levels
+! -----------------------------------------------------------------------
+!     Output
+!------------------------------------------------------------------------
+
+!   fww_u,fwg_u,fgw_u,fsw_u,fsg_u are the view factors used to compute the long wave
+!   and the short wave radation. They are the part of radiation from a surface
+!   or from the sky to another surface.
+
+      real fww_u(nz_um,nz_um,ndm,nurbm)         !  from wall to wall
+      real fwg_u(nz_um,ndm,nurbm)               !  from wall to ground
+      real fgw_u(nz_um,ndm,nurbm)               !  from ground to wall
+      real fsw_u(nz_um,ndm,nurbm)               !  from sky to wall
+      real fws_u(nz_um,ndm,nurbm)               !  from sky to wall
+      real fsg_u(ndm,nurbm)                     !  from sky to ground
+
+! -----------------------------------------------------------------------
+!     Local
+!------------------------------------------------------------------------
+
+      integer id
+
+! -----------------------------------------------------------------------
+!     This routine compute the view factors
+!------------------------------------------------------------------------
+!
+!Initialize
+!
+      fww_u=0.
+      fwg_u=0.
+      fgw_u=0.
+      fsw_u=0.
+      fws_u=0.
+      fsg_u=0.
+      
+      do id=1,ndu
+
+            call view_factors(iurb,nzu,id,strd(id),z_u,ws(id),  &    
+                              fww_u,fwg_u,fgw_u,fsg_u,fsw_u,fws_u) 
+      
+      enddo               
+      return       
+      end subroutine icBEP_XY
+!====================================================================72
+!====================================================================72  
+      subroutine icBEPHI_XY(iurb,hb_u,hi_urb1D,ss_u,pb_u,nzu,z_u)
+
+      implicit none   
+!-----------------------------------------------------------------------
+!    Inputs
+!-----------------------------------------------------------------------
+!    Street parameters
+!
+      real hi_urb1D(nz_um)    ! The probability that a building has an height h_b
+      integer iurb            ! Number of the urban class
+!
+!     Grid parameters
+!
+      real z_u(nz_um)         ! Height of the urban grid levels
+! -----------------------------------------------------------------------
+!     Output
+!------------------------------------------------------------------------
+
+      real ss_u(nz_um,nurbm)  ! The probability that a building has an height equal to z
+      real pb_u(nz_um)        ! The probability that a building has an height greater or equal to z
+!        
+!    Grid parameters
+!
+      integer nzu                ! Number of layer in the urban grid
+
+! -----------------------------------------------------------------------
+!     Local
+!------------------------------------------------------------------------
+      real hb_u(nz_um)        ! Bulding's heights [m]
+      integer iz_u,id,ilu
+
+      real dtot
+      real hbmax
+
+!------------------------------------------------------------------------
+
+!Initialize variables
+!
+      
+      nzu=0
+      ss_u=0.
+      pb_u=0.
+      
+! Normalisation of the building density
+
+         dtot=0.
+         hb_u=0.
+
+         do ilu=1,nz_um
+            dtot=dtot+hi_urb1D(ilu)
+         enddo
+
+         do ilu=1,nz_um
+            if (hi_urb1D(ilu)<0.) then
+!              write(*,*) 'WARNING, HI_URB1D(ilu) < 0 IN BEP_BEM'
+               go to 20
+            endif
+         enddo
+
+         if (dtot.gt.0.) then
+            continue
+         else
+!           write(*,*) 'WARNING, HI_URB1D <= 0 IN BEP_BEM'
+            go to 20
+         endif
+
+         do ilu=1,nz_um
+            hi_urb1D(ilu)=hi_urb1D(ilu)/dtot
+         enddo
+         
+         hb_u(1)=dz_u   
+         do ilu=2,nz_um
+            hb_u(ilu)=dz_u+hb_u(ilu-1)
+         enddo
+           
+
+! Compute pb and ss 
+      
+            
+         hbmax=0.
+       
+         do ilu=1,nz_um
+            if (hi_urb1D(ilu)>0.and.hi_urb1D(ilu)<=1.) then
+                hbmax=hb_u(ilu)
+            endif
+         enddo
+         
+         do iz_u=1,nz_um-1
+            if(z_u(iz_u+1).gt.hbmax)go to 10
+         enddo
+
+10       continue 
+        
+         nzu=iz_u+1
+      
+         if ((nzu+1).gt.nz_um) then 
+             write(*,*) 'error, nz_um has to be increased to at least',nzu+1
+             stop
+         endif
+
+            do iz_u=1,nzu
+               ss_u(iz_u,iurb)=0.
+               do ilu=1,nz_um
+                  if(z_u(iz_u).le.hb_u(ilu)                      &    
+                    .and.z_u(iz_u+1).gt.hb_u(ilu))then            
+                        ss_u(iz_u,iurb)=ss_u(iz_u,iurb)+hi_urb1D(ilu)
+                  endif 
+               enddo
+            enddo
+
+            pb_u(1)=1.
+            do iz_u=1,nzu
+               pb_u(iz_u+1)=max(0.,pb_u(iz_u)-ss_u(iz_u,iurb))
+            enddo
+
+20    continue    
+      return
+      end subroutine icBEPHI_XY
+!====================================================================72
+!====================================================================72
 END MODULE module_sf_bep_bem
diff --git a/src/core_atmosphere/physics/physics_wrf/module_sf_noah_seaice.F b/src/core_atmosphere/physics/physics_wrf/module_sf_noah_seaice.F
new file mode 100644
index 0000000000..4075501d7e
--- /dev/null
+++ b/src/core_atmosphere/physics/physics_wrf/module_sf_noah_seaice.F
@@ -0,0 +1,1291 @@
+MODULE module_sf_noah_seaice
+#if defined(mpas)
+use mpas_atmphys_constants,only: cp,R_D=>R_d,XLF,XLV,RHOWATER=>rho_w,STBOLT
+use mpas_atmphys_utilities, only: physics_error_fatal
+#define FATAL_ERROR(M) call physics_error_fatal( M )
+#else
+use module_model_constants, only : CP, R_D, XLF, XLV, RHOWATER, STBOLT
+use module_wrf_error
+#define FATAL_ERROR(M) call wrf_error_fatal( M )
+#endif
+  use module_sf_noahlsm, only : RD, SIGMA, CPH2O, CPICE, LSUBF, EMISSI_S, &
+       &                        HSTEP
+
+  PUBLIC  SFLX_SEAICE
+  PRIVATE CSNOW
+  PRIVATE HRTICE
+  PRIVATE PENMAN
+  PRIVATE SHFLX
+  PRIVATE SNOPAC
+  PRIVATE SNOWPACK
+  PRIVATE SNOWZ0
+  PRIVATE SNOW_NEW
+
+  INTEGER, PRIVATE :: ILOC
+  INTEGER, PRIVATE :: JLOC
+!$omp threadprivate(iloc, jloc)
+
+  REAL, PARAMETER, PRIVATE :: TFREEZ = 273.15
+!
+CONTAINS
+!
+  SUBROUTINE SFLX_SEAICE (IILOC, JJLOC, SEAICE_ALBEDO_OPT, SEAICE_ALBEDO_DEFAULT, &    !C
+       &                  SEAICE_SNOWDEPTH_OPT, SEAICE_SNOWDEPTH_MAX,      &    !C
+       &                  SEAICE_SNOWDEPTH_MIN,                            &    !C
+       &                  FFROZP,DT,ZLVL,NSOIL,                            &    !C
+       &                  SITHICK,                                         &
+       &                  LWDN,SOLNET,SFCPRS,PRCP,SFCTMP,Q2,               &    !F
+       &                  TH2,Q2SAT,DQSDT2,                                &    !I
+       &                  SNOALB,TBOT, Z0BRD, Z0, EMISSI,                  &    !S
+       &                  T1,STC,SNOWH,SNEQV,ALBEDO, CH,                   &    !H
+       &                  ALBEDOSI, SNOWONSI,                              &
+       &                  ETA,SHEAT,ETA_KINEMATIC,FDOWN,                   &    !O
+       &                  ESNOW,DEW,ETP,SSOIL,FLX1,FLX2,FLX3,              &    !O
+       &                  SNOMLT,SNCOVR,                                   &    !O
+       &                  RUNOFF1,Q1,RIBB)
+
+! ----------------------------------------------------------------------
+! SUBROUTINE SFLX_SEAICE
+! ----------------------------------------------------------------------
+! SUB-DRIVER FOR "Noah LSM" FAMILY OF PHYSICS SUBROUTINES FOR A SEA-ICE
+! LAND-SURFACE MODEL TO UPDATE ICE TEMPERATURE, SKIN TEMPERATURE,
+! SNOWPACK WATER CONTENT, SNOWDEPTH, AND ALL TERMS OF THE SURFACE ENERGY
+! BALANCE (EXCLUDING INPUT ATMOSPHERIC FORCINGS OF DOWNWARD RADIATION
+! AND PRECIP)
+! ----------------------------------------------------------------------
+! SFLX_SEAICE ARGUMENT LIST KEY:
+! ----------------------------------------------------------------------
+!  C  CONFIGURATION INFORMATION
+!  F  FORCING DATA
+!  I  OTHER (INPUT) FORCING DATA
+!  S  SURFACE CHARACTERISTICS
+!  H  HISTORY (STATE) VARIABLES
+!  O  OUTPUT VARIABLES
+!  D  DIAGNOSTIC OUTPUT
+! ----------------------------------------------------------------------
+! 1. CONFIGURATION INFORMATION (C):
+! ----------------------------------------------------------------------
+!   DT         TIMESTEP (SEC) (DT SHOULD NOT EXCEED 3600 SECS, RECOMMEND
+!                1800 SECS OR LESS)
+!   ZLVL       HEIGHT (M) ABOVE GROUND OF ATMOSPHERIC FORCING VARIABLES
+!   NSOIL      NUMBER OF SOIL LAYERS (AT LEAST 2, AND NOT GREATER THAN
+!                PARAMETER NSOLD SET BELOW)
+! ----------------------------------------------------------------------
+! 3. FORCING DATA (F):
+! ----------------------------------------------------------------------
+!   LWDN       LW DOWNWARD RADIATION (W M-2; POSITIVE, NOT NET LONGWAVE)
+!   SOLNET     NET DOWNWARD SOLAR RADIATION ((W M-2; POSITIVE)
+!   SFCPRS     PRESSURE AT HEIGHT ZLVL ABOVE GROUND (PASCALS)
+!   PRCP       PRECIP RATE (KG M-2 S-1) (NOTE, THIS IS A RATE)
+!   SFCTMP     AIR TEMPERATURE (K) AT HEIGHT ZLVL ABOVE GROUND
+!   TH2        AIR POTENTIAL TEMPERATURE (K) AT HEIGHT ZLVL ABOVE GROUND
+!   Q2         MIXING RATIO AT HEIGHT ZLVL ABOVE GROUND (KG KG-1)
+!   FFROZP     FRACTION OF FROZEN PRECIPITATION
+! ----------------------------------------------------------------------
+! 4. OTHER FORCING (INPUT) DATA (I):
+! ----------------------------------------------------------------------
+!   Q2SAT      SAT SPECIFIC HUMIDITY AT HEIGHT ZLVL ABOVE GROUND (KG KG-1)
+!   DQSDT2     SLOPE OF SAT SPECIFIC HUMIDITY CURVE AT T=SFCTMP
+!                (KG KG-1 K-1)
+! ----------------------------------------------------------------------
+! 5. CANOPY/SOIL CHARACTERISTICS (S):
+! ----------------------------------------------------------------------
+!   SNOALB     UPPER BOUND ON MAXIMUM ALBEDO OVER DEEP SNOW (E.G. FROM
+!                ROBINSON AND KUKLA, 1985, J. CLIM. & APPL. METEOR.)
+!   TBOT       BOTTOM SOIL TEMPERATURE (LOCAL YEARLY-MEAN SFC AIR
+!                TEMPERATURE)
+!   Z0BRD      Background fixed roughness length (M)
+!   Z0         Time varying roughness length (M) as function of snow depth
+!
+!   EMISSI     Surface emissivity (between 0 and 1)
+! ----------------------------------------------------------------------
+! 6. HISTORY (STATE) VARIABLES (H):
+! ----------------------------------------------------------------------
+!  T1          GROUND/CANOPY/SNOWPACK) EFFECTIVE SKIN TEMPERATURE (K)
+!  STC(NSOIL)  SOIL TEMP (K)
+!  SNOWH       ACTUAL SNOW DEPTH (M)
+!  SNEQV       LIQUID WATER-EQUIVALENT SNOW DEPTH (M)
+!                NOTE: SNOW DENSITY = SNEQV/SNOWH
+!  ALBEDO      SURFACE ALBEDO
+!  CH          SURFACE EXCHANGE COEFFICIENT FOR HEAT AND MOISTURE
+!                (M S-1); NOTE: CH IS TECHNICALLY A CONDUCTANCE SINCE
+!                IT HAS BEEN MULTIPLIED BY WIND SPEED.
+! ----------------------------------------------------------------------
+! 7. OUTPUT (O):
+! ----------------------------------------------------------------------
+! OUTPUT VARIABLES NECESSARY FOR A COUPLED NWP MODEL.  FOR THIS APPLICATION,
+! THE REMAINING OUTPUT/DIAGNOSTIC/PARAMETER BLOCKS BELOW ARE NOT
+! NECESSARY.  OTHER APPLICATIONS MAY REQUIRE DIFFERENT OUTPUT VARIABLES.
+!   ETA        ACTUAL LATENT HEAT FLUX (W m-2: NEGATIVE, IF UP FROM
+!              SURFACE)
+!  ETA_KINEMATIC actual latent heat flux in Kg m-2 s-1
+!   SHEAT      SENSIBLE HEAT FLUX (W M-2: NEGATIVE, IF UPWARD FROM
+!              SURFACE)
+!   FDOWN      Radiation forcing at the surface (W m-2) = SOLDN*(1-alb)+LWDN
+! ----------------------------------------------------------------------
+!   ESNOW      SUBLIMATION FROM (OR DEPOSITION TO IF <0) SNOWPACK (W m-2)
+!   DEW        DEWFALL (OR FROSTFALL FOR T<273.15) (M)
+! ----------------------------------------------------------------------
+!   ETP        POTENTIAL EVAPORATION (W m-2)
+!   SSOIL      SOIL HEAT FLUX (W M-2: NEGATIVE IF DOWNWARD FROM SURFACE)
+! ----------------------------------------------------------------------
+!   FLX1       PRECIP-SNOW SFC (W M-2)
+!   FLX2       FREEZING RAIN LATENT HEAT FLUX (W M-2)
+!   FLX3       PHASE-CHANGE HEAT FLUX FROM SNOWMELT (W M-2)
+! ----------------------------------------------------------------------
+!   SNOMLT     SNOW MELT (M) (WATER EQUIVALENT)
+!   SNCOVR     FRACTIONAL SNOW COVER (UNITLESS FRACTION, 0-1)
+! ----------------------------------------------------------------------
+!   RUNOFF1    SURFACE RUNOFF (M S-1), NOT INFILTRATING THE SURFACE
+! ----------------------------------------------------------------------
+! 8. DIAGNOSTIC OUTPUT (D):
+! ----------------------------------------------------------------------
+!   Q1         Effective mixing ratio at surface (kg kg-1), used for
+!              diagnosing the mixing ratio at 2 meter for coupled model
+!  Documentation SNOABL2 ?????
+!  What categories of arguments do these variables fall into ????
+!  Documentation for RIBB ?????
+!  What category of argument does RIBB fall into ?????
+! ----------------------------------------------------------------------
+      IMPLICIT NONE
+! ----------------------------------------------------------------------
+      integer, intent(in) :: iiloc, jjloc
+      INTEGER, INTENT(IN) :: SEAICE_ALBEDO_OPT
+      REAL,    INTENT(IN) :: SEAICE_ALBEDO_DEFAULT
+      INTEGER, INTENT(IN) :: SEAICE_SNOWDEPTH_OPT
+      REAL,    INTENT(IN) :: SEAICE_SNOWDEPTH_MAX
+      REAL,    INTENT(IN) :: SEAICE_SNOWDEPTH_MIN
+
+      LOGICAL            ::  FRZGRA, SNOWNG
+
+      INTEGER,INTENT(IN) ::  NSOIL
+
+      REAL, INTENT(IN)   :: DT,DQSDT2,LWDN,PRCP,                   &
+                            Q2,Q2SAT,SFCPRS,SFCTMP,SNOALB,ALBEDOSI,          &
+                            SOLNET,TBOT,TH2,ZLVL,                            &
+                            FFROZP
+      REAL, INTENT(OUT)  :: ALBEDO
+      REAL, INTENT(INOUT):: CH,                         &
+                            SNEQV,SNCOVR,SNOWH,T1,Z0BRD,                    &
+                            EMISSI
+      REAL, INTENT(IN)   :: SNOWONSI
+      REAL, INTENT(IN)   :: SITHICK
+      REAL, INTENT(INOUT):: RIBB
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT) ::  STC
+      REAL,DIMENSION(1:NSOIL)::   ZSOIL
+
+      REAL,INTENT(OUT)   :: ETA_KINEMATIC,DEW,ESNOW,ETA,                    &
+                            ETP,FLX1,FLX2,FLX3,SHEAT,RUNOFF1,               &
+                            SSOIL,                                          &
+                            SNOMLT,                                         &
+                            FDOWN,Q1,Z0
+      REAL :: DF1,DF1A,                                                     &
+              DSOIL,DTOT,FRCSNO,FRCSOI,                                     &
+              RCH,RR,                                                       &
+              SNDENS,SNCOND,SN_NEW,                                         &
+              T24,T2V,TH2V,TSNOW
+
+      REAL :: RHO
+      INTEGER  :: KZ, K
+
+      REAL :: ALB_SNOW
+      REAL :: ALB_ICE
+      REAL :: Z0N
+      REAL :: SNCOVRR
+
+! ----------------------------------------------------------------------
+! DECLARATIONS - PARAMETERS
+! ----------------------------------------------------------------------
+
+      REAL, PARAMETER :: LVH2O = 2.501E+6
+      REAL, PARAMETER :: LSUBS = 2.83E+6
+      REAL, PARAMETER :: R = 287.04
+
+      iloc = iiloc
+      jloc = jjloc
+! ----------------------------------------------------------------------
+!   INITIALIZATION
+! ----------------------------------------------------------------------
+
+      RUNOFF1 = 0.0
+      SNOMLT = 0.0
+
+! ----------------------------------------------------------------------
+! SEA-ICE LAYERS ARE EQUAL THICKNESS AND SUM TO <SITHICK> METERS
+! ----------------------------------------------------------------------
+
+      DO KZ = 1,NSOIL
+         ZSOIL (KZ) = -SITHICK * FLOAT (KZ) / FLOAT (NSOIL)
+      END DO
+
+! ----------------------------------------------------------------------
+
+      Z0BRD = 0.001 
+!      ALB = 0.82  ! Arctic pre-melt spring and post-melt autumn
+!      ALB = 0.80  ! Antarctica
+!      ALB = 0.50  ! Arctic mid-summer (ice and melt ponds)
+!      ALB = 0.65  ! Arctic bare ice with no snow and no melt ponds
+
+! ----------------------------------------------------------------------
+!  INITIALIZE PRECIPITATION LOGICALS.
+! ----------------------------------------------------------------------
+
+      SNOWNG = .FALSE.
+      FRZGRA = .FALSE.
+
+! ----------------------------------------------------------------------
+! OVER SEA-ICE, IF S.W.E. (SNEQV) BELOW THRESHOLD LOWER
+! BOUND (0.01 M FOR SEA-ICE, 0.10 M FOR GLACIAL-ICE), THEN SET AT LOWER
+! BOUND
+! ----------------------------------------------------------------------
+! FOR SEA-ICE CASE, ASSIGN DEFAULT WATER-EQUIV SNOW ON TOP
+! ----------------------------------------------------------------------
+
+      SELECT CASE ( SEAICE_ALBEDO_OPT )
+
+      CASE DEFAULT
+
+         IF ( SNEQV < 0.01 ) THEN
+            SNEQV = 0.01
+            SNOWH = 0.05
+         ENDIF
+
+      CASE ( 1 ) ! Arctic sea-ice albedo from Mills (2011)
+
+         IF ( SNEQV < 0.0001 ) THEN
+            SNEQV = 0.0001
+            SNOWH = 0.0005
+         ENDIF
+
+      END SELECT
+
+
+      IF ( SEAICE_SNOWDEPTH_OPT == 0 ) THEN
+
+          !
+          ! Enforce bounds on snow depth, maintaining original snow density.
+          !
+
+          SNDENS = SNEQV / SNOWH
+          SNOWH = MAX ( SEAICE_SNOWDEPTH_MIN , MIN ( SNOWH , SEAICE_SNOWDEPTH_MAX ) )
+          SNEQV = SNOWH * SNDENS 
+
+      ELSEIF ( SEAICE_SNOWDEPTH_OPT == 1 ) THEN
+
+          !
+          ! Regardless of the assignments above, we want to enforce
+          ! a specified snow depth and density on sea ice.
+          !
+
+          SNDENS = 0.3
+          SNOWH = SNOWONSI
+          SNEQV = SNOWH * SNDENS
+      ENDIF
+
+! ----------------------------------------------------------------------
+! IF INPUT SNOWPACK IS NONZERO, THEN COMPUTE SNOW DENSITY "SNDENS" AND
+! SNOW THERMAL CONDUCTIVITY "SNCOND"
+! ----------------------------------------------------------------------
+
+      SNDENS = SNEQV / SNOWH
+      IF(SNDENS > 1.0) THEN
+         FATAL_ERROR( 'Physical snow depth is less than snow water equiv.' )
+      ENDIF
+      CALL CSNOW (SNCOND,SNDENS)
+
+! ----------------------------------------------------------------------
+! DETERMINE IF IT'S PRECIPITATING AND WHAT KIND OF PRECIP IT IS.
+! IF IT'S PRCPING AND THE AIR TEMP IS COLDER THAN 0 C, IT'S SNOWING!
+! IF IT'S PRCPING AND THE AIR TEMP IS WARMER THAN 0 C, BUT THE GRND
+! TEMP IS COLDER THAN 0 C, FREEZING RAIN IS PRESUMED TO BE FALLING.
+! ----------------------------------------------------------------------
+
+      IF (PRCP > 0.0) THEN
+! snow defined when fraction of frozen precip (FFROZP) > 0.5,
+! passed in from model microphysics.
+         IF (FFROZP .GT. 0.5) THEN
+            SNOWNG = .TRUE.
+         ELSE
+            IF (T1 <= TFREEZ) FRZGRA = .TRUE.
+         END IF
+      END IF
+
+! ----------------------------------------------------------------------
+! IF EITHER PRCP FLAG IS SET, DETERMINE NEW SNOWFALL (CONVERTING PRCP
+! RATE FROM KG M-2 S-1 TO A LIQUID EQUIV SNOW DEPTH IN METERS) AND ADD
+! IT TO THE EXISTING SNOWPACK.
+! ----------------------------------------------------------------------
+
+      IF ( SNOWNG .OR. FRZGRA ) THEN
+         SN_NEW = PRCP * DT * 0.001
+         SNEQV = SNEQV + SN_NEW
+
+! ----------------------------------------------------------------------
+! UPDATE SNOW DENSITY BASED ON NEW SNOWFALL, USING OLD AND NEW SNOW.
+! UPDATE SNOW THERMAL CONDUCTIVITY
+! ----------------------------------------------------------------------
+
+         CALL SNOW_NEW ( SFCTMP , SN_NEW , SNOWH , SNDENS )
+         !
+         ! kmh 09/04/2006 set Snow Density at 0.2 g/cm**3
+         ! for "cold permanent ice" or new "dry" snow
+         !
+         IF ( SNCOVR .GT. 0.99 ) THEN
+            !
+            !  if soil temperature less than 268.15 K, treat as typical 
+            !  Antarctic/Greenland snow firn
+            !
+            IF ( STC(1) .LT. (TFREEZ - 5.) ) SNDENS = 0.2
+            IF ( SNOWNG .AND. (T1.LT.273.) .AND. (SFCTMP.LT.273.) ) SNDENS=0.2
+         ENDIF
+
+         CALL CSNOW (SNCOND,SNDENS)
+
+      END IF
+
+! ----------------------------------------------------------------------
+! ALBEDO OF SEA ICE
+! ----------------------------------------------------------------------
+      
+
+      SELECT CASE ( SEAICE_ALBEDO_OPT )
+
+      CASE DEFAULT
+
+         SNCOVR = 1.0
+         EMISSI = 0.98
+         ALBEDO = SEAICE_ALBEDO_DEFAULT
+!        ALBEDO = 0.82  ! Arctic pre-melt spring and post-melt autumn
+!        ALBEDO = 0.80  ! Antarctica
+!        ALBEDO = 0.50  ! Arctic mid-summer (ice and melt ponds)
+!        ALBEDO = 0.65  ! Arctic bare ice with no snow and no melt ponds
+
+      CASE ( 1 ) ! Arctic sea-ice albedo from Mills (2011)
+
+         !
+         ! Make albedo of snow on sea-ice a function of skin temperature:
+         !
+         IF (T1 < 268.15) THEN
+            alb_snow = 0.8
+         ELSEIF ( ( T1 >= 268.15 ) .AND. ( T1 < 273.15 ) ) then
+            alb_snow = 0.65 - ( 0.03 * (T1 - 273.15) )
+         ELSE
+            alb_snow = 0.65
+         ENDIF
+
+         !
+         ! Make albedo of snow-free sea-ice a function of air temperature
+         !
+         IF ( SFCTMP <= 273.15 ) THEN
+            alb_ice = 0.65
+         ELSEIF ( ( SFCTMP > 273.15 ) .and. ( SFCTMP < 278.15 ) ) THEN
+            alb_ice = 0.65 - ( 0.04 * (SFCTMP - 273.15) )
+         ELSE
+            alb_ice = 0.45
+         ENDIF
+
+         !
+         ! Define a snow-cover fraction for use only with Mills sea-ice albedo
+         !
+         Z0N = 0.10 ! Approximate roughness length of snow-covered surface
+         SNCOVRR = SNOWH / ( SNOWH + Z0N )
+
+         !
+         ! Final albedo over sea-ice point is a combination of the snow 
+         ! albedo and the snow-free ice albedo, weighted by the snow cover.
+         !
+         ALBEDO = (SNCOVRR * alb_snow ) + ( ( 1.0 - SNCOVRR) * alb_ice )
+
+      CASE ( 2 ) ! Seaice albedo from 2d field
+
+         SNCOVR = 1.0
+         EMISSI = 0.98
+         ALBEDO = ALBEDOSI
+
+      END SELECT
+
+! ----------------------------------------------------------------------
+! THERMAL CONDUCTIVITY FOR SEA-ICE CASE
+! ----------------------------------------------------------------------
+      DF1 = 2.2
+
+      DSOIL = - (0.5 * ZSOIL (1))
+
+      DTOT = SNOWH + DSOIL
+      FRCSNO = SNOWH / DTOT
+
+! 1. HARMONIC MEAN (SERIES FLOW)
+!        DF1 = (SNCOND*DF1)/(FRCSOI*SNCOND+FRCSNO*DF1)
+      FRCSOI = DSOIL / DTOT
+! 2. ARITHMETIC MEAN (PARALLEL FLOW)
+!        DF1 = FRCSNO*SNCOND + FRCSOI*DF1
+
+! 3. GEOMETRIC MEAN (INTERMEDIATE BETWEEN HARMONIC AND ARITHMETIC MEAN)
+!        DF1 = (SNCOND**FRCSNO)*(DF1**FRCSOI)
+! weigh DF by snow fraction
+      DF1A = FRCSNO * SNCOND + FRCSOI * DF1
+
+! ----------------------------------------------------------------------
+! CALCULATE SUBSURFACE HEAT FLUX, SSOIL, FROM FINAL THERMAL DIFFUSIVITY
+! OF SURFACE MEDIUMS, DF1 ABOVE, AND SKIN TEMPERATURE AND TOP
+! MID-LAYER SOIL TEMPERATURE
+! ----------------------------------------------------------------------
+      DF1 = DF1A * SNCOVR + DF1 * ( 1.0 - SNCOVR )
+      
+      SSOIL = DF1 * ( T1 - STC(1) ) / DTOT
+
+! ----------------------------------------------------------------------
+! DETERMINE SURFACE ROUGHNESS OVER SNOWPACK USING SNOW CONDITION FROM
+! THE PREVIOUS TIMESTEP.
+! ----------------------------------------------------------------------
+
+      CALL SNOWZ0 (SNCOVR,Z0,Z0BRD,SNOWH)
+
+! ----------------------------------------------------------------------
+! CALCULATE TOTAL DOWNWARD RADIATION (SOLAR PLUS LONGWAVE) NEEDED IN
+! PENMAN EP SUBROUTINE THAT FOLLOWS
+! ----------------------------------------------------------------------
+      FDOWN =  SOLNET + LWDN
+! ----------------------------------------------------------------------
+! CALC VIRTUAL TEMPS AND VIRTUAL POTENTIAL TEMPS NEEDED BY SUBROUTINES
+! PENMAN.
+! ----------------------------------------------------------------------
+      T2V = SFCTMP * (1.0+ 0.61 * Q2 )
+      T24 = SFCTMP * SFCTMP * SFCTMP * SFCTMP
+      RHO = SFCPRS / ( RD * T2V )
+      ! RCH = RHO * CP * CH
+      RCH = RHO * 1004.6 * CH  ! CP is defined different in subroutine PENMAN.
+                               ! Pulling this computation out of PENMAN changed
+                               ! the results.  So I'm hard-coding the PENMAN
+                               ! value here, but perhaps this should go back
+                               ! into PENMAN for now.
+
+! ----------------------------------------------------------------------
+! CALL PENMAN SUBROUTINE TO CALCULATE POTENTIAL EVAPORATION (ETP), AND
+! OTHER PARTIAL PRODUCTS AND SUMS FOR LATER CALCULATIONS.
+! ----------------------------------------------------------------------
+
+      CALL PENMAN (SFCTMP,SFCPRS,CH,TH2,PRCP,FDOWN,T24,SSOIL,     &
+           Q2,Q2SAT,ETP,RCH,RR,SNOWNG,FRZGRA,                     &
+           DQSDT2,FLX2,EMISSI,T1)
+
+      ESNOW = 0.0
+      CALL SNOPAC (ETP,ETA,PRCP,SNOWNG,                    &
+           NSOIL,DT,DF1,                                   &
+           Q2,T1,SFCTMP,T24,TH2,FDOWN,SSOIL,STC,           &
+           SFCPRS,RCH,RR,SNCOVR,SNEQV,SNDENS,              &
+           SNOWH,ZSOIL,TBOT,                               &
+           SNOMLT,DEW,FLX1,FLX2,FLX3,ESNOW,EMISSI,RIBB,    &
+           SEAICE_ALBEDO_OPT)
+!     ETA_KINEMATIC =  ESNOW
+      ETA_KINEMATIC =  ETP
+
+      IF ( SEAICE_SNOWDEPTH_OPT == 0 ) THEN
+
+          !
+          ! Set bounds on snow depth, maintaining snow density.
+          !
+          SNDENS = SNEQV / SNOWH
+          SNOWH = MAX ( SEAICE_SNOWDEPTH_MIN , MIN ( SNOWH , SEAICE_SNOWDEPTH_MAX ) )
+          SNEQV = SNOWH * SNDENS 
+
+      ELSEIF ( SEAICE_SNOWDEPTH_OPT == 1 ) THEN
+
+          !
+          ! Regardless of the results of snopac, we want to enforce
+          ! a specified snow depth and density on sea ice.
+          !
+          SNDENS = 0.3
+          SNOWH = SNOWONSI
+          SNEQV = SNOWH * SNDENS
+      ENDIF
+
+!     Calculate effective mixing ratio at ground level (skin)
+      Q1=Q2+ETA_KINEMATIC*CP/RCH
+!
+! ----------------------------------------------------------------------
+! DETERMINE SENSIBLE HEAT (H) IN ENERGY UNITS (W M-2)
+! ----------------------------------------------------------------------
+
+      SHEAT = - (CH * CP * SFCPRS)/ (R * T2V) * ( TH2- T1 )
+
+! ----------------------------------------------------------------------
+! CONVERT EVAP TERMS FROM KINEMATIC (KG M-2 S-1) TO ENERGY UNITS (W M-2)
+! ----------------------------------------------------------------------
+
+      ESNOW = ESNOW * LSUBS
+      ETP = ETP*((1.-SNCOVR)*LVH2O + SNCOVR*LSUBS)
+      IF (ETP .GT. 0.) THEN
+         ETA = ESNOW
+      ELSE
+         ETA = ETP
+      ENDIF
+
+! ----------------------------------------------------------------------
+! CONVERT THE SIGN OF SOIL HEAT FLUX SO THAT:
+!   SSOIL>0: WARM THE SURFACE  (NIGHT TIME)
+!   SSOIL<0: COOL THE SURFACE  (DAY TIME)
+! ----------------------------------------------------------------------
+
+      SSOIL = -1.0* SSOIL
+
+! ----------------------------------------------------------------------
+! FOR THE CASE OF SEA-ICE, ADD ANY
+! SNOWMELT DIRECTLY TO SURFACE RUNOFF (RUNOFF1) SINCE THERE IS NO
+! SOIL MEDIUM, AND THUS NO CALL TO SUBROUTINE SMFLX (FOR SOIL MOISTURE
+! TENDENCY).
+! ----------------------------------------------------------------------
+      RUNOFF1 = SNOMLT/DT
+
+! ----------------------------------------------------------------------
+    END SUBROUTINE SFLX_SEAICE
+! ----------------------------------------------------------------------
+
+      SUBROUTINE CSNOW (SNCOND,DSNOW)
+
+! ----------------------------------------------------------------------
+! SUBROUTINE CSNOW
+! FUNCTION CSNOW
+! ----------------------------------------------------------------------
+! CALCULATE SNOW TERMAL CONDUCTIVITY
+! ----------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL, INTENT(IN) :: DSNOW
+      REAL, INTENT(OUT):: SNCOND
+      REAL             :: C
+      REAL, PARAMETER  :: UNIT = 0.11631
+
+! ----------------------------------------------------------------------
+! SNCOND IN UNITS OF CAL/(CM*HR*C), RETURNED IN W/(M*C)
+! CSNOW IN UNITS OF CAL/(CM*HR*C), RETURNED IN W/(M*C)
+! BASIC VERSION IS DYACHKOVA EQUATION (1960), FOR RANGE 0.1-0.4
+! ----------------------------------------------------------------------
+      C = 0.328*10** (2.25* DSNOW)
+!      CSNOW=UNIT*C
+
+! ----------------------------------------------------------------------
+! DE VAUX EQUATION (1933), IN RANGE 0.1-0.6
+! ----------------------------------------------------------------------
+!      SNCOND=0.0293*(1.+100.*DSNOW**2)
+!      CSNOW=0.0293*(1.+100.*DSNOW**2)
+
+! ----------------------------------------------------------------------
+! E. ANDERSEN FROM FLERCHINGER
+! ----------------------------------------------------------------------
+!      SNCOND=0.021+2.51*DSNOW**2
+!      CSNOW=0.021+2.51*DSNOW**2
+
+!      SNCOND = UNIT * C
+! double snow thermal conductivity
+      SNCOND = 2.0 * UNIT * C
+
+! ----------------------------------------------------------------------
+  END SUBROUTINE CSNOW
+! ----------------------------------------------------------------------
+  SUBROUTINE HRTICE (RHSTS,STC,TBOT,NSOIL,ZSOIL,YY,ZZ1,DF1,AI,BI,CI)
+! ----------------------------------------------------------------------
+! CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY TERM OF THE SOIL
+! THERMAL DIFFUSION EQUATION IN THE CASE OF SEA-ICE (ICE=1) OR GLACIAL
+! ICE (ICE=-1). COMPUTE (PREPARE) THE MATRIX COEFFICIENTS FOR THE
+! TRI-DIAGONAL MATRIX OF THE IMPLICIT TIME SCHEME.
+!
+! (NOTE:  THIS SUBROUTINE ONLY CALLED FOR SEA-ICE OR GLACIAL ICE, BUT
+! NOT FOR NON-GLACIAL LAND (ICE = 0).
+! ----------------------------------------------------------------------
+      IMPLICIT NONE
+
+
+      INTEGER, INTENT(IN)    :: NSOIL
+      INTEGER                :: K
+
+      REAL,    INTENT(IN)    :: DF1,YY,ZZ1
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT):: AI, BI,CI
+      REAL, DIMENSION(1:NSOIL), INTENT(IN) :: STC, ZSOIL
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT):: RHSTS
+      REAL,                     INTENT(IN) :: TBOT
+      REAL                   :: DDZ,DDZ2,DENOM,DTSDZ,DTSDZ2,SSOIL,       &
+                                ZBOT
+      REAL                   :: HCPCT
+      REAL :: DF1K
+      REAL :: DF1N
+      REAL :: ZMD
+
+! ----------------------------------------------------------------------
+! SET A NOMINAL UNIVERSAL VALUE OF THE SEA-ICE SPECIFIC HEAT CAPACITY,
+! HCPCT = 1880.0*917.0.
+! ----------------------------------------------------------------------
+      ! Sea-ice values
+      HCPCT = 1.72396E+6
+
+! ----------------------------------------------------------------------
+! THE INPUT ARGUMENT DF1 IS A UNIVERSALLY CONSTANT VALUE OF SEA-ICE
+! THERMAL DIFFUSIVITY, SET IN ROUTINE SNOPAC AS DF1 = 2.2.
+! ----------------------------------------------------------------------
+! SET ICE PACK DEPTH.  USE TBOT AS ICE PACK LOWER BOUNDARY TEMPERATURE
+! (THAT OF UNFROZEN SEA WATER AT BOTTOM OF SEA ICE PACK).  ASSUME ICE
+! PACK IS OF N=NSOIL LAYERS SPANNING A UNIFORM CONSTANT ICE PACK
+! THICKNESS AS DEFINED BY ZSOIL(NSOIL) IN ROUTINE SFLX.
+! ----------------------------------------------------------------------
+! ----------------------------------------------------------------------
+! CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER
+! ----------------------------------------------------------------------
+      ZBOT = ZSOIL (NSOIL)
+      DDZ = 1.0 / ( -0.5 * ZSOIL (2) )
+      AI (1) = 0.0
+      CI (1) = (DF1 * DDZ) / (ZSOIL (1) * HCPCT)
+
+! ----------------------------------------------------------------------
+! CALC THE VERTICAL SOIL TEMP GRADIENT BTWN THE TOP AND 2ND SOIL LAYERS.
+! RECALC/ADJUST THE SOIL HEAT FLUX.  USE THE GRADIENT AND FLUX TO CALC
+! RHSTS FOR THE TOP SOIL LAYER.
+! ----------------------------------------------------------------------
+      BI (1) = - CI (1) + DF1/ (0.5 * ZSOIL (1) * ZSOIL (1) * HCPCT *    &
+       ZZ1)
+      DTSDZ = ( STC (1) - STC (2) ) / ( -0.5 * ZSOIL (2) )
+      SSOIL = DF1 * ( STC (1) - YY ) / ( 0.5 * ZSOIL (1) * ZZ1 )
+
+! ----------------------------------------------------------------------
+! INITIALIZE DDZ2
+! ----------------------------------------------------------------------
+      RHSTS (1) = ( DF1 * DTSDZ - SSOIL ) / ( ZSOIL (1) * HCPCT )
+
+! ----------------------------------------------------------------------
+! LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABOVE PROCESS
+! ----------------------------------------------------------------------
+      DDZ2 = 0.0
+      DF1K = DF1
+      DF1N = DF1
+      DO K = 2,NSOIL
+
+! ----------------------------------------------------------------------
+! CALC THE VERTICAL SOIL TEMP GRADIENT THRU THIS LAYER.
+! ----------------------------------------------------------------------
+         IF (K /= NSOIL) THEN
+            DENOM = 0.5 * ( ZSOIL (K -1) - ZSOIL (K +1) )
+
+! ----------------------------------------------------------------------
+! CALC THE MATRIX COEF, CI, AFTER CALC'NG ITS PARTIAL PRODUCT.
+! ----------------------------------------------------------------------
+            DTSDZ2 = ( STC (K) - STC (K +1) ) / DENOM
+            DDZ2 = 2. / (ZSOIL (K -1) - ZSOIL (K +1))
+            CI (K) = - DF1N * DDZ2 / ( (ZSOIL (K -1) - ZSOIL (K))*HCPCT)
+
+! ----------------------------------------------------------------------
+! CALC THE VERTICAL SOIL TEMP GRADIENT THRU THE LOWEST LAYER.
+! ----------------------------------------------------------------------
+         ELSE
+
+! ----------------------------------------------------------------------
+! SET MATRIX COEF, CI TO ZERO.
+! ----------------------------------------------------------------------
+            DTSDZ2 = (STC (K) - TBOT)/ (.5 * (ZSOIL (K -1) + ZSOIL (K)) &
+                     - ZBOT)
+            CI (K) = 0.
+         END IF
+! ----------------------------------------------------------------------
+! CALC RHSTS FOR THIS LAYER AFTER CALC'NG A PARTIAL PRODUCT.
+! ----------------------------------------------------------------------
+         DENOM = ( ZSOIL (K) - ZSOIL (K -1) ) * HCPCT
+! ----------------------------------------------------------------------
+! CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER.
+! ----------------------------------------------------------------------
+         RHSTS (K) = ( DF1N * DTSDZ2- DF1K * DTSDZ ) / DENOM
+         AI (K) = - DF1K * DDZ / ( (ZSOIL (K -1) - ZSOIL (K)) * HCPCT)
+         BI (K) = - (AI (K) + CI (K))
+! ----------------------------------------------------------------------
+! RESET VALUES OF DTSDZ AND DDZ FOR LOOP TO NEXT SOIL LYR.
+! ----------------------------------------------------------------------
+         DF1K = DF1N
+         DTSDZ = DTSDZ2
+         DDZ = DDZ2
+      END DO
+! ----------------------------------------------------------------------
+  END SUBROUTINE HRTICE
+! ----------------------------------------------------------------------
+
+  SUBROUTINE PENMAN (SFCTMP,SFCPRS,CH,TH2,PRCP,FDOWN,T24,SSOIL, &
+       &             Q2,Q2SAT,ETP,RCH,RR,SNOWNG,FRZGRA,       &
+       &             DQSDT2,FLX2,EMISSI,T1)
+
+! ----------------------------------------------------------------------
+! CALCULATE POTENTIAL EVAPORATION FOR THE CURRENT POINT.  VARIOUS
+! PARTIAL SUMS/PRODUCTS ARE ALSO CALCULATED AND PASSED BACK TO THE
+! CALLING ROUTINE FOR LATER USE.
+! ----------------------------------------------------------------------
+
+    IMPLICIT NONE
+    LOGICAL, INTENT(IN)     :: SNOWNG, FRZGRA
+    REAL, INTENT(IN)        :: CH, DQSDT2, FDOWN, PRCP,           &
+         &                     Q2, Q2SAT, SSOIL, SFCPRS, SFCTMP,  &
+         &                     TH2,EMISSI
+    REAL, INTENT(IN)        :: T1, T24, RCH
+    REAL, INTENT(OUT)       :: ETP,FLX2,RR
+    REAL                    :: ELCP1, LVS, EPSCA, A, DELTA, FNET, RAD
+
+    REAL, PARAMETER      :: ELCP = 2.4888E+3, LSUBC = 2.501000E+6,CP = 1004.6
+    REAL, PARAMETER      :: LSUBS = 2.83E+6
+
+! ----------------------------------------------------------------------
+! PREPARE PARTIAL QUANTITIES FOR PENMAN EQUATION.
+! ----------------------------------------------------------------------
+
+    IF ( T1 > 273.15 ) THEN
+       ELCP1=ELCP
+       LVS=LSUBC
+    ELSE
+       ELCP1  = ELCP*LSUBS/LSUBC
+       LVS    = LSUBS
+    ENDIF
+
+    FLX2 = 0.0
+    DELTA = ELCP1 * DQSDT2
+    RR = EMISSI * T24 * 6.48E-8 / (SFCPRS * CH) + 1.0
+
+! ----------------------------------------------------------------------
+! ADJUST THE PARTIAL SUMS / PRODUCTS WITH THE LATENT HEAT
+! EFFECTS CAUSED BY FALLING PRECIPITATION.
+! ----------------------------------------------------------------------
+
+    IF ( PRCP > 0.0 ) THEN
+       IF (.NOT. SNOWNG) THEN
+          RR = RR + CPH2O * PRCP / RCH
+       ELSE
+          RR = RR + CPICE * PRCP / RCH
+       ENDIF
+    ENDIF
+
+! ----------------------------------------------------------------------
+! INCLUDE THE LATENT HEAT EFFECTS OF FREEZING RAIN CONVERTING TO ICE ON
+! IMPACT IN THE CALCULATION OF FLX2 AND FNET.
+! ----------------------------------------------------------------------
+
+    FNET = FDOWN - EMISSI * SIGMA * T24 - SSOIL
+    IF (FRZGRA) THEN
+       FLX2 = - LSUBF * PRCP
+       FNET = FNET - FLX2
+    END IF
+
+! ----------------------------------------------------------------------
+! FINISH PENMAN EQUATION CALCULATIONS.
+! ----------------------------------------------------------------------
+
+    RAD = FNET / RCH + TH2 - SFCTMP
+    A = ELCP1 * (Q2SAT - Q2)
+    EPSCA = (A * RR + RAD * DELTA) / (DELTA + RR)
+    ETP = EPSCA * RCH / LVS
+
+! ----------------------------------------------------------------------
+  END SUBROUTINE PENMAN
+! ----------------------------------------------------------------------
+
+  SUBROUTINE SHFLX (STC,NSOIL,DT,YY,ZZ1,ZSOIL,TBOT,DF1)
+! ----------------------------------------------------------------------
+! UPDATE THE TEMPERATURE STATE OF THE SOIL COLUMN BASED ON THE THERMAL
+! DIFFUSION EQUATION.
+! ----------------------------------------------------------------------
+      IMPLICIT NONE
+
+      INTEGER,                  INTENT(IN)    :: NSOIL
+      REAL,                     INTENT(IN)    :: DF1,DT,TBOT,YY, ZZ1
+      REAL, DIMENSION(1:NSOIL), INTENT(IN)    :: ZSOIL
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: STC
+      REAL, DIMENSION(1:NSOIL)                :: AI, BI, CI, STCF,RHSTS
+      INTEGER                                 :: I
+      REAL, PARAMETER                         :: T0 = 273.15
+
+! ----------------------------------------------------------------------
+! HRTICE ROUTINE CALCS THE RIGHT HAND SIDE OF THE SOIL TEMP DIF EQN
+! ----------------------------------------------------------------------
+
+      CALL HRTICE (RHSTS,STC,TBOT,NSOIL,ZSOIL,YY,ZZ1,DF1,AI,BI,CI)
+      CALL HSTEP (STCF,STC,RHSTS,DT,NSOIL,AI,BI,CI)
+
+      DO I = 1,NSOIL
+         STC (I) = STCF (I)
+      END DO
+
+! ----------------------------------------------------------------------
+  END SUBROUTINE SHFLX
+! ----------------------------------------------------------------------
+
+  SUBROUTINE SNOPAC (ETP,ETA,PRCP,SNOWNG,            &
+       NSOIL,DT,DF1,                                 &
+       Q2,T1,SFCTMP,T24,TH2,FDOWN,SSOIL,STC,         &
+       SFCPRS,RCH,RR,SNCOVR,ESD,SNDENS,              &
+       SNOWH,ZSOIL,TBOT,                             &
+       SNOMLT,DEW,FLX1,FLX2,FLX3,ESNOW,EMISSI,       &
+       RIBB, SEAICE_ALBEDO_OPT)
+
+! ----------------------------------------------------------------------
+! SUBROUTINE SNOPAC
+! ----------------------------------------------------------------------
+! CALCULATE SOIL MOISTURE AND HEAT FLUX VALUES & UPDATE SOIL MOISTURE
+! CONTENT AND SOIL HEAT CONTENT VALUES FOR THE CASE WHEN A SNOW PACK IS
+! PRESENT.
+! ----------------------------------------------------------------------
+    IMPLICIT NONE
+
+    INTEGER, INTENT(IN)   :: NSOIL
+    INTEGER               :: K
+    LOGICAL, INTENT(IN)   :: SNOWNG
+    REAL, INTENT(IN)      :: DF1,                                     &
+         &                   DT,FDOWN,                                &
+         &                   PRCP,Q2,                                 &
+         &                   RCH,RR,SFCPRS, SFCTMP,                   &
+         &                   T24,                                     &
+         &                   TBOT,TH2,EMISSI
+    REAL, INTENT(INOUT)   :: ESD,FLX2,SNOWH,SNCOVR,                   &
+         &                   SNDENS, T1, RIBB, ETP
+    REAL, INTENT(OUT)     :: DEW,ESNOW,                               &
+         &                   FLX1,FLX3, SSOIL,SNOMLT
+    REAL, DIMENSION(1:NSOIL),INTENT(IN)     :: ZSOIL
+    REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: STC
+    REAL                  :: DENOM,DSOIL,DTOT,ETA,                    &
+         &                   ESNOW1, ESNOW2, ETA1,ETP1,ETP2,          &
+         &                   ETANRG, EX, SEH,                         &
+         &                   SNCOND,T12, T12A,                        &
+         &                   T12B, T14, YY, ZZ1
+    INTEGER, INTENT(IN)   :: SEAICE_ALBEDO_OPT
+    REAL, PARAMETER       :: ESDMIN = 1.E-6, LSUBC = 2.501000E+6,     &
+         LSUBS = 2.83E+6, SNOEXP = 2.0
+
+! ----------------------------------------------------------------------
+! SNOWCOVER FRACTION = 1.0, AND SUBLIMATION IS AT THE POTENTIAL RATE.
+! ----------------------------------------------------------------------
+! INITIALIZE EVAP TERMS.
+! ----------------------------------------------------------------------
+! conversions:
+! ESNOW [KG M-2 S-1]
+! ESNOW1 [M S-1]
+! ESNOW2 [M]
+! ETP [KG M-2 S-1]
+! ETP1 [M S-1]
+! ETP2 [M]
+! ----------------------------------------------------------------------
+    DEW = 0.
+    ESNOW = 0.
+    ESNOW1 = 0.
+    ESNOW2 = 0.
+
+! ----------------------------------------------------------------------
+! CONVERT POTENTIAL EVAP (ETP) FROM KG M-2 S-1 TO ETP1 IN M S-1
+! ----------------------------------------------------------------------
+! ----------------------------------------------------------------------
+! IF ETP<0 (DOWNWARD) THEN DEWFALL (=FROSTFALL IN THIS CASE).
+! ----------------------------------------------------------------------
+    IF (ETP <= 0.0) THEN
+       IF ( ( RIBB >= 0.1 ) .AND. ( FDOWN > 150.0 ) ) THEN
+          ETP=(MIN(ETP*(1.0-RIBB),0.)*SNCOVR/0.980 + ETP*(0.980-SNCOVR))/0.980
+       ENDIF
+       ETP1 = ETP * 0.001
+       DEW = -ETP1
+       ESNOW2 = ETP1*DT
+       ETANRG = ETP*((1.-SNCOVR)*LSUBC + SNCOVR*LSUBS)
+    ELSE
+       ETP1 = ETP * 0.001
+       ESNOW  = ETP
+       ESNOW1 = ESNOW*0.001
+       ESNOW2 = ESNOW1*DT
+       ETANRG = ESNOW*LSUBS
+       ESNOW  = ETP*SNCOVR
+       ESNOW1 = ESNOW*0.001
+       ESNOW2 = ESNOW1*DT
+       ETANRG = ESNOW*LSUBS
+    END IF
+
+! ----------------------------------------------------------------------
+! IF PRECIP IS FALLING, CALCULATE HEAT FLUX FROM SNOW SFC TO NEWLY
+! ACCUMULATING PRECIP.  NOTE THAT THIS REFLECTS THE FLUX APPROPRIATE FOR
+! THE NOT-YET-UPDATED SKIN TEMPERATURE (T1).  ASSUMES TEMPERATURE OF THE
+! SNOWFALL STRIKING THE GROUND IS =SFCTMP (LOWEST MODEL LEVEL AIR TEMP).
+! ----------------------------------------------------------------------
+    FLX1 = 0.0
+    IF (SNOWNG) THEN
+       FLX1 = CPICE * PRCP * (T1- SFCTMP)
+    ELSE
+       IF (PRCP >  0.0) FLX1 = CPH2O * PRCP * (T1- SFCTMP)
+! ----------------------------------------------------------------------
+! CALCULATE AN 'EFFECTIVE SNOW-GRND SFC TEMP' (T12) BASED ON HEAT FLUXES
+! BETWEEN THE SNOW PACK AND THE SOIL AND ON NET RADIATION.
+! INCLUDE FLX1 (PRECIP-SNOW SFC) AND FLX2 (FREEZING RAIN LATENT HEAT)
+! FLUXES.  FLX1 FROM ABOVE, FLX2 BROUGHT IN VIA COMMOM BLOCK RITE.
+! FLX2 REFLECTS FREEZING RAIN LATENT HEAT FLUX USING T1 CALCULATED IN
+! PENMAN.
+! ----------------------------------------------------------------------
+    END IF
+    DSOIL = - (0.5 * ZSOIL (1))
+    DTOT = SNOWH + DSOIL
+    DENOM = 1.0+ DF1 / (DTOT * RR * RCH)
+! surface emissivity weighted by snow cover fraction
+!      T12A = ( (FDOWN - FLX1 - FLX2 -                                   &
+!     &       ((SNCOVR*EMISSI_S)+EMISSI*(1.0-SNCOVR))*SIGMA *T24)/RCH    &
+!     &       + TH2 - SFCTMP - ETANRG/RCH ) / RR
+    T12A = ( (FDOWN - FLX1 - FLX2 - EMISSI * SIGMA * T24)/ RCH                    &
+         + TH2 - SFCTMP - ETANRG / RCH ) / RR
+
+    T12B = DF1 * STC (1) / (DTOT * RR * RCH)
+
+! ----------------------------------------------------------------------
+! IF THE 'EFFECTIVE SNOW-GRND SFC TEMP' IS AT OR BELOW FREEZING, NO SNOW
+! MELT WILL OCCUR.  SET THE SKIN TEMP TO THIS EFFECTIVE TEMP.  REDUCE
+! (BY SUBLIMINATION ) OR INCREASE (BY FROST) THE DEPTH OF THE SNOWPACK,
+! DEPENDING ON SIGN OF ETP.
+! UPDATE SOIL HEAT FLUX (SSOIL) USING NEW SKIN TEMPERATURE (T1)
+! SINCE NO SNOWMELT, SET ACCUMULATED SNOWMELT TO ZERO, SET 'EFFECTIVE'
+! PRECIP FROM SNOWMELT TO ZERO, SET PHASE-CHANGE HEAT FLUX FROM SNOWMELT
+! TO ZERO.
+! ----------------------------------------------------------------------
+! SUB-FREEZING BLOCK
+! ----------------------------------------------------------------------
+    T12 = (SFCTMP + T12A + T12B) / DENOM
+    IF (T12 <=  TFREEZ) THEN
+       T1 = T12
+       SSOIL = DF1 * (T1- STC (1)) / DTOT
+!        ESD = MAX (0.0, ESD- ETP2)
+       ESD = MAX(0.0, ESD-ESNOW2)
+       FLX3 = 0.0
+       EX = 0.0
+
+       SNOMLT = 0.0
+! ----------------------------------------------------------------------
+! IF THE 'EFFECTIVE SNOW-GRND SFC TEMP' IS ABOVE FREEZING, SNOW MELT
+! WILL OCCUR.  CALL THE SNOW MELT RATE,EX AND AMT, SNOMLT.  REVISE THE
+! EFFECTIVE SNOW DEPTH.  REVISE THE SKIN TEMP BECAUSE IT WOULD HAVE CHGD
+! DUE TO THE LATENT HEAT RELEASED BY THE MELTING. CALC THE LATENT HEAT
+! RELEASED, FLX3.  ADJUSTMENT TO T1 TO ACCOUNT FOR SNOW PATCHES.
+! CALCULATE QSAT VALID AT FREEZING POINT.  NOTE THAT ESAT (SATURATION
+! VAPOR PRESSURE) VALUE OF 6.11E+2 USED HERE IS THAT VALID AT FRZZING
+! POINT.  NOTE THAT ETP FROM CALL PENMAN IN SFLX IS IGNORED HERE IN
+! FAVOR OF BULK ETP OVER 'OPEN WATER' AT FREEZING TEMP.
+! UPDATE SOIL HEAT FLUX (S) USING NEW SKIN TEMPERATURE (T1)
+! ----------------------------------------------------------------------
+! ABOVE FREEZING BLOCK
+! ----------------------------------------------------------------------
+    ELSE
+       T1 = TFREEZ 
+       SSOIL = DF1 * (T1- STC (1)) / DTOT
+
+! ----------------------------------------------------------------------
+! IF POTENTIAL EVAP (SUBLIMATION) GREATER THAN DEPTH OF SNOWPACK.
+! SNOWPACK HAS SUBLIMATED AWAY, SET DEPTH TO ZERO.
+! ----------------------------------------------------------------------
+
+       IF (ESD-ESNOW2 <= ESDMIN) THEN
+          ESD = 0.0
+          EX = 0.0
+          SNOMLT = 0.0
+          FLX3 = 0.0
+! ----------------------------------------------------------------------
+! SUBLIMATION LESS THAN DEPTH OF SNOWPACK
+! SNOWPACK (ESD) REDUCED BY ESNOW2 (DEPTH OF SUBLIMATED SNOW)
+! ----------------------------------------------------------------------
+       ELSE
+          ESD = ESD-ESNOW2
+          SEH = RCH * (T1- TH2)
+          T14 = ( T1 * T1 ) * ( T1 * T1 )
+          FLX3 = FDOWN - FLX1- FLX2- EMISSI*SIGMA * T14- SSOIL - SEH - ETANRG
+          IF (FLX3 <= 0.0) FLX3 = 0.0
+! ----------------------------------------------------------------------
+! SNOWMELT REDUCTION DEPENDING ON SNOW COVER
+! ----------------------------------------------------------------------
+          EX = FLX3*0.001/ LSUBF
+
+! ----------------------------------------------------------------------
+! ESDMIN REPRESENTS A SNOWPACK DEPTH THRESHOLD VALUE BELOW WHICH WE
+! CHOOSE NOT TO RETAIN ANY SNOWPACK, AND INSTEAD INCLUDE IT IN SNOWMELT.
+! ----------------------------------------------------------------------
+          SNOMLT = EX * DT
+          IF (ESD- SNOMLT >=  ESDMIN) THEN
+             ESD = ESD- SNOMLT
+          ELSE
+             !
+             ! SNOWMELT EXCEEDS SNOW DEPTH
+             !
+             EX = ESD / DT
+             FLX3 = EX *1000.0* LSUBF
+             SNOMLT = ESD
+
+             ESD = 0.0
+          ENDIF
+       ENDIF
+
+! ----------------------------------------------------------------------
+! END OF 'T12 .LE. TFREEZ' IF-BLOCK
+! ----------------------------------------------------------------------
+
+    ENDIF
+
+! ----------------------------------------------------------------------
+! FOR SEA-ICE, THE SNOWMELT WILL BE ADDED TO SUBSURFACE
+! RUNOFF/BASEFLOW LATER NEAR THE END OF SFLX (AFTER RETURN FROM CALL TO
+! SUBROUTINE SNOPAC)
+! ----------------------------------------------------------------------
+! ----------------------------------------------------------------------
+! SET THE EFFECTIVE POTNL EVAPOTRANSP (ETP1) TO ZERO SINCE THIS IS SNOW
+! CASE, SO SURFACE EVAP NOT CALCULATED FROM EDIR IN SMFLX (BELOW).
+! IF SEAICE (ICE==1) SKIP CALL TO SMFLX, SINCE NO SOIL MEDIUM FOR SEA-ICE
+! ----------------------------------------------------------------------
+! ----------------------------------------------------------------------
+! BEFORE CALL SHFLX IN THIS SNOWPACK CASE, SET ZZ1 AND YY ARGUMENTS TO
+! SPECIAL VALUES THAT ENSURE THAT GROUND HEAT FLUX CALCULATED IN SHFLX
+! MATCHES THAT ALREADY COMPUTED FOR BELOW THE SNOWPACK, THUS THE SFC
+! HEAT FLUX TO BE COMPUTED IN SHFLX WILL EFFECTIVELY BE THE FLUX AT THE
+! SNOW TOP SURFACE.
+! ----------------------------------------------------------------------
+
+    ZZ1 = 1.0
+    YY = STC (1) -0.5* SSOIL * ZSOIL (1)* ZZ1/ DF1
+
+! ----------------------------------------------------------------------
+! SHFLX WILL CALC/UPDATE THE ICE TEMPS.
+! ----------------------------------------------------------------------
+
+    CALL SHFLX (STC,NSOIL,DT,YY,ZZ1,ZSOIL,TBOT,DF1)
+
+! ----------------------------------------------------------------------
+! SNOW DEPTH AND DENSITY ADJUSTMENT BASED ON SNOW COMPACTION.  YY IS
+! ASSUMED TO BE THE SOIL TEMPERTURE AT THE TOP OF THE SOIL COLUMN.
+! ----------------------------------------------------------------------
+    SELECT CASE ( SEAICE_ALBEDO_OPT )
+
+    CASE DEFAULT
+
+       IF (ESD .GE. 0.01) THEN
+          CALL SNOWPACK (ESD,DT,SNOWH,SNDENS,T1,YY)
+       ELSE
+          ESD = 0.01
+          SNOWH = 0.05
+!KWM???? SNDENS =
+!KWM???? SNCOND =
+          SNCOVR = 1.0
+       ENDIF
+
+    CASE ( 1 ) ! Arctic sea-ice albedo from Mills (2011)
+
+       IF ( ESD >= 0.0001 ) THEN
+          CALL SNOWPACK (ESD,DT,SNOWH,SNDENS,T1,YY)
+       ELSE
+          ESD    = 0.0001
+          SNOWH  = 0.0005
+          SNCOVR = 0.005
+       ENDIF
+
+    END SELECT
+! ----------------------------------------------------------------------
+  END SUBROUTINE SNOPAC
+! ----------------------------------------------------------------------
+
+      SUBROUTINE SNOWPACK (ESD,DTSEC,SNOWH,SNDENS,TSNOW,TSOIL)
+
+! ----------------------------------------------------------------------
+! SUBROUTINE SNOWPACK
+! ----------------------------------------------------------------------
+! CALCULATE COMPACTION OF SNOWPACK UNDER CONDITIONS OF INCREASING SNOW
+! DENSITY, AS OBTAINED FROM AN APPROXIMATE SOLUTION OF E. ANDERSON'S
+! DIFFERENTIAL EQUATION (3.29), NOAA TECHNICAL REPORT NWS 19, BY VICTOR
+! KOREN, 03/25/95.
+! ----------------------------------------------------------------------
+! ESD     WATER EQUIVALENT OF SNOW (M)
+! DTSEC   TIME STEP (SEC)
+! SNOWH   SNOW DEPTH (M)
+! SNDENS  SNOW DENSITY (G/CM3=DIMENSIONLESS FRACTION OF H2O DENSITY)
+! TSNOW   SNOW SURFACE TEMPERATURE (K)
+! TSOIL   SOIL SURFACE TEMPERATURE (K)
+
+! SUBROUTINE WILL RETURN NEW VALUES OF SNOWH AND SNDENS
+! ----------------------------------------------------------------------
+      IMPLICIT NONE
+
+      INTEGER                :: IPOL, J
+      REAL, INTENT(IN)       :: ESD, DTSEC,TSNOW,TSOIL
+      REAL, INTENT(INOUT)    :: SNOWH, SNDENS
+      REAL                   :: BFAC,DSX,DTHR,DW,SNOWHC,PEXP,           &
+                                TAVGC,TSNOWC,TSOILC,ESDC,ESDCX
+      REAL, PARAMETER        :: C1 = 0.01, C2 = 21.0, G = 9.81,         &
+                                KN = 4000.0
+! ----------------------------------------------------------------------
+! CONVERSION INTO SIMULATION UNITS
+! ----------------------------------------------------------------------
+      SNOWHC = SNOWH *100.
+      ESDC = ESD *100.
+      DTHR = DTSEC /3600.
+      TSNOWC = TSNOW -273.15
+      TSOILC = TSOIL -273.15
+
+! ----------------------------------------------------------------------
+! CALCULATING OF AVERAGE TEMPERATURE OF SNOW PACK
+! ----------------------------------------------------------------------
+! ----------------------------------------------------------------------
+! CALCULATING OF SNOW DEPTH AND DENSITY AS A RESULT OF COMPACTION
+!  SNDENS=DS0*(EXP(BFAC*ESD)-1.)/(BFAC*ESD)
+!  BFAC=DTHR*C1*EXP(0.08*TAVGC-C2*DS0)
+! NOTE: BFAC*ESD IN SNDENS EQN ABOVE HAS TO BE CAREFULLY TREATED
+! NUMERICALLY BELOW:
+!   C1 IS THE FRACTIONAL INCREASE IN DENSITY (1/(CM*HR))
+!   C2 IS A CONSTANT (CM3/G) KOJIMA ESTIMATED AS 21 CMS/G
+! ----------------------------------------------------------------------
+      TAVGC = 0.5* (TSNOWC + TSOILC)
+      IF (ESDC >  1.E-2) THEN
+         ESDCX = ESDC
+      ELSE
+         ESDCX = 1.E-2
+      END IF
+
+!      DSX = SNDENS*((DEXP(BFAC*ESDC)-1.)/(BFAC*ESDC))
+! ----------------------------------------------------------------------
+! THE FUNCTION OF THE FORM (e**x-1)/x EMBEDDED IN ABOVE EXPRESSION
+! FOR DSX WAS CAUSING NUMERICAL DIFFICULTIES WHEN THE DENOMINATOR "x"
+! (I.E. BFAC*ESDC) BECAME ZERO OR APPROACHED ZERO (DESPITE THE FACT THAT
+! THE ANALYTICAL FUNCTION (e**x-1)/x HAS A WELL DEFINED LIMIT AS
+! "x" APPROACHES ZERO), HENCE BELOW WE REPLACE THE (e**x-1)/x
+! EXPRESSION WITH AN EQUIVALENT, NUMERICALLY WELL-BEHAVED
+! POLYNOMIAL EXPANSION.
+
+! NUMBER OF TERMS OF POLYNOMIAL EXPANSION, AND HENCE ITS ACCURACY,
+! IS GOVERNED BY ITERATION LIMIT "IPOL".
+!      IPOL GREATER THAN 9 ONLY MAKES A DIFFERENCE ON DOUBLE
+!            PRECISION (RELATIVE ERRORS GIVEN IN PERCENT %).
+!       IPOL=9, FOR REL.ERROR <~ 1.6 E-6 % (8 SIGNIFICANT DIGITS)
+!       IPOL=8, FOR REL.ERROR <~ 1.8 E-5 % (7 SIGNIFICANT DIGITS)
+!       IPOL=7, FOR REL.ERROR <~ 1.8 E-4 % ...
+! ----------------------------------------------------------------------
+      BFAC = DTHR * C1* EXP (0.08* TAVGC - C2* SNDENS)
+      IPOL = 4
+      PEXP = 0.
+!        PEXP = (1. + PEXP)*BFAC*ESDC/REAL(J+1)
+      DO J = IPOL,1, -1
+         PEXP = (1. + PEXP)* BFAC * ESDCX / REAL (J +1)
+      END DO
+
+      PEXP = PEXP + 1.
+! ----------------------------------------------------------------------
+! ABOVE LINE ENDS POLYNOMIAL SUBSTITUTION
+! ----------------------------------------------------------------------
+!     END OF KOREAN FORMULATION
+
+!     BASE FORMULATION (COGLEY ET AL., 1990)
+!     CONVERT DENSITY FROM G/CM3 TO KG/M3
+!       DSM=SNDENS*1000.0
+
+!       DSX=DSM+DTSEC*0.5*DSM*G*ESD/
+!    &      (1E7*EXP(-0.02*DSM+KN/(TAVGC+273.16)-14.643))
+
+!  &   CONVERT DENSITY FROM KG/M3 TO G/CM3
+!       DSX=DSX/1000.0
+
+!     END OF COGLEY ET AL. FORMULATION
+
+! ----------------------------------------------------------------------
+! SET UPPER/LOWER LIMIT ON SNOW DENSITY
+! ----------------------------------------------------------------------
+      DSX = SNDENS * (PEXP)
+      IF (DSX > 0.40) DSX = 0.40
+      IF (DSX < 0.05) DSX = 0.05
+! ----------------------------------------------------------------------
+! UPDATE OF SNOW DEPTH AND DENSITY DEPENDING ON LIQUID WATER DURING
+! SNOWMELT.  ASSUMED THAT 13% OF LIQUID WATER CAN BE STORED IN SNOW PER
+! DAY DURING SNOWMELT TILL SNOW DENSITY 0.40.
+! ----------------------------------------------------------------------
+      SNDENS = DSX
+      IF (TSNOWC >=  0.) THEN
+         DW = 0.13* DTHR /24.
+         SNDENS = SNDENS * (1. - DW) + DW
+         IF (SNDENS >=  0.40) SNDENS = 0.40
+! ----------------------------------------------------------------------
+! CALCULATE SNOW DEPTH (CM) FROM SNOW WATER EQUIVALENT AND SNOW DENSITY.
+! CHANGE SNOW DEPTH UNITS TO METERS
+! ----------------------------------------------------------------------
+      END IF
+      SNOWHC = ESDC / SNDENS
+      SNOWH = SNOWHC *0.01
+
+! ----------------------------------------------------------------------
+  END SUBROUTINE SNOWPACK
+! ----------------------------------------------------------------------
+
+      SUBROUTINE SNOWZ0 (SNCOVR,Z0, Z0BRD, SNOWH)
+
+! ----------------------------------------------------------------------
+! SUBROUTINE SNOWZ0
+! ----------------------------------------------------------------------
+! CALCULATE TOTAL ROUGHNESS LENGTH OVER SNOW
+! SNCOVR  FRACTIONAL SNOW COVER
+! Z0      ROUGHNESS LENGTH (m)
+! Z0S     SNOW ROUGHNESS LENGTH:=0.001 (m)
+! ----------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL, INTENT(IN)        :: SNCOVR, Z0BRD
+      REAL, INTENT(OUT)       :: Z0
+      REAL, PARAMETER         :: Z0S=0.001
+      REAL, INTENT(IN)        :: SNOWH
+      REAL                    :: BURIAL
+      REAL                    :: Z0EFF
+
+!m      Z0 = (1.- SNCOVR)* Z0BRD + SNCOVR * Z0S
+      BURIAL = 7.0*Z0BRD - SNOWH
+      IF(BURIAL.LE.0.0007) THEN
+        Z0EFF = Z0S
+      ELSE      
+        Z0EFF = BURIAL/7.0
+      ENDIF
+      
+      Z0 = (1.- SNCOVR)* Z0BRD + SNCOVR * Z0EFF
+
+! ----------------------------------------------------------------------
+  END SUBROUTINE SNOWZ0
+! ----------------------------------------------------------------------
+
+
+      SUBROUTINE SNOW_NEW (TEMP,NEWSN,SNOWH,SNDENS)
+
+! ----------------------------------------------------------------------
+! SUBROUTINE SNOW_NEW
+! ----------------------------------------------------------------------
+! CALCULATE SNOW DEPTH AND DENSITY TO ACCOUNT FOR THE NEW SNOWFALL.
+! NEW VALUES OF SNOW DEPTH & DENSITY RETURNED.
+
+! TEMP    AIR TEMPERATURE (K)
+! NEWSN   NEW SNOWFALL (M)
+! SNOWH   SNOW DEPTH (M)
+! SNDENS  SNOW DENSITY (G/CM3=DIMENSIONLESS FRACTION OF H2O DENSITY)
+! ----------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL, INTENT(IN)        :: NEWSN, TEMP
+      REAL, INTENT(INOUT)     :: SNDENS, SNOWH
+      REAL                    :: DSNEW, HNEWC, SNOWHC,NEWSNC,TEMPC
+
+! ----------------------------------------------------------------------
+! CONVERSION INTO SIMULATION UNITS
+! ----------------------------------------------------------------------
+      SNOWHC = SNOWH *100.
+      NEWSNC = NEWSN *100.
+
+! ----------------------------------------------------------------------
+! CALCULATING NEW SNOWFALL DENSITY DEPENDING ON TEMPERATURE
+! EQUATION FROM GOTTLIB L. 'A GENERAL RUNOFF MODEL FOR SNOWCOVERED
+! AND GLACIERIZED BASIN', 6TH NORDIC HYDROLOGICAL CONFERENCE,
+! VEMADOLEN, SWEDEN, 1980, 172-177PP.
+!-----------------------------------------------------------------------
+      TEMPC = TEMP -273.15
+      IF (TEMPC <=  -15.) THEN
+         DSNEW = 0.05
+      ELSE
+         DSNEW = 0.05+0.0017* (TEMPC +15.)**1.5
+      END IF
+! ----------------------------------------------------------------------
+! ADJUSTMENT OF SNOW DENSITY DEPENDING ON NEW SNOWFALL
+! ----------------------------------------------------------------------
+      HNEWC = NEWSNC / DSNEW
+      IF (SNOWHC + HNEWC .LT. 1.0E-3) THEN
+         SNDENS = MAX(DSNEW,SNDENS)
+      ELSE
+         SNDENS = (SNOWHC * SNDENS + HNEWC * DSNEW)/ (SNOWHC + HNEWC)
+      ENDIF
+      SNOWHC = SNOWHC + HNEWC
+      SNOWH = SNOWHC *0.01
+
+! ----------------------------------------------------------------------
+  END SUBROUTINE SNOW_NEW
+! ----------------------------------------------------------------------
+
+END MODULE module_sf_noah_seaice
diff --git a/src/core_atmosphere/physics/physics_wrf/module_sf_noah_seaice_drv.F b/src/core_atmosphere/physics/physics_wrf/module_sf_noah_seaice_drv.F
new file mode 100644
index 0000000000..b7c34ffb7e
--- /dev/null
+++ b/src/core_atmosphere/physics/physics_wrf/module_sf_noah_seaice_drv.F
@@ -0,0 +1,502 @@
+module module_sf_noah_seaice_drv
+#if defined(mpas)
+use mpas_atmphys_utilities, only: physics_message,physics_error_fatal
+#define FATAL_ERROR(M) call physics_error_fatal( M )
+#define WRITE_MESSAGE(M) call physics_message( M )
+#else
+use module_wrf_error
+#define FATAL_ERROR(M) call wrf_error_fatal( M )
+#define WRITE_MESSAGE(M) call wrf_message( M )
+#endif
+  use module_sf_noah_seaice
+  implicit none
+contains
+  subroutine seaice_noah( SEAICE_ALBEDO_OPT, SEAICE_ALBEDO_DEFAULT, SEAICE_THICKNESS_OPT, &
+       &                  SEAICE_THICKNESS_DEFAULT, SEAICE_SNOWDEPTH_OPT,               &
+       &                  SEAICE_SNOWDEPTH_MAX, SEAICE_SNOWDEPTH_MIN,                   &
+       &                  T3D, QV3D, P8W3D, DZ8W, NUM_SOIL_LAYERS, DT, FRPCPN, SR,      &
+       &                  GLW, SWDOWN, RAINBL, SNOALB2D, QGH, XICE, XICE_THRESHOLD,     &
+       &                  ALBSI, ICEDEPTH, SNOWSI,                                      &
+       &                  TSLB, EMISS, ALBEDO, Z02D, TSK, SNOW, SNOWC, SNOWH2D, &
+       &                  CHS, CHS2, CQS2,                                              &
+       &                  RIB, ZNT, LH, HFX, QFX, POTEVP, GRDFLX, QSFC, ACSNOW,         &
+       &                  ACSNOM, SNOPCX, SFCRUNOFF, NOAHRES,                           &
+       &                  SF_URBAN_PHYSICS, B_T_BEP, B_Q_BEP, RHO,                      &
+       &                  IDS, IDE, JDS, JDE, KDS, KDE,                                 &
+       &                  IMS, IME, JMS, JME, KMS, KME,                                 &
+       &                  ITS, ITE, JTS, JTE, KTS, KTE  )
+#if defined(wrfmodel)
+#if (NMM_CORE != 1)
+    USE module_state_description, ONLY : NOAHUCMSCHEME
+    USE module_state_description, ONLY : BEPSCHEME
+    USE module_state_description, ONLY : BEP_BEMSCHEME
+#endif
+#endif
+    implicit none
+
+    INTEGER, INTENT(IN)       ::               SEAICE_ALBEDO_OPT
+    REAL   , INTENT(IN)       ::               SEAICE_ALBEDO_DEFAULT
+    INTEGER, INTENT(IN)       ::               SEAICE_THICKNESS_OPT
+    REAL,    INTENT(IN)       ::               SEAICE_THICKNESS_DEFAULT
+    INTEGER, INTENT(IN)       ::               SEAICE_SNOWDEPTH_OPT
+    REAL,    INTENT(IN)       ::               SEAICE_SNOWDEPTH_MAX
+    REAL,    INTENT(IN)       ::               SEAICE_SNOWDEPTH_MIN
+
+    INTEGER, INTENT(IN)       ::                            IDS, &
+         &                                                  IDE, &
+         &                                                  JDS, &
+         &                                                  JDE, &
+         &                                                  KDS, &
+         &                                                  KDE
+
+    INTEGER, INTENT(IN)       ::                            IMS, &
+         &                                                  IME, &
+         &                                                  JMS, &
+         &                                                  JME, &
+         &                                                  KMS, &
+         &                                                  KME
+
+    INTEGER, INTENT(IN)       ::                            ITS, &
+         &                                                  ITE, &
+         &                                                  JTS, &
+         &                                                  JTE, &
+         &                                                  KTS, &
+         &                                                  KTE
+
+    REAL,    DIMENSION( ims:ime, kms:kme, jms:jme )            , &
+         &   INTENT (IN)      ::                            T3D, &
+         &                                                 QV3D, &
+         &                                                P8W3D, &
+         &                                                 DZ8W
+
+    REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+         &   INTENT (IN)      ::                             SR, &
+         &                                                  GLW, &
+         &                                                  QGH, &
+         &                                               SWDOWN, &
+         &                                               RAINBL, &
+         &                                             SNOALB2D, &
+         &                                                 XICE, &
+         &                                                  RIB
+
+    LOGICAL, INTENT (IN)      :: FRPCPN
+    REAL   , INTENT (IN)      :: DT
+    INTEGER, INTENT (IN)      :: NUM_SOIL_LAYERS
+    REAL   , INTENT (IN)      :: XICE_THRESHOLD
+
+    REAL,     DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &
+         INTENT(INOUT)   ::                            TSLB
+
+    REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+         &   INTENT (INOUT)   ::                          EMISS, &
+         &                                               ALBEDO, &
+         &                                                ALBSI, &
+         &                                                 Z02D, &
+         &                                                 SNOW, &
+         &                                                  TSK, &
+         &                                                SNOWC, &
+         &                                              SNOWH2D, &
+         &                                                  CHS, &
+         &                                                 CQS2
+
+    REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+         &   INTENT (OUT)     ::                            HFX, &
+         &                                                   LH, &
+         &                                                  QFX, &
+         &                                                  ZNT, &
+         &                                               POTEVP, &
+         &                                               GRDFLX, &
+         &                                                 QSFC, &
+         &                                               ACSNOW, &
+         &                                               ACSNOM, &
+         &                                               SNOPCX, &
+         &                                            SFCRUNOFF, &
+         &                                              NOAHRES, &
+         &                                                 CHS2
+
+    REAL,    DIMENSION( ims:ime, jms:jme )                      ,&
+         &   INTENT(INOUT)    ::                         SNOWSI
+
+    REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+         &   INTENT (INOUT)   ::                        ICEDEPTH
+
+    INTEGER, INTENT (IN)      ::               SF_URBAN_PHYSICS
+    REAL,    OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme )  , &
+         &   INTENT (INOUT)   ::                        B_Q_BEP, &
+         &                                              B_T_BEP
+    REAL,    OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme )  , &
+         &   INTENT (IN)      ::                            RHO
+
+    INTEGER :: I
+    INTEGER :: J
+    REAL    :: FFROZP
+    REAL    :: ZLVL
+    INTEGER :: NSOIL
+    REAL    :: LWDN
+    REAL    :: SOLNET
+    REAL    :: SFCPRS
+    REAL    :: PRCP
+    REAL    :: SFCTMP
+    REAL    :: Q2
+    REAL    :: TH2
+    REAL    :: Q2SAT
+    REAL    :: DQSDT2
+    REAL    :: SNOALB
+    REAL    :: TBOT
+    REAL    :: SITHICK
+
+    REAL    :: ALBEDOK
+    REAL    :: ALBBRD
+    REAL    :: Z0BRD
+    REAL    :: EMISSI
+    REAL    :: T1
+    REAL, DIMENSION(1:NUM_SOIL_LAYERS)::  STC
+    REAL    :: SNOWH
+    REAL    :: SNEQV
+    REAL    :: CH
+    REAL    :: SNCOVR
+    REAL    :: RIBB
+
+    REAL    :: Z0
+    REAL    :: ETA
+    REAL    :: SHEAT
+    REAL    :: ETA_KINEMATIC
+    REAL    :: FDOWN
+    REAL    :: ESNOW
+    REAL    :: DEW
+    REAL    :: ETP
+    REAL    :: SSOIL
+    REAL    :: FLX1
+    REAL    :: FLX2
+    REAL    :: FLX3
+    REAL    :: SNOMLT
+    REAL    :: RUNOFF1
+    REAL    :: Q1
+
+    REAL    :: APES
+    REAL    :: APELM
+    REAL    :: PSFC
+    REAL    :: SFCTSNO
+    REAL    :: E2SAT
+    REAL    :: Q2SATI
+    INTEGER :: NS
+    REAL    :: FDTW
+    REAL    :: FDTLIW
+    REAL    :: ALBEDOSI
+    REAL    :: SNOWONSI
+    REAL, PARAMETER  :: CAPA   = R_D / CP
+    REAL, PARAMETER  :: A2     = 17.67
+    REAL, PARAMETER  :: A3     = 273.15
+    REAL, PARAMETER  :: A4     = 29.65
+    REAL, PARAMETER  :: A23M4  = A2 * ( A3 - A4 )
+    REAL, PARAMETER  :: ROW    = 1.E3
+    REAL, PARAMETER  :: ELIW   = XLF
+    REAL, PARAMETER  :: ROWLIW = ROW * ELIW
+
+    CHARACTER(len=80) :: message
+
+    FDTLIW = DT / ROWLIW
+    FDTW   = DT / ( XLV * RHOWATER )
+
+    NSOIL  = NUM_SOIL_LAYERS
+
+    SEAICE_JLOOP : do J = JTS, JTE
+       SEAICE_ILOOP : do I = ITS, ITE
+
+          ! Skip the points that are not sea-ice points.
+          IF ( XICE(I,J) < XICE_THRESHOLD ) THEN
+              IF ( SEAICE_THICKNESS_OPT == 1 ) THEN
+                  ICEDEPTH(I,J) = 0.0
+              ENDIF
+              IF ( SEAICE_SNOWDEPTH_OPT == 1 ) THEN
+                  SNOWSI(I,J) = 0.0
+              ENDIF
+              CYCLE SEAICE_ILOOP
+          ENDIF
+
+          SELECT CASE ( SEAICE_THICKNESS_OPT )
+          CASE DEFAULT
+              WRITE(message,'("Namelist value for SEAICE_THICKNESS_OPT not recognized: ",I6)') SEAICE_THICKNESS_OPT
+              FATAL_ERROR(message)
+          CASE (0)
+              ! Use uniform sea-ice thickness.
+              SITHICK = SEAICE_THICKNESS_DEFAULT
+          CASE (1)
+              ! Use the sea-ice as read in from the input files.
+              ! Limit the to between 0.10 and 10.0 m.
+              IF ( ICEDEPTH(I,J) < -1.E6 ) THEN
+                  WRITE_MESSAGE("Field ICEDEPTH not found in input files.")
+                  WRITE_MESSAGE(".... Namelist SEAICE_THICKNESS_OPT=1 requires ICEDEPTH field.")
+                  WRITE_MESSAGE(".... Try namelist option SEAICE_THICKNESS_OPT=0.")
+                  FATAL_ERROR("SEAICE_THICKNESS_OPT")
+              ENDIF
+              SITHICK = MIN ( MAX ( 0.10 , ICEDEPTH(I,J) ) , 10.0 )
+              ICEDEPTH(I,J) = SITHICK
+          END SELECT
+
+          SFCTMP = T3D(I,1,J)
+          T1     = TSK(I,J)
+          IF ( SEAICE_ALBEDO_OPT == 2 ) THEN
+              IF ( ALBSI(I,J) < -1.E6 ) THEN
+                  FATAL_ERROR("Field ALBSI not found in input.  Field ALBSI is required if SEAICE_ALBEDO_OPT=2")
+              ENDIF
+              SNOALB = ALBSI(I,J)
+              ALBEDO(I,J) = ALBSI(I,J)
+              ALBEDOK = ALBSI(I,J)
+              ALBBRD = ALBSI(I,J)
+              ALBEDOSI = ALBSI(I,J)
+          ELSE
+              SNOALB = SNOALB2D(I,J)
+          ENDIF
+          ZLVL   = 0.5 * DZ8W(I,1,J)
+          EMISSI = EMISS(I,J)               ! But EMISSI might change in SFLX_SEAICE
+          LWDN   = GLW(I,J) * EMISSI        ! But EMISSI might change in SFLX_SEAICE
+
+          ! convert snow water equivalent from mm to meter
+          SNEQV = SNOW(I,J) * 0.001
+
+          ! snow depth in meters
+          SNOWH = SNOWH2D(I,J)
+          SNCOVR = SNOWC(I,J)
+
+          ! Use mid-day albedo to determine net downward solar (no solar zenith angle correction)
+          SOLNET = SWDOWN(I,J) * (1.-ALBEDO(I,J))   ! But ALBEDO might change after SFLX_SEAICE
+
+          ! Pressure in middle of lowest layer.  Why don't we use the true surface pressure?
+          ! Are there places where we would need to use the true surface pressure?
+          SFCPRS = ( P8W3D(I,KTS+1,j) + P8W3D(I,KTS,J) ) * 0.5
+
+          ! surface pressure
+          PSFC   = P8W3D(I,1,J)
+
+          ! Convert lowest model level humidity from mixing ratio to specific humidity
+          Q2     = QV3D(I,1,J) / ( 1.0 + QV3D(I,1,J) )
+
+          ! Calculate TH2 via Exner function
+          APES   = ( 1.E5 / PSFC )   ** CAPA
+          APELM  = ( 1.E5 / SFCPRS ) ** CAPA
+          TH2    = ( SFCTMP * APELM ) / APES
+
+          ! Q2SAT is specific humidity
+          Q2SAT  = QGH(I,J) / ( 1.0 + QGH(I,J) )
+          DQSDT2 = Q2SAT * A23M4 / ( SFCTMP - A4 ) ** 2
+
+          SELECT CASE ( SEAICE_SNOWDEPTH_OPT )
+          CASE DEFAULT
+              
+              WRITE(message,'("Namelist value for SEAICE_SNOWDEPTH_OPT not recognized: ",I6)') SEAICE_SNOWDEPTH_OPT
+              FATAL_ERROR(message)
+
+          CASE ( 0 )
+
+              ! Minimum and maximum bounds on snow depth are enforced in SFLX_SEAICE
+
+          CASE ( 1 ) 
+
+              ! Snow depth on sea ice comes from a 2D array, SNOWSI, bounded by user-specified
+              ! minimum and maximum values.  No matter what anybody else says about snow 
+              ! accumulation and melt, we want the snow depth on sea ice to be specified
+              ! as SNOWSI (bounded by SEAICE_SNOWDEPTH_MIN and SEAICE_SNOWDEPTH_MAX).
+              SNOWONSI = MAX ( SEAICE_SNOWDEPTH_MIN , MIN ( SNOWSI(I,J) , SEAICE_SNOWDEPTH_MAX ) )
+              SNEQV = SNOWONSI * 0.3
+              SNOWH2D(I,J) = SNOWONSI
+
+          END SELECT
+
+          IF ( SNOW(I,J) .GT. 0.0 ) THEN
+             ! If snow on surface, use ice saturation properties
+             SFCTSNO = SFCTMP ! Lowest model Air temperature
+             E2SAT = 611.2 * EXP ( 6174. * ( 1./273.15 - 1./SFCTSNO ) )
+             Q2SATI = 0.622 * E2SAT / ( SFCPRS - E2SAT )
+             Q2SATI = Q2SATI / ( 1.0 + Q2SATI )    ! Convert to specific humidity
+             ! T1 is skin temperature
+             IF (T1 .GT. 273.14) THEN
+                ! Warm ground temps, weight the saturation between ice and water according to SNOWC
+                Q2SAT = Q2SAT * (1.-SNOWC(I,J)) + Q2SATI * SNOWC(I,J)
+                DQSDT2 = DQSDT2 * (1.-SNOWC(I,J)) + Q2SATI * 6174. / (SFCTSNO**2) * SNOWC(I,J)
+             ELSE
+                ! Cold ground temps, use ice saturation only
+                Q2SAT = Q2SATI
+                DQSDT2 = Q2SATI * 6174. / (SFCTSNO**2)
+             ENDIF
+             IF ( ( T1 .GT. 273. ) .AND. ( SNOWC(I,J) .GT. 0.0 ) ) THEN   
+                ! If (SNOW > 0) can we have (SNOWC <= 0) ?  Perhaps not, so the check on 
+                ! SNOWC here might be superfluous.
+                DQSDT2 = DQSDT2 * ( 1. - SNOWC(I,J) )
+             ENDIF
+          ENDIF
+
+          PRCP = RAINBL(I,J) / DT
+
+          ! If "SR" is present, set frac of frozen precip ("FFROZP") = snow-ratio ("SR", range:0-1)
+          ! SR from e.g. Ferrier microphysics
+          ! otherwise define from 1st atmos level temperature
+
+          IF (FRPCPN) THEN
+             FFROZP = SR(I,J)
+          ELSE
+             IF (SFCTMP <=  273.15) THEN
+                FFROZP = 1.0
+             ELSE
+                FFROZP = 0.0
+             ENDIF
+          ENDIF
+
+          ! Sea-ice point has deep-level temperature of about -1.8 C
+          TBOT = 271.36
+          ! TBOT=273.15  ! appropriate value for lake ice.
+
+          ! INTENT(IN) for SFLX_SEAICE, values unchanged by SFLX_SEAICE
+          !       I           --
+          !       J           --
+          !       FFROZP      --
+          !       DT          --
+          !       ZLVL        --
+          !       NSOIL       --
+          !       LWDN        --
+          !       SOLNET      --
+          !       SFCPRS      --
+          !       PRCP        --
+          !       SFCTMP      --
+          !       Q2          --
+          !       TH2         --
+          !       Q2SAT       --
+          !       DQSDT2      --
+          !       SNOALB      --
+          !       TBOT        --
+
+          Z0BRD  = Z02D(I,J)
+
+          DO NS = 1, NSOIL
+             STC(NS) = TSLB(I,NS,J)
+          ENDDO
+
+          CH = CHS(I,J)
+          RIBB = RIB(I,J)
+
+          ! INTENT(INOUT) for SFLX_SEAICE, values updated by SFLX_SEAICE
+          !       Z0BRD       --
+          !       EMISSI      --
+          !       T1          --
+          !       STC         --
+          !       SNOWH       --
+          !       SNEQV       --
+          !       SNCOVR      --
+          !       CH          -- but the result isn't used for anything.
+          !                      Might as well be intent in to SFLX_SEAICE and changed locally in 
+          !                      that routine?
+          !       RIBB        -- but the result isn't used for anything.  
+          !                      Might as well be intent in to SFLX_SEAICE and changed locally in 
+          !                      that routine?
+
+          ! INTENT(OUT) for SFLX_SEAICE.  Input value should not matter.
+          Z0               = -1.E36
+          ETA              = -1.E36
+          SHEAT            = -1.E36
+          ETA_KINEMATIC    = -1.E36
+          FDOWN            = -1.E36  ! Returned value unused.  Might as well be local to SFLX_SEAICE ?
+          ESNOW            = -1.E36  ! Returned value unused.  Might as well be local to SFLX_SEAICE ?
+          DEW              = -1.E36  ! Returned value unused.  Might as well be local to SFLX_SEAICE ?
+          ETP              = -1.E36
+          SSOIL            = -1.E36
+          FLX1             = -1.E36
+          FLX2             = -1.E36
+          FLX3             = -1.E36
+          SNOMLT           = -1.E36
+          RUNOFF1          = -1.E36
+          Q1               = -1.E36
+
+          call sflx_seaice(I, J, SEAICE_ALBEDO_OPT, SEAICE_ALBEDO_DEFAULT,  &    !C
+               &           SEAICE_SNOWDEPTH_OPT, SEAICE_SNOWDEPTH_MAX,      &    !C
+               &           SEAICE_SNOWDEPTH_MIN,                            &    !C
+               &           FFROZP, DT, ZLVL, NSOIL,                         &    !C
+               &           SITHICK,                                         &
+               &           LWDN, SOLNET, SFCPRS, PRCP, SFCTMP, Q2,          &    !F
+               &           TH2, Q2SAT, DQSDT2,                              &    !I
+               &           SNOALB, TBOT, Z0BRD, Z0, EMISSI,                 &    !S
+               &           T1, STC, SNOWH, SNEQV, ALBEDOK, CH,              &    !H
+               &           ALBEDOSI, SNOWONSI,                              &
+               &           ETA, SHEAT, ETA_KINEMATIC, FDOWN,                &    !O
+               &           ESNOW, DEW, ETP, SSOIL, FLX1, FLX2, FLX3,        &    !O
+               &           SNOMLT, SNCOVR,                                  &    !O
+               &           RUNOFF1, Q1, RIBB)
+
+          ! Update our 2d arrays with results from SFLX_SEAICE
+          ALBEDO(I,J)  = ALBEDOK
+          EMISS(I,J)   = EMISSI
+          TSK(I,J)     = T1
+          Z02D(I,J)    = Z0BRD
+          SNOWH2D(I,J) = SNOWH
+          SNOWC(I,J)   = SNCOVR
+
+          ! Convert snow water equivalent from (m) back to (mm)
+          SNOW(I,J)    = SNEQV * 1000.
+
+          ! Update our ice temperature array with results from SFLX_SEAICE
+          DO NS = 1,NSOIL
+             TSLB(I,NS,J) = STC(NS)
+          ENDDO
+
+          ! Intent (OUT) from SFLX_SEAICE
+          ZNT(I,J)    = Z0
+          LH(I,J)     = ETA
+          HFX(I,J)    = SHEAT
+          QFX(I,J)    = ETA_KINEMATIC
+          POTEVP(I,J) = POTEVP(I,J) + ETP*FDTW
+          GRDFLX(I,J) = SSOIL
+
+          ! Exchange Coefficients
+          CHS2(I,J) = CQS2(I,J)
+          IF (Q1 .GT. QSFC(I,J)) THEN
+             CQS2(I,J) = CHS(I,J)
+          ENDIF
+
+          ! Convert QSFC term back to Mixing Ratio.
+          QSFC(I,J)   = Q1 / ( 1.0 - Q1 )
+
+          IF ( SEAICE_SNOWDEPTH_OPT == 1 ) THEN
+              SNOWSI(I,J) = SNOWONSI
+          ENDIF
+
+          ! Accumulated snow precipitation.
+          IF ( FFROZP .GT. 0.5 ) THEN
+             ACSNOW(I,J) = ACSNOW(I,J) + PRCP * DT
+          ENDIF
+
+          ! Accumulated snow melt.
+          ACSNOM(I,J) = ACSNOM(I,J) + SNOMLT * 1000.
+
+          ! Accumulated snow-melt energy.
+          SNOPCX(I,J) = SNOPCX(I,J) - SNOMLT/FDTLIW
+
+          ! Surface runoff
+          SFCRUNOFF(I,J) = SFCRUNOFF(I,J) + RUNOFF1 * DT * 1000.0
+
+          !
+          ! Residual of surface energy balance terms
+          !
+          NOAHRES(I,J) = ( SOLNET + LWDN ) &
+               &         - SHEAT + SSOIL - ETA &
+               &         - ( EMISSI * STBOLT * (T1**4) ) &
+               &         - FLX1 - FLX2 - FLX3
+#if defined(wrfmodel)
+#if (NMM_CORE != 1)
+          IF ( ( SF_URBAN_PHYSICS == NOAHUCMSCHEME ) .OR. &
+               (SF_URBAN_PHYSICS == BEPSCHEME )      .OR. &
+               ( SF_URBAN_PHYSICS == BEP_BEMSCHEME ) ) THEN
+             if ( PRESENT (B_T_BEP) ) then
+                B_T_BEP(I,1,J)=hfx(i,j)/dz8w(i,1,j)/rho(i,1,j)/CP
+             endif
+             if ( PRESENT (B_Q_BEP) ) then
+                B_Q_BEP(I,1,J)=qfx(i,j)/dz8w(i,1,j)/rho(i,1,j)
+             endif
+          ENDIF
+#endif
+#endif
+
+       enddo SEAICE_ILOOP
+    enddo SEAICE_JLOOP
+
+  end subroutine seaice_noah
+
+end module module_sf_noah_seaice_drv
diff --git a/src/core_atmosphere/physics/physics_wrf/module_sf_noahdrv.F b/src/core_atmosphere/physics/physics_wrf/module_sf_noahdrv.F
index 35590a5fe2..3dde0130d4 100644
--- a/src/core_atmosphere/physics/physics_wrf/module_sf_noahdrv.F
+++ b/src/core_atmosphere/physics/physics_wrf/module_sf_noahdrv.F
@@ -1,11 +1,31 @@
 MODULE module_sf_noahdrv
 
 !-------------------------------
-  USE module_sf_noahlsm
-  USE module_sf_urban
-  USE module_sf_bep
-  USE module_sf_bep_bem
-#ifdef WRF_CHEM
+  USE module_sf_noahlsm,  only: SFLX, XLF, XLV, CP, R_D, RHOWATER, NATURAL, SHDTBL, LUTYPE, SLTYPE, STBOLT, &
+      &                         KARMAN, LUCATS, NROTBL, RSTBL, RGLTBL, HSTBL, SNUPTBL, MAXALB, LAIMINTBL,   &
+      &                         LAIMAXTBL, Z0MINTBL, Z0MAXTBL, ALBEDOMINTBL, ALBEDOMAXTBL, EMISSMINTBL,     &
+      &                         EMISSMAXTBL, TOPT_DATA, CMCMAX_DATA, CFACTR_DATA, RSMAX_DATA, BARE, NLUS,   &
+      &                         SLCATS, BB, DRYSMC, F11, MAXSMC, REFSMC, SATPSI, SATDK, SATDW, WLTSMC, QTZ, &
+      &                         NSLTYPE, SLPCATS, SLOPE_DATA, SBETA_DATA, FXEXP_DATA, CSOIL_DATA,           &
+      &                         SALP_DATA, REFDK_DATA, REFKDT_DATA, FRZK_DATA, ZBOT_DATA, CZIL_DATA,        &
+      &                         SMLOW_DATA, SMHIGH_DATA, LVCOEF_DATA, NSLOPE, &
+      &                         FRH2O,ZTOPVTBL,ZBOTVTBL, &
+      &                         LOW_DENSITY_RESIDENTIAL, HIGH_DENSITY_RESIDENTIAL, HIGH_INTENSITY_INDUSTRIAL
+
+  USE module_sf_urban,    only: urban, oasis, IRI_SCHEME
+  USE module_sf_noahlsm_glacial_only, only: sflx_glacial
+  USE module_sf_bep,      only: bep
+  USE module_sf_bep_bem,  only: bep_bem
+#if defined(mpas)
+use mpas_atmphys_date_time, only: cal_mon_day
+use mpas_atmphys_utilities, only: physics_error_fatal
+#define FATAL_ERROR(M) call physics_error_fatal( M )
+#else
+ use module_ra_gfdleta,  only: cal_mon_day
+ use module_wrf_error
+#define FATAL_ERROR(M) call wrf_error_fatal( M )
+#endif
+#if ( WRF_CHEM == 1 )
   USE module_data_gocart_dust
 #endif
 !-------------------------------
@@ -36,12 +56,15 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
                   XICE_THRESHOLD,                               &
                   RDLAI2D,USEMONALB,                            &
                   RIB,                                          & !?
-                  NOAHRES,                                      &
+                  NOAHRES,opt_thcnd,                            &
+! Noah UA changes
+                  ua_phys,flx4_2d,fvb_2d,fbur_2d,fgsn_2d,       &
                   ids,ide, jds,jde, kds,kde,                    &
                   ims,ime, jms,jme, kms,kme,                    &
                   its,ite, jts,jte, kts,kte,                    &
                   sf_urban_physics,                             &
                   CMR_SFCDIF,CHR_SFCDIF,CMC_SFCDIF,CHC_SFCDIF,  &
+                  CMGR_SFCDIF,CHGR_SFCDIF,                      &
 !Optional Urban
                   TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !H urban
                   UC_URB2D,                                     & !H urban
@@ -55,8 +78,14 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
                   XLAT_URB2D,                                   & !I urban
                   num_roof_layers, num_wall_layers,             & !I urban
                   num_road_layers, DZR, DZB, DZG,               & !I urban
+                  CMCR_URB2D,TGR_URB2D,TGRL_URB3D,SMR_URB3D,    & !H urban
+                  DRELR_URB2D,DRELB_URB2D,DRELG_URB2D,          & !H urban
+                  FLXHUMR_URB2D,FLXHUMB_URB2D,FLXHUMG_URB2D,    & !H urban
+                  julian, julyr,                                & !H urban
                   FRC_URB2D,UTYPE_URB2D,                        & !O
                   num_urban_layers,                             & !I multi-layer urban
+                  num_urban_hi,                                 & !I multi-layer urban
+                  tsk_rural_bep,                                & !H multi-layer urban
                   trb_urb4d,tw1_urb4d,tw2_urb4d,tgb_urb4d,      & !H multi-layer urban
                   tlev_urb3d,qlev_urb3d,                        & !H multi-layer urban
                   tw1lev_urb3d,tw2lev_urb3d,                    & !H multi-layer urban
@@ -65,12 +94,17 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
                   sfvent_urb3d,lfvent_urb3d,                    & !H multi-layer urban
                   sfwin1_urb3d,sfwin2_urb3d,                    & !H multi-layer urban
                   sfw1_urb3d,sfw2_urb3d,sfr_urb3d,sfg_urb3d,    & !H multi-layer urban
+                  lp_urb2d,hi_urb2d,lb_urb2d,hgt_urb2d,         & !H multi-layer urban
+                  mh_urb2d,stdh_urb2d,lf_urb2d,                 & !SLUCM
                   th_phy,rho,p_phy,ust,                         & !I multi-layer urban
                   gmt,julday,xlong,xlat,                        & !I multi-layer urban
                   a_u_bep,a_v_bep,a_t_bep,a_q_bep,              & !O multi-layer urban
                   a_e_bep,b_u_bep,b_v_bep,                      & !O multi-layer urban
                   b_t_bep,b_q_bep,b_e_bep,dlg_bep,              & !O multi-layer urban
-                  dl_u_bep,sf_bep,vl_bep                         )   !O multi-layer urban         
+                  dl_u_bep,sf_bep,vl_bep,sfcheadrt,INFXSRT, soldrain      &   !O multi-layer urban         
+                 ,SDA_HFX, SDA_QFX, HFX_BOTH, QFX_BOTH, QNORM, fasdas     &   !fasdas
+                 ,RC2,XLAI2                                               &
+                  )
 
 !----------------------------------------------------------------
     IMPLICIT NONE
@@ -127,6 +161,7 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
 !-- SHDMIN      minimum areal fractional coverage of annual green vegetation
 !-- SHDMAX      maximum areal fractional coverage of annual green vegetation
 !-- XLAI        leaf area index (dimensionless)
+!-- XLAI2       leaf area index (same as XLAI) passed to output (dimensionless)
 !-- Z0BRD       Background fixed roughness length (M)
 !-- Z0          Background vroughness length (M) as function
 !-- ZNT         Time varying roughness length (M) as function
@@ -159,7 +194,7 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
 !-- ACSNOM      snow melt (mm) (water equivalent)
 !-- ACSNOW      accumulated snow fall (mm) (water equivalent)
 !-- SNOPCX      snow phase change heat flux (W/m^2)
-!-- POTEVP      accumulated potential evaporation (W/m^2)
+!-- POTEVP      accumulated potential evaporation (m)
 !-- RIB         Documentation needed!!!
 ! ----------------------------------------------------------------------
 !-- RUNOFF1     surface runoff (m s-1), not infiltrating the surface
@@ -168,8 +203,11 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
 !  important note: here RUNOFF2 is actually the sum of RUNOFF2 and RUNOFF3
 !-- RUNOFF3     numerical trunctation in excess of porosity (smcmax)
 !                  for a given soil layer at the end of a time step (m s-1).
+!SFCRUNOFF     Surface Runoff (mm)
+!UDRUNOFF      Total Underground Runoff (mm), which is the sum of RUNOFF2 and RUNOFF3
 ! ----------------------------------------------------------------------
 !-- RC          canopy resistance (s m-1)
+!-- RC2         canopy resistance (same as RC) passed to output
 !-- PC          plant coefficient (unitless fraction, 0-1) where PC*ETP = actual transp
 !-- RSMIN       minimum canopy resistance (s m-1)
 !-- RCS         incoming solar rc factor (dimensionless)
@@ -213,6 +251,15 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
    INTEGER,  INTENT(IN   )   ::  sf_urban_physics               !urban
    INTEGER,  INTENT(IN   )   ::  isurban
    INTEGER,  INTENT(IN   )   ::  isice
+   INTEGER,  INTENT(IN   )   ::  julian, julyr                  !urban
+
+!added by Wei Yu  for routing
+    REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+             INTENT(INOUT)  :: sfcheadrt,INFXSRT,soldrain 
+    real :: etpnd1
+!end added
+
+
 
    REAL,    DIMENSION( ims:ime, jms:jme )                     , &
             INTENT(IN   )    ::                            TMN, &
@@ -261,7 +308,7 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
                                                          TSLB     ! TSLB     STEMP
 
    REAL,     DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &
-             INTENT(INOUT)     ::                         SMCREL
+             INTENT(OUT)     ::                         SMCREL
 
    REAL,    DIMENSION( ims:ime, jms:jme )                     , &
             INTENT(INOUT)    ::                            TSK, & !was TGB (temperature)
@@ -291,15 +338,24 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
                                                         ALBEDO, &
                                                            ZNT
    REAL,    DIMENSION( ims:ime, jms:jme )                     , &
-            INTENT(INOUT)      ::                         NOAHRES
+            INTENT(OUT)      ::                         NOAHRES
+   INTEGER, INTENT(IN)       ::                         OPT_THCND
+
+! Noah UA changes
+   LOGICAL,                                INTENT(IN)  :: UA_PHYS
+   REAL,    DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: FLX4_2D,FVB_2D,FBUR_2D,FGSN_2D
+   REAL                                                :: FLX4,FVB,FBUR,FGSN
 
    REAL,    DIMENSION( ims:ime, jms:jme )                     , &
-               INTENT(INOUT)    ::                        CHKLOWQ
+               INTENT(OUT)    ::                        CHKLOWQ
    REAL,    DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LAI
    REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) ::        QZ0
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) ::  RC2, XLAI2
 
    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMR_SFCDIF
    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHR_SFCDIF
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMGR_SFCDIF
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHGR_SFCDIF
    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMC_SFCDIF
    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHC_SFCDIF
 ! Local variables (moved here from driver to make routine thread safe, 20031007 jm)
@@ -423,6 +479,34 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
      REAL, DIMENSION(1:num_wall_layers) :: TBL_URB  ! wall layer temp [K]
      REAL, DIMENSION(1:num_road_layers) :: TGL_URB  ! road layer temp [K]
      LOGICAL  :: LSOLAR_URB
+
+!===Yang,2014/10/08,hydrological variable for single layer UCM===
+     INTEGER :: jmonth, jday, tloc
+     INTEGER :: IRIOPTION, USOIL, DSOIL
+     REAL :: AOASIS, OMG
+     REAL :: DRELR_URB
+     REAL :: DRELB_URB
+     REAL :: DRELG_URB
+     REAL :: FLXHUMR_URB
+     REAL :: FLXHUMB_URB
+     REAL :: FLXHUMG_URB
+     REAL :: CMCR_URB
+     REAL :: TGR_URB
+     REAL, DIMENSION(1:num_roof_layers) :: SMR_URB  ! green roof layer moisture
+     REAL, DIMENSION(1:num_roof_layers) :: TGRL_URB ! green roof layer temp [K]
+
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELR_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELB_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELG_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMR_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMB_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMG_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMCR_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TGR_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TGRL_URB3D
+     REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: SMR_URB3D
+
+
 ! state variable surface_driver <--> lsm <--> urban
      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D
      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D
@@ -446,24 +530,20 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
      REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_road_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D
 
 ! output variable lsm --> surface_driver
-     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: PSIM_URB2D
-     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: PSIH_URB2D
-     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: GZ1OZ0_URB2D
-     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: U10_URB2D
-     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: V10_URB2D
-     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TH2_URB2D
-     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: Q2_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: PSIM_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: PSIH_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: GZ1OZ0_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: U10_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: V10_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: TH2_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: Q2_URB2D
 !
-     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: AKMS_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: AKMS_URB2D
 !
-!ldf (01-18-2011):
-!    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UST_URB2D
-!    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: FRC_URB2D
-!    INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: UTYPE_URB2D
-     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UST_URB2D
-     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: FRC_URB2D
-     INTEGER, OPTIONAL,DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: UTYPE_URB2D
-!end ldf.
+     REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: UST_URB2D
+     REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: FRC_URB2D
+     INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: UTYPE_URB2D
+
 
 ! output variables urban --> lsm
      REAL :: TS_URB     ! surface radiative temperature    [K]
@@ -486,14 +566,19 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
      REAL :: CHS_URB
      REAL :: CHS2_URB
      REAL :: UST_URB
+! NUDAPT Parameters urban --> lam
+     REAL :: mh_urb
+     REAL :: stdh_urb
+     REAL :: lp_urb
+     REAL :: hgt_urb
+     REAL, DIMENSION(4) :: lf_urb
 ! Variables for multi-layer UCM (Martilli et al. 2002)
    REAL, OPTIONAL, INTENT(IN  )   ::                                   GMT 
    INTEGER, OPTIONAL, INTENT(IN  ) ::                               JULDAY
    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   )        ::XLAT, XLONG
-!ldf (01-18-2011):
    INTEGER, INTENT(IN  ) ::                               NUM_URBAN_LAYERS
-!  INTEGER, OPTIONAL, INTENT(IN  ) ::                               NUM_URBAN_LAYERS
-!end ldf.
+   INTEGER, INTENT(IN  ) ::                               NUM_URBAN_HI
+   REAL, OPTIONAL, DIMENSION( ims:ime,                     jms:jme ), INTENT(INOUT) :: tsk_rural_bep
    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: trb_urb4d
    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw1_urb4d
    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw2_urb4d
@@ -515,6 +600,13 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfw2_urb3d
    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfr_urb3d
    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfg_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_hi, jms:jme ), INTENT(IN) :: hi_urb2d
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: lp_urb2d
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: lb_urb2d
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: hgt_urb2d
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: mh_urb2d
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: stdh_urb2d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 4, jms:jme ), INTENT(IN) :: lf_urb2d
    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_u_bep   !Implicit momemtum component X-direction
    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_v_bep   !Implicit momemtum component Y-direction
    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_t_bep   !Implicit component pot. temperature
@@ -531,30 +623,56 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::dl_u_bep  !Length scale
 
 ! Local variables for multi-layer UCM (Martilli et al. 2002)
-   REAL,    DIMENSION( ims:ime, jms:jme ) :: HFX_RURAL,LH_RURAL,GRDFLX_RURAL,RN_RURAL
-   REAL,    DIMENSION( ims:ime, jms:jme ) :: QFX_RURAL,QSFC_RURAL,UMOM_RURAL,VMOM_RURAL
-   REAL,    DIMENSION( ims:ime, jms:jme ) :: ALB_RURAL,EMISS_RURAL,UST_RURAL,TSK_RURAL
-!   REAL,    DIMENSION( ims:ime, jms:jme ) :: GRDFLX_URB
-!   REAL,    DIMENSION( ims:ime, jms:jme ) :: QFX_URB,QSFC_URB,UMOM_URB,VMOM_URB
-   REAL,    DIMENSION( ims:ime, jms:jme ) :: HFX_URB,UMOM_URB,VMOM_URB
-   REAL,    DIMENSION( ims:ime, jms:jme ) :: QFX_URB
+   REAL,    DIMENSION( its:ite, jts:jte ) :: HFX_RURAL,LH_RURAL,GRDFLX_RURAL ! ,RN_RURAL
+   REAL,    DIMENSION( its:ite, jts:jte ) :: QFX_RURAL ! ,QSFC_RURAL,UMOM_RURAL,VMOM_RURAL
+   REAL,    DIMENSION( its:ite, jts:jte ) :: ALB_RURAL,EMISS_RURAL,TSK_RURAL ! ,UST_RURAL
+!   REAL,    DIMENSION( ims:ime, jms:jme ) :: QSFC_URB
+   REAL,    DIMENSION( its:ite, jts:jte ) :: HFX_URB,UMOM_URB,VMOM_URB
+   REAL,    DIMENSION( its:ite, jts:jte ) :: QFX_URB
 !   REAL,    DIMENSION( ims:ime, jms:jme ) :: ALBEDO_URB,EMISS_URB,UMOM,VMOM,UST
-   REAL, DIMENSION(ims:ime,jms:jme) ::EMISS_URB
-   REAL, DIMENSION(ims:ime,jms:jme) :: RL_UP_URB
-   REAL, DIMENSION(ims:ime,jms:jme) ::RS_ABS_URB
-   REAL, DIMENSION(ims:ime,jms:jme) ::GRDFLX_URB
+   REAL, DIMENSION(its:ite,jts:jte) ::EMISS_URB
+   REAL, DIMENSION(its:ite,jts:jte) :: RL_UP_URB
+   REAL, DIMENSION(its:ite,jts:jte) ::RS_ABS_URB
+   REAL, DIMENSION(its:ite,jts:jte) ::GRDFLX_URB
    REAL :: SIGMA_SB,RL_UP_RURAL,RL_UP_TOT,RS_ABS_TOT,UMOM,VMOM
-   REAL :: r1,r2,r3
-   REAL :: CMR_URB, CHR_URB, CMC_URB, CHC_URB
+   REAL :: CMR_URB, CHR_URB, CMC_URB, CHC_URB, CMGR_URB, CHGR_URB
+   REAL :: frc_urb,lb_urb
+   REAL :: check 
 ! ----------------------------------------------------------------------
 ! DECLARATIONS END - urban
 ! ----------------------------------------------------------------------
 
   REAL, PARAMETER  :: CAPA=R_D/CP
   REAL :: APELM,APES,SFCTH2,PSFC
-
   real, intent(in) :: xice_threshold
   character(len=80) :: message_text
+!
+!  FASDAS
+!
+   REAL,    DIMENSION( ims:ime, jms:jme ),  OPTIONAL,                     &
+            INTENT(INOUT)  ::   SDA_HFX, SDA_QFX, HFX_BOTH, QFX_BOTH, QNORM
+   INTEGER, INTENT(IN   )  ::  fasdas
+!  local vars
+   REAL                    ::  XSDA_HFX, XSDA_QFX, XQNORM
+   REAL                    ::  HFX_PHY, QFX_PHY
+   REAL                    ::  DZQ
+   REAL                    ::  HCPCT_FASDAS
+
+   HFX_PHY = 0.0   ! initialize
+   QFX_PHY = 0.0
+   XQNORM  = 0.0
+   XSDA_HFX = 0.0
+   XSDA_QFX = 0.0
+!
+!  END FASDAS
+!
+  FLX4  = 0.0 !BSINGH - Initialized to 0.0
+  FVB   = 0.0 !BSINGH - Initialized to 0.0
+  FBUR  = 0.0 !BSINGH - Initialized to 0.0
+  FGSN  = 0.0 !BSINGH - Initialized to 0.0
+  SOILW = 0.0 !BSINGH - Initialized to 0.0
+
+  sigma_sb=5.67e-08
 
 ! MEK MAY 2007
       FDTLIW=DT/ROWLIW
@@ -574,7 +692,7 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
      SLDPTH(NS)=DZS(NS)
      ENDDO
 
-   DO J=jts,jte
+     JLOOP : DO J=jts,jte
 
       IF(ITIMESTEP.EQ.1)THEN
         DO 50 I=its,ite
@@ -618,7 +736,7 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
       ENDIF                                                               ! end of initialization over ocean
 
 !-----------------------------------------------------------------------
-      DO 100 I=its,ite
+      ILOOP : DO I=its,ite
 ! surface pressure
         PSFC=P8w3D(i,1,j)
 ! pressure in middle of lowest layer
@@ -691,6 +809,7 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
           LH_RURAL(I,J)=LH(I,J)
           EMISS_RURAL(I,J)=EMISS(I,J)
           GRDFLX_RURAL(I,J)=GRDFLX(I,J)
+
         ELSE
 ! Land or sea-ice case
 
@@ -722,19 +841,19 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
               DQSDT2=Q2SATI*6174./(SFCTSNO**2)
             ENDIF
 ! for snow cover fraction at 0 C, ground temp will not change, so DQSDT2 effectively zero
-            IF(T1 .GT. 273. .AND. SNOWC(I,J) .GT. 0.)DQSDT2=DQSDT2*(1.-SNOWC(I,J))
+! V3.8 add condition for SWDOWN to restrict condition to positive forcing (JD)
+            IF(T1 .GT. 273. .AND. SNOWC(I,J) .GT. 0. .AND. SWDOWN(I,J) .GT. 10.)DQSDT2=DQSDT2*(1.-SNOWC(I,J))
           ENDIF
 
-          IF(ICE.EQ.1)THEN
-             ! Sea-ice point has deep-level temperature of -2 C
-             TBOT=271.16
-          ELSE
-             ! Land-ice or land points have the usual deep-soil temperature.
-             TBOT=TMN(I,J)
-          ENDIF
+          ! Land-ice or land points use the usual deep-soil temperature.
+          TBOT=TMN(I,J)
+
+          IF(ISURBAN.EQ.1) THEN
+! assumes these only need to be set for USGS land data
           IF(VEGTYP.EQ.25) SHDFAC=0.0000
           IF(VEGTYP.EQ.26) SHDFAC=0.0000
           IF(VEGTYP.EQ.27) SHDFAC=0.0000
+          ENDIF
           IF(SOILTYP.EQ.14.AND.XICE(I,J).EQ.0.)THEN
 #if 0
          IF(IPRINT)PRINT*,' SOIL TYPE FOUND TO BE WATER AT A LAND-POINT'
@@ -743,7 +862,8 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
             SOILTYP=7
           ENDIF
           SNOALB1 = SNOALB(I,J)
-          CMC=CANWAT(I,J)
+! converts canwat in mm to CMC in meters
+          CMC=CANWAT(I,J)/1000.
 
 !-------------------------------------------
 !*** convert snow depth from mm to meter
@@ -763,11 +883,11 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
         RIBB=RIB(I,J)
 !FEI: temporaray arrays above need to be changed later by using SI
 
-          DO 70 NS=1,NSOIL
+          DO NS=1,NSOIL
             SMC(NS)=SMOIS(I,NS,J)
             STC(NS)=TSLB(I,NS,J)                                          !STEMP
             SWC(NS)=SH2O(I,NS,J)
-   70     CONTINUE
+          ENDDO
 !
           if ( (SNEQV.ne.0..AND.SNOWHK.eq.0.).or.(SNOWHK.le.SNEQV) )THEN
             SNOWHK= 5.*SNEQV
@@ -778,8 +898,8 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
 ! the "NATURAL" category in the VEGPARM.TBL
 	
 	   IF(SF_URBAN_PHYSICS == 1.OR. SF_URBAN_PHYSICS==2.OR.SF_URBAN_PHYSICS==3 ) THEN
-                IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == 31 .or. &
-                  IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33) THEN
+                IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LOW_DENSITY_RESIDENTIAL .or. &
+                  IVGTYP(I,J) == HIGH_DENSITY_RESIDENTIAL .or. IVGTYP(I,J) == HIGH_INTENSITY_INDUSTRIAL) THEN
 		 VEGTYP = NATURAL
                  SHDFAC = SHDTBL(NATURAL)
                  ALBEDOK =0.2         !  0.2
@@ -787,24 +907,57 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
                  EMISSI = 0.98                                 !for VEGTYP=5
 		 IF ( FRC_URB2D(I,J) < 0.99 ) THEN
                    if(sf_urban_physics.eq.1)then
-           T1= ( TSK(I,J) -FRC_URB2D(I,J) * TS_URB2D (I,J) )/ (1-FRC_URB2D(I,J))
+                     T1= ( TSK(I,J) -FRC_URB2D(I,J) * TS_URB2D (I,J) )/ (1-FRC_URB2D(I,J))
                    elseif((sf_urban_physics.eq.2).OR.(sf_urban_physics.eq.3))then
-                r1= (tsk(i,j)**4.)
-                r2= frc_urb2d(i,j)*(ts_urb2d(i,j)**4.)
-                r3= (1.-frc_urb2d(i,j))
-                t1= ((r1-r2)/r3)**.25
+                     T1=tsk_rural_bep(i,j)
                    endif
 	         ELSE
 		 T1 = TSK(I,J)
                  ENDIF
                 ENDIF
            ELSE
-                 IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == 31 .or. &
-                  IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33) THEN
+                 IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LOW_DENSITY_RESIDENTIAL .or. &
+                  IVGTYP(I,J) == HIGH_DENSITY_RESIDENTIAL .or. IVGTYP(I,J) == HIGH_INTENSITY_INDUSTRIAL) THEN
                   VEGTYP = ISURBAN
            	 ENDIF
            ENDIF
 
+!===Yang, 2014/10/08, hydrological processes for urban vegetation in single layer UCM===
+           AOASIS = 1.0
+           USOIL = 1
+           DSOIL = 2
+           IRIOPTION=IRI_SCHEME
+	  IF(SF_URBAN_PHYSICS == 1) THEN
+           OMG= OMG_URB2D(I,J)   
+           tloc=mod(int(OMG/3.14159*180./15.+12.+0.5 ),24)
+           if (tloc.lt.0) tloc=tloc+24
+           if (tloc==0) tloc=24
+           CALL cal_mon_day(julian,julyr,jmonth,jday) 
+           IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LOW_DENSITY_RESIDENTIAL .or. &
+                IVGTYP(I,J) == HIGH_DENSITY_RESIDENTIAL .or. IVGTYP(I,J) == HIGH_INTENSITY_INDUSTRIAL) THEN
+            AOASIS = oasis  ! urban oasis effect
+                   IF (IRIOPTION ==1) THEN
+                   IF (tloc==21 .or. tloc==22) THEN  !irrigation on vegetaion in urban area, MAY-SEP, 9-10pm
+                   IF (jmonth==5 .or. jmonth==6 .or. jmonth==7 .or. jmonth==8 .or. jmonth==9) THEN
+!                      IF (SMC(USOIL) .LT. SMCREF) SMC(USOIL)= SMCREF
+!                      IF (SMC(DSOIL) .LT. SMCREF) SMC(DSOIL)= SMCREF
+                      IF (SMC(USOIL) .LT. SMCREF) SMC(USOIL)= REFSMC(ISLTYP(I,J))                      
+                      IF (SMC(DSOIL) .LT. SMCREF) SMC(DSOIL)= REFSMC(ISLTYP(I,J))                    
+                   ENDIF
+                   ENDIF
+                   ENDIF
+                ENDIF
+           ENDIF
+
+	  IF(SF_URBAN_PHYSICS == 2 .or. SF_URBAN_PHYSICS == 3) THEN
+          IF(AOASIS > 1.0) THEN
+          FATAL_ERROR('Urban oasis option is for SF_URBAN_PHYSICS == 1 only')
+          ENDIF
+          IF(IRIOPTION == 1) THEN
+          FATAL_ERROR('Urban irrigation option is for SF_URBAN_PHYSICS == 1 only')
+          ENDIF
+          ENDIF
+
 #if 0
           IF(IPRINT) THEN
 !
@@ -831,35 +984,123 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
            endif
 #endif
 
-
           IF (rdlai2d) THEN
+             IF (SHDFAC > 0.0 .AND. LAI(I,J) <= 0.0) LAI(I,J) = 0.01
              xlai = lai(i,j)
           endif
 
-       CALL SFLX (FFROZP, ICE, ISURBAN, DT,ZLVL,NSOIL,SLDPTH,     &    !C
-                 LOCAL,                                           &    !L
-                 LUTYPE, SLTYPE,                                  &    !CL
-                 LWDN,SOLDN,SOLNET,SFCPRS,PRCP,SFCTMP,Q2K,DUMMY,         &    !F
-                 DUMMY,DUMMY, DUMMY,                              &    !F PRCPRAIN not used
-                 TH2,Q2SAT,DQSDT2,                                &    !I
-                 VEGTYP,SOILTYP,SLOPETYP,SHDFAC,SHMIN,SHMAX,      &    !I
-                 ALBBRD, SNOALB1,TBOT, Z0BRD, Z0K, EMISSI, EMBRD, &    !S
+    IF ( ICE == 1 ) THEN
+
+       ! Sea-ice case
+
+       DO NS = 1, NSOIL
+          SH2O(I,NS,J) = 1.0
+       ENDDO
+       LAI(I,J) = 0.01
+
+       CYCLE ILOOP
+
+    ELSEIF (ICE == 0) THEN
+
+       ! Non-glacial land
+!
+!  FASDAS
+!
+       IF( fasdas == 1 ) THEN
+
+         DZQ = DZ8W(I,1,J)
+         XSDA_HFX= SDA_HFX(I,J)*RHO(I,1,J)*CPM(I,J)*DZQ  ! W/m^2
+         ! TWG2015 Bugfix remove factor of 1000.0 for correct units
+         XSDA_QFX= SDA_QFX(I,J)*RHO(I,1,J)*DZQ          ! Kg/m2/s of water
+         XQNORM = QNORM(I,J)
+
+       ENDIF
+!
+!  END FASDAS
+!
+       CALL SFLX (I,J,FFROZP, ISURBAN, DT,ZLVL,NSOIL,SLDPTH,       &    !C
+                 LOCAL,                                            &    !L
+                 LUTYPE, SLTYPE,                                   &    !CL
+                 LWDN,SOLDN,SOLNET,SFCPRS,PRCP,SFCTMP,Q2K,DUMMY,   &    !F
+                 DUMMY,DUMMY, DUMMY,                               &    !F PRCPRAIN not used
+                 TH2,Q2SAT,DQSDT2,                                 &    !I
+                 VEGTYP,SOILTYP,SLOPETYP,SHDFAC,SHMIN,SHMAX,       &    !I
+                 ALBBRD, SNOALB1,TBOT, Z0BRD, Z0K, EMISSI, EMBRD,  &    !S
                  CMC,T1,STC,SMC,SWC,SNOWHK,SNEQV,ALBEDOK,CHK,dummy,&    !H
-                 ETA,SHEAT, ETA_KINEMATIC,FDOWN,                  &    !O
-                 EC,EDIR,ET,ETT,ESNOW,DRIP,DEW,                   &    !O
-                 BETA,ETP,SSOIL,                                  &    !O
-                 FLX1,FLX2,FLX3,                                  &    !O
-                 SNOMLT,SNCOVR,                                   &    !O
-                 RUNOFF1,RUNOFF2,RUNOFF3,                         &    !O
-                 RC,PC,RSMIN,XLAI,RCS,RCT,RCQ,RCSOIL,             &    !O
-                 SOILW,SOILM,Q1,SMAV,                             &    !D
-                 RDLAI2D,USEMONALB,                               &
-                 SNOTIME1,                                        &
-                 RIBB,                                            &
-                 SMCWLT,SMCDRY,SMCREF,SMCMAX,NROOT)
+                 ETA,SHEAT, ETA_KINEMATIC,FDOWN,                   &    !O
+                 EC,EDIR,ET,ETT,ESNOW,DRIP,DEW,                    &    !O
+                 BETA,ETP,SSOIL,                                   &    !O
+                 FLX1,FLX2,FLX3,                                   &    !O
+		 FLX4,FVB,FBUR,FGSN,UA_PHYS,                       &    !UA 
+                 SNOMLT,SNCOVR,                                    &    !O
+                 RUNOFF1,RUNOFF2,RUNOFF3,                          &    !O
+                 RC,PC,RSMIN,XLAI,RCS,RCT,RCQ,RCSOIL,              &    !O
+                 SOILW,SOILM,Q1,SMAV,                              &    !D
+                 RDLAI2D,USEMONALB,                                &
+                 SNOTIME1,                                         &
+                 RIBB,                                             &
+                 SMCWLT,SMCDRY,SMCREF,SMCMAX,NROOT,                &
+                 sfcheadrt(i,j),                                   &    !I
+                 INFXSRT(i,j),ETPND1,OPT_THCND,AOASIS              &    !O
+                ,XSDA_QFX, HFX_PHY, QFX_PHY, XQNORM, fasdas, HCPCT_FASDAS    &   ! fasdas
+                 )
+
+
+#ifdef WRF_HYDRO
+                 soldrain(i,j) = RUNOFF2*DT*1000.0
+#endif
+    ELSEIF (ICE == -1) THEN
+
+       !
+       ! Set values that the LSM is expected to update,
+       ! but don't get updated for glacial points.
+       !
+       SOILM = 0.0 !BSINGH(PNNL)- SOILM is undefined for this case, it is used for diagnostics so setting it to zero
+       XLAI = 0.01 ! KWM Should this be Zero over land ice?  Does this value matter?
+       RUNOFF2 = 0.0
+       RUNOFF3 = 0.0
+       DO NS = 1, NSOIL
+          SWC(NS) = 1.0
+          SMC(NS) = 1.0
+          SMAV(NS) = 1.0
+       ENDDO
+!
+!  FASDAS
+!
+       IF( fasdas == 1 ) THEN
+
+         DZQ = DZ8W(I,1,J)
+         XSDA_HFX= SDA_HFX(I,J)*RHO(I,1,J)*CPM(I,J)*DZQ  ! W/m^2
+         XSDA_QFX= 0.0          ! Kg/m2/s of water
+         XQNORM = 0.0
+
+       ENDIF
+!
+!  END FASDAS
+!
 
+       CALL SFLX_GLACIAL(I,J,ISICE,FFROZP,DT,ZLVL,NSOIL,SLDPTH,   &    !C
+            &    LWDN,SOLNET,SFCPRS,PRCP,SFCTMP,Q2K,              &    !F
+            &    TH2,Q2SAT,DQSDT2,                                &    !I
+            &    ALBBRD, SNOALB1,TBOT, Z0BRD, Z0K, EMISSI, EMBRD, &    !S
+            &    T1,STC(1:NSOIL),SNOWHK,SNEQV,ALBEDOK,CHK,        &    !H
+            &    ETA,SHEAT,ETA_KINEMATIC,FDOWN,                   &    !O
+            &    ESNOW,DEW,                                       &    !O
+            &    ETP,SSOIL,                                       &    !O
+            &    FLX1,FLX2,FLX3,                                  &    !O
+            &    SNOMLT,SNCOVR,                                   &    !O
+            &    RUNOFF1,                                         &    !O
+            &    Q1,                                              &    !D
+            &    SNOTIME1,                                        &
+            &    RIBB)
+
+    ENDIF
 
        lai(i,j) = xlai
+       if (present(rc2) .and. present(xlai2)) then
+       rc2(I,J) = RC                                              ! for output
+       xlai2(I,J) = XLAI
+       endif
 
 #if 0
           IF(IPRINT) THEN
@@ -888,7 +1129,7 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
 #endif
 
 !***  UPDATE STATE VARIABLES
-          CANWAT(I,J)=CMC
+          CANWAT(I,J)=CMC*1000.
           SNOW(I,J)=SNEQV*1000.
 !          SNOWH(I,J)=SNOWHK*1000.
           SNOWH(I,J)=SNOWHK                   ! SNOWHK in meters
@@ -898,16 +1139,46 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
           Z0(I,J)=Z0BRD
           EMISS(I,J) = EMISSI
           EMISS_RURAL(I,J) = EMISSI
-! MEK Nov2006 turn off
-!          ZNT(I,J)=Z0K
+! Noah: activate time-varying roughness length (V3.3 Feb 2011)
+          ZNT(I,J)=Z0K
+!
+! FASDAS
+!
+! Update Skin Temperature
+       IF( fasdas == 1 ) THEN
+           XSDA_QFX= XSDA_QFX*ELWV*XQNORM
+
+        !TWG2015 Bugfix to multiply Heat Capacity by Soil Depth for correct
+        !units 
+
+           T1 = T1 + (XSDA_HFX-XSDA_QFX)*DT/(HCPCT_FASDAS*DZS(1))
+
+       END IF
+!
+! END FASDAS
+!
           TSK(I,J)=T1
           TSK_RURAL(I,J)=T1
+          if (present(tsk_rural_bep)) then
+             IF(SF_URBAN_PHYSICS == 2 .or. SF_URBAN_PHYSICS == 3) THEN
+               TSK_RURAL_BEP(I,J)=T1
+             END IF
+          endif
           HFX(I,J)=SHEAT
           HFX_RURAL(I,J)=SHEAT
 ! MEk Jul07 add potential evap accum
         POTEVP(I,J)=POTEVP(I,J)+ETP*FDTW
           QFX(I,J)=ETA_KINEMATIC
           QFX_RURAL(I,J)=ETA_KINEMATIC
+
+#ifdef WRF_HYDRO
+!added by Wei Yu
+!         QFX(I,J) = QFX(I,J) + ETPND1
+!         ETA = ETA + ETPND1/2.501E6*dt
+!end added by Wei Yu
+#endif
+
+
           LH(I,J)=ETA
           LH_RURAL(I,J)=ETA
           GRDFLX(I,J)=SSOIL
@@ -918,14 +1189,15 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
 !      prevent diagnostic ground q (q1) from being greater than qsat(tsk)
 !      as happens over snow cover where the cqs2 value also becomes irrelevant
 !      by setting cqs2=chs in this situation the 2m q should become just qv(k=1)
-          IF (Q1 .GT. QSFC(I,J)) THEN
-            CQS2(I,J) = CHS(I,J)
-          ENDIF
+! ww: comment out this change to avoid Q2 drop due to change of radiative flux
+!         IF (Q1 .GT. QSFC(I,J)) THEN
+!           CQS2(I,J) = CHS(I,J)
+!         ENDIF
 !          QSFC(I,J)=Q1
 ! Convert QSFC back to mixing ratio
            QSFC(I,J)= Q1/(1.0-Q1)
 !
-           QSFC_RURAL(I,J)= Q1/(1.0-Q1)
+           ! QSFC_RURAL(I,J)= Q1/(1.0-Q1)
 ! Calculate momentum flux from rural surface for use with multi-layer UCM (Martilli et al. 2002)
 
           DO 80 NS=1,NSOIL
@@ -935,10 +1207,23 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
    80     CONTINUE
 !       ENDIF
 
+        FLX4_2D(I,J)  = FLX4
+	FVB_2D(I,J)   = FVB
+	FBUR_2D(I,J)  = FBUR
+	FGSN_2D(I,J)  = FGSN
+
      !
      ! Residual of surface energy balance equation terms
      !
-     noahres(i,j) =     ( solnet + lwdn ) - sheat + ssoil - eta - ( emissi * STBOLT * (t1**4) ) - flx1 - flx2 - flx3
+
+     IF ( UA_PHYS ) THEN
+         noahres(i,j) = ( solnet + lwdn ) - sheat + ssoil - eta &
+              - ( emissi * STBOLT * (t1**4) ) - flx1 - flx2 - flx3 - flx4
+
+     ELSE
+         noahres(i,j) = ( solnet + lwdn ) - sheat + ssoil - eta &
+              - ( emissi * STBOLT * (t1**4) ) - flx1 - flx2 - flx3
+     ENDIF
 
 
         IF (SF_URBAN_PHYSICS == 1 ) THEN                                              ! Beginning of UCM CALL if block
@@ -948,8 +1233,8 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
 ! Input variables lsm --> urban
 
 
-          IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == 31 .or. &
-              IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33 ) THEN
+          IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LOW_DENSITY_RESIDENTIAL .or. &
+              IVGTYP(I,J) == HIGH_DENSITY_RESIDENTIAL .or. IVGTYP(I,J) == HIGH_INTENSITY_INDUSTRIAL ) THEN
 
 ! Call urban
 
@@ -984,8 +1269,19 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
             QC_URB = QC_URB2D(I,J)
             UC_URB = UC_URB2D(I,J)
 
+            TGR_URB   = TGR_URB2D(I,J)
+            CMCR_URB  = CMCR_URB2D(I,J)
+            FLXHUMR_URB = FLXHUMR_URB2D(I,J)
+            FLXHUMB_URB = FLXHUMB_URB2D(I,J)
+            FLXHUMG_URB = FLXHUMG_URB2D(I,J)
+            DRELR_URB = DRELR_URB2D(I,J)
+            DRELB_URB = DRELB_URB2D(I,J)
+            DRELG_URB = DRELG_URB2D(I,J)
+
             DO K = 1,num_roof_layers
               TRL_URB(K) = TRL_URB3D(I,K,J)
+              SMR_URB(K) = SMR_URB3D(I,K,J)
+              TGRL_URB(K)= TGRL_URB3D(I,K,J)
             END DO
             DO K = 1,num_wall_layers
               TBL_URB(K) = TBL_URB3D(I,K,J)
@@ -1016,12 +1312,30 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
             IF (PRESENT(CMR_SFCDIF)) THEN
                CMR_URB = CMR_SFCDIF(I,J)
                CHR_URB = CHR_SFCDIF(I,J)
+               CMGR_URB = CMGR_SFCDIF(I,J)
+               CHGR_URB = CHGR_SFCDIF(I,J)
                CMC_URB = CMC_SFCDIF(I,J)
                CHC_URB = CHC_SFCDIF(I,J)
             ENDIF
+
+! NUDAPT for SLUCM
+            mh_urb = mh_urb2d(I,J)
+            stdh_urb = stdh_urb2d(I,J)
+            lp_urb = lp_urb2d(I,J)
+            hgt_urb = hgt_urb2d(I,J)
+            lf_urb = 0.0
+            DO K = 1,4
+              lf_urb(K)=lf_urb2d(I,K,J)
+            ENDDO
+            frc_urb = frc_urb2d(I,J)
+            lb_urb = lb_urb2d(I,J)
+            check = 0
+            if (I.eq.73.and.J.eq.125)THEN
+               check = 1
+            end if
 !
 ! Call urban
-
+            CALL cal_mon_day(julian,julyr,jmonth,jday)
             CALL urban(LSOLAR_URB,                                      & ! I
                        num_roof_layers,num_wall_layers,num_road_layers, & ! C
                        DZR,DZB,DZG,                                     & ! C
@@ -1038,7 +1352,11 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
                        GZ1OZ0_URB,                                      & !O
                        CMR_URB, CHR_URB, CMC_URB, CHC_URB,              &
                        U10_URB, V10_URB, TH2_URB, Q2_URB,               & ! O
-                       UST_URB)                                           !O
+                       UST_URB,mh_urb, stdh_urb, lf_urb, lp_urb,        & ! 0
+                       hgt_urb,frc_urb,lb_urb, check,CMCR_URB,TGR_URB,  & ! H
+                       TGRL_URB,SMR_URB,CMGR_URB,CHGR_URB,jmonth,       & ! H
+                       DRELR_URB,DRELB_URB,                             & ! H
+                       DRELG_URB,FLXHUMR_URB,FLXHUMB_URB,FLXHUMG_URB)                            
 
 #if 0
           IF(IPRINT) THEN
@@ -1108,8 +1426,19 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
             QC_URB2D(I,J) = QC_URB
             UC_URB2D(I,J) = UC_URB
 
+            TGR_URB2D(I,J) =TGR_URB 
+            CMCR_URB2D(I,J)=CMCR_URB
+            FLXHUMR_URB2D(I,J)=FLXHUMR_URB 
+            FLXHUMB_URB2D(I,J)=FLXHUMB_URB
+            FLXHUMG_URB2D(I,J)=FLXHUMG_URB
+            DRELR_URB2D(I,J) = DRELR_URB 
+            DRELB_URB2D(I,J) = DRELB_URB 
+            DRELG_URB2D(I,J) = DRELG_URB
+
             DO K = 1,num_roof_layers
               TRL_URB3D(I,K,J) = TRL_URB(K)
+              SMR_URB3D(I,K,J) = SMR_URB(K)
+              TGRL_URB3D(I,K,J)= TGRL_URB(K)
             END DO
             DO K = 1,num_wall_layers
               TBL_URB3D(I,K,J) = TBL_URB(K)
@@ -1138,6 +1467,8 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
             IF (PRESENT(CMR_SFCDIF)) THEN
                CMR_SFCDIF(I,J) = CMR_URB
                CHR_SFCDIF(I,J) = CHR_URB
+               CMGR_SFCDIF(I,J) = CMGR_URB
+               CHGR_SFCDIF(I,J) = CHGR_URB
                CMC_SFCDIF(I,J) = CMC_URB
                CHC_SFCDIF(I,J) = CHC_URB
             ENDIF
@@ -1154,9 +1485,11 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
           DO NS=1,NSOIL
           SMCREL(I,NS,J)=SMAV(NS)
           ENDDO
+
+
 !         Convert the water unit into mm
           SFCRUNOFF(I,J)=SFCRUNOFF(I,J)+RUNOFF1*DT*1000.0
-          UDRUNOFF(I,J)=UDRUNOFF(I,J)+(RUNOFF2+RUNOFF3)*DT*1000.0
+          UDRUNOFF(I,J)=UDRUNOFF(I,J)+RUNOFF2*DT*1000.0
 ! snow defined when fraction of frozen precip (FFROZP) > 0.5,
           IF(FFROZP.GT.0.5)THEN
             ACSNOW(I,J)=ACSNOW(I,J)+PRCP*DT
@@ -1169,9 +1502,8 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
 
         ENDIF                                                           ! endif of land-sea test
 
-  100 CONTINUE                                                          ! of I loop
-
-   ENDDO                                                                ! of J loop
+      ENDDO ILOOP                                                       ! of I loop
+   ENDDO JLOOP                                                          ! of J loop
 
       IF (SF_URBAN_PHYSICS == 2) THEN
 
@@ -1182,17 +1514,19 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
             RL_UP_URB(i,j)=0.
             RS_ABS_URB(i,j)=0.
             GRDFLX_URB(i,j)=0.
+            b_q_bep(i,kts:kte,j)=0.
          end do
          end do
        CALL BEP(frc_urb2d,utype_urb2d,itimestep,dz8w,dt,u_phy,v_phy,   &
                 th_phy,rho,p_phy,swdown,glw,                           &
                 gmt,julday,xlong,xlat,declin_urb,cosz_urb2d,omg_urb2d, &
-                num_urban_layers,                                      &
+                num_urban_layers,num_urban_hi,                         &
                 trb_urb4d,tw1_urb4d,tw2_urb4d,tgb_urb4d,               &
                 sfw1_urb3d,sfw2_urb3d,sfr_urb3d,sfg_urb3d,             &
+                lp_urb2d,hi_urb2d,lb_urb2d,hgt_urb2d,                  &
                 a_u_bep,a_v_bep,a_t_bep,                               &
                 a_e_bep,b_u_bep,b_v_bep,                               &
-                b_t_bep,b_e_bep,dlg_bep,                               &
+                b_t_bep,b_e_bep,b_q_bep,dlg_bep,                       &
                 dl_u_bep,sf_bep,vl_bep,                                &
                 rl_up_urb,rs_abs_urb,emiss_urb,grdflx_urb,             &
                 ids,ide, jds,jde, kds,kde,                             &
@@ -1211,19 +1545,22 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
             RL_UP_URB(i,j)=0.
             RS_ABS_URB(i,j)=0.
             GRDFLX_URB(i,j)=0.
+            b_q_bep(i,kts:kte,j)=0.
          end do
          end do
-          
+        
+
        CALL BEP_BEM(frc_urb2d,utype_urb2d,itimestep,dz8w,dt,u_phy,v_phy, &
                 th_phy,rho,p_phy,swdown,glw,                           &
                 gmt,julday,xlong,xlat,declin_urb,cosz_urb2d,omg_urb2d, &
-                num_urban_layers,                                      &
+                num_urban_layers,num_urban_hi,                         &
                 trb_urb4d,tw1_urb4d,tw2_urb4d,tgb_urb4d,               &
                 tlev_urb3d,qlev_urb3d,tw1lev_urb3d,tw2lev_urb3d,       &
                 tglev_urb3d,tflev_urb3d,sf_ac_urb3d,lf_ac_urb3d,       &
                 cm_ac_urb3d,sfvent_urb3d,lfvent_urb3d,                 &
                 sfwin1_urb3d,sfwin2_urb3d,                             &
                 sfw1_urb3d,sfw2_urb3d,sfr_urb3d,sfg_urb3d,             &
+                lp_urb2d,hi_urb2d,lb_urb2d,hgt_urb2d,                  &
                 a_u_bep,a_v_bep,a_t_bep,                               &
                 a_e_bep,b_u_bep,b_v_bep,                               &
                 b_t_bep,b_e_bep,b_q_bep,dlg_bep,                       &
@@ -1236,8 +1573,6 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
        ENDIF
 
     if((sf_urban_physics.eq.2).OR.(sf_urban_physics.eq.3))then         !Bep begin
-! fix the value of the Stefan-Boltzmann constant
-         sigma_sb=5.67e-08
          do j=jts,jte
          do i=its,ite
             UMOM_URB(I,J)=0.
@@ -1285,11 +1620,11 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
 !           emiss(i,j)=(1.-frc_urb2d(i,j))*emiss_rural(i,j)+frc_urb2d(i,j)*emiss_urb(i,j)
 ! using the emissivity and the total longwave upward radiation estimate the averaged skin temperature
            IF (FRC_URB2D(I,J).GT.0.) THEN
-              rl_up_rural=-emiss_rural(i,j)*sigma_sb*(tsk_rural(i,j)**4.)-(1.-emiss_rural(i,j))*glw(i,j)
+              rl_up_rural=-emiss_rural(i,j)*sigma_sb*(tsk_rural(i,j)**4.)-(1.-emissi)*glw(i,j)
               rl_up_tot=(1.-frc_urb2d(i,j))*rl_up_rural+frc_urb2d(i,j)*rl_up_urb(i,j)   
               emiss(i,j)=(1.-frc_urb2d(i,j))*emiss_rural(i,j)+frc_urb2d(i,j)*emiss_urb(i,j)
-              ts_urb2d(i,j)=((-rl_up_urb(i,j)-(1.-emiss_urb(i,j))*glw(i,j))/emiss_urb(i,j)/sigma_sb)**0.25
-           tsk(i,j)=( (-1.*rl_up_tot-(1.-emiss(i,j))*glw(i,j) )/emiss(i,j)/sigma_sb)**.25
+              ts_urb2d(i,j)=(max(0.,(-rl_up_urb(i,j)-(1.-emiss_urb(i,j))*glw(i,j))/emiss_urb(i,j)/sigma_sb))**0.25
+              tsk(i,j)=(max(0., (-1.*rl_up_tot-(1.-emiss(i,j))*glw(i,j) )/emiss(i,j)/sigma_sb))**.25
            rs_abs_tot=(1.-frc_urb2d(i,j))*swdown(i,j)*(1.-albedo(i,j))+frc_urb2d(i,j)*rs_abs_urb(i,j)  
           if(swdown(i,j).gt.0.)then
            albedo(i,j)=1.-rs_abs_tot/swdown(i,j)
@@ -1306,7 +1641,7 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
             LH_URB2D(I,J)    = qfx_urb(i,j)*xlv
             G_URB2D(I,J)     = grdflx_urb(i,j)
             RN_URB2D(I,J)    = rs_abs_urb(i,j)+emiss_urb(i,j)*glw(i,j)-rl_up_urb(i,j)
-         ust(i,j)=(umom**2.+vmom**2.)**.25
+            ust(i,j)=(umom**2.+vmom**2.)**.25
 !          if(tsk(i,j).gt.350)write(*,*)'tsk too big!',i,j,tsk(i,j)
 !          if(tsk(i,j).lt.260)write(*,*)'tsk too small!',i,j,tsk(i,j),rl_up_tot,rl_up_urb(i,j),rl_up_rural
 !                    print*,'ivgtyp,i,j,sigma_sb',ivgtyp(i,j),i,j,sigma_sb
@@ -1331,8 +1666,8 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
               G_URB2D(I,J)     = 0.
               RN_URB2D(I,J)    = 0.
             endif
-!          IF( IVGTYP(I,J) == 1 .or. IVGTYP(I,J) == 31 .or. &
-!                  IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33) THEN
+!          IF( IVGTYP(I,J) == 1 .or. IVGTYP(I,J) == LOW_DENSITY_RESIDENTIAL .or. &
+!                  IVGTYP(I,J) == HIGH_DENSITY_RESIDENTIAL .or. IVGTYP(I,J) == HIGH_INTENSITY_INDUSTRIAL) THEN
 !                    print*,'ivgtyp, qfx, hfx',ivgtyp(i,j),hfx_rural(i,j),qfx_rural(i,j)
 !                    print*,'ivgtyp,hfx,hfx_urb,hfx_rural',hfx(i,j),hfx_urb(i,j),hfx_rural(i,j)
 !                    print*,'lh,lh_rural',lh(i,j),lh_rural(i,j)
@@ -1350,14 +1685,12 @@ SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
    END SUBROUTINE lsm
 !------------------------------------------------------
 
-!ldf (01-04-2011): This section of the module is moved to module_physics_lsm_noahinit.F in
+!For MPAS, the below section of the module is moved to module_physics_lsm_noahinit.F in
 !./../core_physics to accomodate differences in the mpi calls between WRF and MPAS.I thought
 !that it would be cleaner to do this instead of adding a lot of #ifdef statements throughout
 !the initialization subroutine.
 
-#if !defined(mpas)
-
-
+#if defined(wrfmodel)
   SUBROUTINE LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV,    &
                      SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,        &
                      ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, &
@@ -1413,6 +1746,7 @@ SUBROUTINE LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV,    &
    REAL, PARAMETER           :: BLIM = 5.5, HLICE = 3.335E5,    &
                                 GRAV = 9.81, T0 = 273.15
    INTEGER                   :: errflag
+   CHARACTER(LEN=80)         :: err_message
 
    character*256 :: MMINSL
         MMINSL='STAS'
@@ -1420,18 +1754,22 @@ SUBROUTINE LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV,    &
 
 ! initialize three Noah LSM related tables
    IF ( allowed_to_read ) THEN
-!    CALL wrf_message( 'INITIALIZE THREE Noah LSM RELATED TABLES' )
+     CALL wrf_message( 'INITIALIZE THREE Noah LSM RELATED TABLES' )
      CALL  SOIL_VEG_GEN_PARM( MMINLU, MMINSL )
    ENDIF
 
-#ifdef WRF_CHEM
-!
-! need this parameter for dust parameterization in wrf/chem
-!
-   do I=1,NSLTYPE
-      porosity(i)=maxsmc(i)
-   enddo
-#endif
+! GAC-->
+! 20130219 - No longer need these - see module_data_gocart_dust
+!#if ( WRF_CHEM == 1 )
+!!
+!! need this parameter for dust parameterization in wrf/chem
+!!
+!   do I=1,NSLTYPE
+!      porosity(i)=maxsmc(i)
+!      drypoint(i)=drysmc(i)
+!   enddo
+!#endif
+! <--GAC
 
    IF(.not.restart)THEN
 
@@ -1443,7 +1781,7 @@ SUBROUTINE LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV,    &
      DO i = its,itf
        IF ( ISLTYP( i,j ) .LT. 1 ) THEN
          errflag = 1
-         WRITE(err_message,*)"module_sf_noahlsm.F: lsminit: out of range ISLTYP ",i,j,ISLTYP( i,j )
+         WRITE(err_message,*)"module_sf_noahdrv.F: lsminit: out of range ISLTYP ",i,j,ISLTYP( i,j )
          CALL wrf_message(err_message)
        ENDIF
        IF(.not.RDMAXALB) THEN
@@ -1452,8 +1790,13 @@ SUBROUTINE LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV,    &
      ENDDO
    ENDDO
    IF ( errflag .EQ. 1 ) THEN
-      CALL wrf_error_fatal( "module_sf_noahlsm.F: lsminit: out of range value "// &
+#if ( HWRF == 1 ) 
+      CALL wrf_message( "WARNING: message only; was fatal. module_sf_noahdrv.F: lsminit: out of range value "// &
+                            "of ISLTYP. Is this field in the input?" )
+#else
+      CALL wrf_error_fatal( "module_sf_noahdrv.F: lsminit: out of range value "// &
                             "of ISLTYP. Is this field in the input?" )
+#endif
    ENDIF
 
 ! initialize soil liquid water content SH2O
@@ -1541,7 +1884,7 @@ END SUBROUTINE lsminit
         SUBROUTINE SOIL_VEG_GEN_PARM( MMINLU, MMINSL)
 !-----------------------------------------------------------------
 
-!       USE module_wrf_error
+        USE module_wrf_error
         IMPLICIT NONE
 
         CHARACTER(LEN=*), INTENT(IN) :: MMINLU, MMINSL
@@ -1550,7 +1893,10 @@ SUBROUTINE SOIL_VEG_GEN_PARM( MMINLU, MMINSL)
         INTEGER , PARAMETER :: OPEN_OK = 0
 
         character*128 :: mess , message
+        character*256 :: a_string
         logical, external :: wrf_dm_on_monitor
+        integer , parameter :: loop_max   = 10
+        integer             :: loop_count
 
 
 !-----SPECIFY VEGETATION RELATED CHARACTERISTICS :
@@ -1589,8 +1935,9 @@ SUBROUTINE SOIL_VEG_GEN_PARM( MMINLU, MMINSL)
 
         LUMATCH=0
 
+        loop_count = 0
+        READ (19,FMT='(A)',END=2002) a_string
         FIND_LUTYPE : DO WHILE (LUMATCH == 0)
-           READ (19,*,END=2002)
            READ (19,*,END=2002)LUTYPE
            READ (19,*)LUCATS,IINDEX
 
@@ -1599,10 +1946,16 @@ SUBROUTINE SOIL_VEG_GEN_PARM( MMINLU, MMINSL)
               CALL wrf_message( mess )
               LUMATCH=1
            ELSE
+              loop_count = loop_count+1
               call wrf_message ( "Skipping over LUTYPE = " // TRIM ( LUTYPE ) )
-              DO LC = 1, LUCATS+12
-                 read(19,*)
-              ENDDO
+              FIND_VEGETATION_PARAMETER_FLAG : DO
+                 READ (19,FMT='(A)', END=2002) a_string
+                 IF ( a_string(1:21) .EQ. 'Vegetation Parameters' ) THEN
+                    EXIT FIND_VEGETATION_PARAMETER_FLAG
+                 ELSE IF ( loop_count .GE. loop_max ) THEN
+                    CALL wrf_error_fatal ( 'Too many loops in VEGPARM.TBL')
+                 ENDIF
+              ENDDO FIND_VEGETATION_PARAMETER_FLAG
            ENDIF
         ENDDO FIND_LUTYPE
 ! prevent possible array overwrite, Bill Bovermann, IBM, May 6, 2008
@@ -1619,6 +1972,8 @@ SUBROUTINE SOIL_VEG_GEN_PARM( MMINLU, MMINSL)
              SIZE(Z0MAXTBL)     < LUCATS .OR. &
              SIZE(ALBEDOMINTBL) < LUCATS .OR. &
              SIZE(ALBEDOMAXTBL) < LUCATS .OR. &
+             SIZE(ZTOPVTBL) < LUCATS .OR. &
+             SIZE(ZBOTVTBL) < LUCATS .OR. &
              SIZE(EMISSMINTBL ) < LUCATS .OR. &
              SIZE(EMISSMAXTBL ) < LUCATS ) THEN
            CALL wrf_error_fatal('Table sizes too small for value of LUCATS in module_sf_noahdrv.F')
@@ -1631,7 +1986,8 @@ SUBROUTINE SOIL_VEG_GEN_PARM( MMINLU, MMINSL)
                         SNUPTBL(LC),MAXALB(LC), LAIMINTBL(LC),     &
                         LAIMAXTBL(LC),EMISSMINTBL(LC),             &
                         EMISSMAXTBL(LC), ALBEDOMINTBL(LC),         &
-                        ALBEDOMAXTBL(LC), Z0MINTBL(LC), Z0MAXTBL(LC)
+                        ALBEDOMAXTBL(LC), Z0MINTBL(LC), Z0MAXTBL(LC),&
+			ZTOPVTBL(LC), ZBOTVTBL(LC)
           ENDDO
 !
           READ (19,*)
@@ -1646,6 +2002,18 @@ SUBROUTINE SOIL_VEG_GEN_PARM( MMINLU, MMINSL)
           READ (19,*)BARE
           READ (19,*)
           READ (19,*)NATURAL
+          READ (19,*)
+          READ (19,*)
+          READ (19,FMT='(A)') a_string
+          IF ( a_string(1:21) .EQ. 'Vegetation Parameters' ) THEN
+             CALL wrf_message     ("Expected low and high density residential, and high density industrial information in VEGPARM.TBL")
+             CALL wrf_error_fatal ("This could be caused by using an older VEGPARM.TBL file with a newer WRF source code.")
+          ENDIF
+          READ (19,*)LOW_DENSITY_RESIDENTIAL
+          READ (19,*)
+          READ (19,*)HIGH_DENSITY_RESIDENTIAL
+          READ (19,*)
+          READ (19,*)HIGH_INTENSITY_INDUSTRIAL
         ENDIF
 !
  2002   CONTINUE
@@ -1674,6 +2042,8 @@ SUBROUTINE SOIL_VEG_GEN_PARM( MMINLU, MMINSL)
       CALL wrf_dm_bcast_real    ( EMISSMAXTBL  , NLUS )
       CALL wrf_dm_bcast_real    ( ALBEDOMINTBL , NLUS )
       CALL wrf_dm_bcast_real    ( ALBEDOMAXTBL , NLUS )
+      CALL wrf_dm_bcast_real    ( ZTOPVTBL , NLUS )
+      CALL wrf_dm_bcast_real    ( ZBOTVTBL , NLUS )
       CALL wrf_dm_bcast_real    ( MAXALB  , NLUS )
       CALL wrf_dm_bcast_real    ( TOPT_DATA    , 1 )
       CALL wrf_dm_bcast_real    ( CMCMAX_DATA  , 1 )
@@ -1681,6 +2051,9 @@ SUBROUTINE SOIL_VEG_GEN_PARM( MMINLU, MMINSL)
       CALL wrf_dm_bcast_real    ( RSMAX_DATA  , 1 )
       CALL wrf_dm_bcast_integer ( BARE    , 1 )
       CALL wrf_dm_bcast_integer ( NATURAL , 1 )
+      CALL wrf_dm_bcast_integer ( LOW_DENSITY_RESIDENTIAL , 1 )
+      CALL wrf_dm_bcast_integer ( HIGH_DENSITY_RESIDENTIAL , 1 )
+      CALL wrf_dm_bcast_integer ( HIGH_INTENSITY_INDUSTRIAL , 1 )
 
 !
 !-----READ IN SOIL PROPERTIES FROM SOILPARM.TBL
@@ -1693,7 +2066,7 @@ SUBROUTINE SOIL_VEG_GEN_PARM( MMINLU, MMINSL)
           CALL wrf_error_fatal ( message )
         END IF
 
-        WRITE(mess,*) 'INPUT SOIL TEXTURE CLASSIFICAION = ', TRIM ( MMINSL )
+        WRITE(mess,*) 'INPUT SOIL TEXTURE CLASSIFICATION = ', TRIM ( MMINSL )
         CALL wrf_message( mess )
 
         LUMATCH=0
@@ -1829,6 +2202,2884 @@ SUBROUTINE SOIL_VEG_GEN_PARM( MMINLU, MMINSL)
       END SUBROUTINE SOIL_VEG_GEN_PARM
 !-----------------------------------------------------------------
 
+!===========================================================================
+!
+! subroutine lsm_mosaic: a tiling approach for Noah LSM
+!
+!=========================================================================== 
+
+SUBROUTINE lsm_mosaic(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
+                  HFX,QFX,LH,GRDFLX, QGH,GSW,SWDOWN,GLW,SMSTAV,SMSTOT, &
+                  SFCRUNOFF, UDRUNOFF,IVGTYP,ISLTYP,ISURBAN,ISICE,VEGFRA,    &
+                  ALBEDO,ALBBCK,ZNT,Z0,TMN,XLAND,XICE,EMISS,EMBCK,   &
+                  SNOWC,QSFC,RAINBL,MMINLU,                     &
+                  num_soil_layers,DT,DZS,ITIMESTEP,             &
+                  SMOIS,TSLB,SNOW,CANWAT,                       &
+                  CHS,CHS2,CQS2,CPM,ROVCP,SR,chklowq,lai,qz0,   & !H
+                  myj,frpcpn,                                   &
+                  SH2O,SNOWH,                                   & !H
+                  U_PHY,V_PHY,                                  & !I
+                  SNOALB,SHDMIN,SHDMAX,                         & !I
+                  SNOTIME,                                      & !?
+                  ACSNOM,ACSNOW,                                & !O
+                  SNOPCX,                                       & !O
+                  POTEVP,                                       & !O
+                  SMCREL,                                       & !O
+                  XICE_THRESHOLD,                               &
+                  RDLAI2D,USEMONALB,                            &
+                  RIB,                                          & !?
+                  NOAHRES,OPT_THCND,                            &
+                 NLCAT,landusef,landusef2,                       & ! danli mosaic
+                 sf_surface_mosaic,mosaic_cat,mosaic_cat_index,  & ! danli mosaic 
+                 TSK_mosaic,QSFC_mosaic,                         & ! danli mosaic 
+                 TSLB_mosaic,SMOIS_mosaic,SH2O_mosaic,           & ! danli mosaic 
+                 CANWAT_mosaic,SNOW_mosaic,                      & ! danli mosaic
+                 SNOWH_mosaic,SNOWC_mosaic,                      & ! danli mosaic 
+                 ALBEDO_mosaic,ALBBCK_mosaic,                    & ! danli mosaic
+                 EMISS_mosaic, EMBCK_mosaic,                     & ! danli mosaic
+                 ZNT_mosaic, Z0_mosaic,                          & ! danli mosaic 
+                 HFX_mosaic,QFX_mosaic,                          & ! danli mosaic
+                 LH_mosaic, GRDFLX_mosaic, SNOTIME_mosaic,       & ! danli mosaic                   
+                 RC_mosaic, LAI_mosaic,                          &
+! Noah UA changes
+                  ua_phys,flx4_2d,fvb_2d,fbur_2d,fgsn_2d,       &
+                  ids,ide, jds,jde, kds,kde,                    &
+                  ims,ime, jms,jme, kms,kme,                    &
+                  its,ite, jts,jte, kts,kte,                    &
+                  sf_urban_physics,                             &
+                  CMR_SFCDIF,CHR_SFCDIF,CMC_SFCDIF,CHC_SFCDIF,  &
+                  CMGR_SFCDIF,CHGR_SFCDIF,                      &
+!Optional Urban
+                  TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !H urban
+                  UC_URB2D,                                     & !H urban
+                  XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D,  & !H urban
+                  TRL_URB3D,TBL_URB3D,TGL_URB3D,                & !H urban
+                  SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D,TS_URB2D,  & !H urban
+                  TR_URB2D_mosaic,TB_URB2D_mosaic,              & !H urban  danli mosaic
+                  TG_URB2D_mosaic,TC_URB2D_mosaic,              & !H urban  danli mosaic
+                  QC_URB2D_mosaic,UC_URB2D_mosaic,              & !H urban  danli mosaic                  
+                  TRL_URB3D_mosaic,TBL_URB3D_mosaic,            & !H urban  danli mosaic
+                  TGL_URB3D_mosaic,                             & !H urban  danli mosaic
+                  SH_URB2D_mosaic,LH_URB2D_mosaic,              & !H urban  danli mosaic
+                  G_URB2D_mosaic,RN_URB2D_mosaic,               & !H urban  danli mosaic
+                  TS_URB2D_mosaic,                              & !H urban  danli mosaic
+                  TS_RUL2D_mosaic,                              & !H urban  danli mosaic                  
+                  PSIM_URB2D,PSIH_URB2D,U10_URB2D,V10_URB2D,    & !O urban
+                  GZ1OZ0_URB2D,  AKMS_URB2D,                    & !O urban
+                  TH2_URB2D,Q2_URB2D, UST_URB2D,                & !O urban
+                  DECLIN_URB,COSZ_URB2D,OMG_URB2D,              & !I urban
+                  XLAT_URB2D,                                   & !I urban
+                  num_roof_layers, num_wall_layers,             & !I urban
+                  num_road_layers, DZR, DZB, DZG,               & !I urban
+                  CMCR_URB2D,TGR_URB2D,TGRL_URB3D,SMR_URB3D,    & !H urban
+                  julian,julyr,                                 & !H urban
+                  DRELR_URB2D,DRELB_URB2D,DRELG_URB2D,          & !H urban
+                  FLXHUMR_URB2D,FLXHUMB_URB2D,FLXHUMG_URB2D,    & !H urban
+                  FRC_URB2D,UTYPE_URB2D,                        & !O
+                  num_urban_layers,                             & !I multi-layer urban
+                  num_urban_hi,                                 & !I multi-layer urban
+                  tsk_rural_bep,                                & !H multi-layer urban
+                  trb_urb4d,tw1_urb4d,tw2_urb4d,tgb_urb4d,      & !H multi-layer urban
+                  tlev_urb3d,qlev_urb3d,                        & !H multi-layer urban
+                  tw1lev_urb3d,tw2lev_urb3d,                    & !H multi-layer urban
+                  tglev_urb3d,tflev_urb3d,                      & !H multi-layer urban
+                  sf_ac_urb3d,lf_ac_urb3d,cm_ac_urb3d,          & !H multi-layer urban
+                  sfvent_urb3d,lfvent_urb3d,                    & !H multi-layer urban
+                  sfwin1_urb3d,sfwin2_urb3d,                    & !H multi-layer urban
+                  sfw1_urb3d,sfw2_urb3d,sfr_urb3d,sfg_urb3d,    & !H multi-layer urban
+                  lp_urb2d,hi_urb2d,lb_urb2d,hgt_urb2d,         & !H multi-layer urban
+                  mh_urb2d,stdh_urb2d,lf_urb2d,                 & !SLUCM
+                  th_phy,rho,p_phy,ust,                         & !I multi-layer urban
+                  gmt,julday,xlong,xlat,                        & !I multi-layer urban
+                  a_u_bep,a_v_bep,a_t_bep,a_q_bep,              & !O multi-layer urban
+                  a_e_bep,b_u_bep,b_v_bep,                      & !O multi-layer urban
+                  b_t_bep,b_q_bep,b_e_bep,dlg_bep,              & !O multi-layer urban
+                  dl_u_bep,sf_bep,vl_bep                        & !O multi-layer urban
+                 ,sfcheadrt,INFXSRT, soldrain                   & !hydro
+                 ,SDA_HFX, SDA_QFX, HFX_BOTH, QFX_BOTH, QNORM, fasdas     &   !fasdas
+                 ,RC2,XLAI2                                     & !O
+                  )
+
+!----------------------------------------------------------------
+    IMPLICIT NONE
+!----------------------------------------------------------------
+!----------------------------------------------------------------
+! --- atmospheric (WRF generic) variables
+!-- DT          time step (seconds)
+!-- DZ8W        thickness of layers (m)
+!-- T3D         temperature (K)
+!-- QV3D        3D water vapor mixing ratio (Kg/Kg)
+!-- P3D         3D pressure (Pa)
+!-- FLHC        exchange coefficient for heat (m/s)
+!-- FLQC        exchange coefficient for moisture (m/s)
+!-- PSFC        surface pressure (Pa)
+!-- XLAND       land mask (1 for land, 2 for water)
+!-- QGH         saturated mixing ratio at 2 meter
+!-- GSW         downward short wave flux at ground surface (W/m^2)
+!-- GLW         downward long wave flux at ground surface (W/m^2)
+!-- History variables
+!-- CANWAT      canopy moisture content (mm)
+!-- TSK         surface temperature (K)
+!-- TSLB        soil temp (k)
+!-- SMOIS       total soil moisture content (volumetric fraction)
+!-- SH2O        unfrozen soil moisture content (volumetric fraction)
+!                note: frozen soil moisture (i.e., soil ice) = SMOIS - SH2O
+!-- SNOWH       actual snow depth (m)
+!-- SNOW        liquid water-equivalent snow depth (m)
+!-- ALBEDO      time-varying surface albedo including snow effect (unitless fraction)
+!-- ALBBCK      background surface albedo (unitless fraction)
+!-- CHS          surface exchange coefficient for heat and moisture (m s-1);
+!-- CHS2        2m surface exchange coefficient for heat  (m s-1);
+!-- CQS2        2m surface exchange coefficient for moisture (m s-1);
+! --- soil variables
+!-- num_soil_layers   the number of soil layers
+!-- ZS          depths of centers of soil layers   (m)
+!-- DZS         thicknesses of soil layers (m)
+!-- SLDPTH      thickness of each soil layer (m, same as DZS)
+!-- TMN         soil temperature at lower boundary (K)
+!-- SMCWLT      wilting point (volumetric)
+!-- SMCDRY      dry soil moisture threshold where direct evap from
+!               top soil layer ends (volumetric)
+!-- SMCREF      soil moisture threshold below which transpiration begins to
+!                   stress (volumetric)
+!-- SMCMAX      porosity, i.e. saturated value of soil moisture (volumetric)
+!-- NROOT       number of root layers, a function of veg type, determined
+!               in subroutine redprm.
+!-- SMSTAV      Soil moisture availability for evapotranspiration (
+!                   fraction between SMCWLT and SMCMXA)
+!-- SMSTOT      Total soil moisture content frozen+unfrozen) in the soil column (mm)
+! --- snow variables
+!-- SNOWC       fraction snow coverage (0-1.0)
+! --- vegetation variables
+!-- SNOALB      upper bound on maximum albedo over deep snow
+!-- SHDMIN      minimum areal fractional coverage of annual green vegetation
+!-- SHDMAX      maximum areal fractional coverage of annual green vegetation
+!-- XLAI        leaf area index (dimensionless)
+!-- Z0BRD       Background fixed roughness length (M)
+!-- Z0          Background vroughness length (M) as function
+!-- ZNT         Time varying roughness length (M) as function
+!-- ALBD(IVGTPK,ISN) background albedo reading from a table
+! --- LSM output
+!-- HFX         upward heat flux at the surface (W/m^2)
+!-- QFX         upward moisture flux at the surface (kg/m^2/s)
+!-- LH          upward moisture flux at the surface (W m-2)
+!-- GRDFLX(I,J) ground heat flux (W m-2)
+!-- FDOWN       radiation forcing at the surface (W m-2) = SOLDN*(1-alb)+LWDN
+!----------------------------------------------------------------------------
+!-- EC          canopy water evaporation ((W m-2)
+!-- EDIR        direct soil evaporation (W m-2)
+!-- ET          plant transpiration from a particular root layer (W m-2)
+!-- ETT         total plant transpiration (W m-2)
+!-- ESNOW       sublimation from (or deposition to if <0) snowpack (W m-2)
+!-- DRIP        through-fall of precip and/or dew in excess of canopy
+!                 water-holding capacity (m)
+!-- DEW         dewfall (or frostfall for t<273.15) (M)
+!-- SMAV        Soil Moisture Availability for each layer, as a fraction
+!                 between SMCWLT and SMCMAX (dimensionless fraction)
+! ----------------------------------------------------------------------
+!-- BETA        ratio of actual/potential evap (dimensionless)
+!-- ETP         potential evaporation (W m-2)
+! ----------------------------------------------------------------------
+!-- FLX1        precip-snow sfc (W m-2)
+!-- FLX2        freezing rain latent heat flux (W m-2)
+!-- FLX3        phase-change heat flux from snowmelt (W m-2)
+! ----------------------------------------------------------------------
+!-- ACSNOM      snow melt (mm) (water equivalent)
+!-- ACSNOW      accumulated snow fall (mm) (water equivalent)
+!-- SNOPCX      snow phase change heat flux (W/m^2)
+!-- POTEVP      accumulated potential evaporation (m)
+!-- RIB         Documentation needed!!!
+! ----------------------------------------------------------------------
+!-- RUNOFF1     surface runoff (m s-1), not infiltrating the surface
+!-- RUNOFF2     subsurface runoff (m s-1), drainage out bottom of last
+!                  soil layer (baseflow)
+!  important note: here RUNOFF2 is actually the sum of RUNOFF2 and RUNOFF3
+!-- RUNOFF3     numerical trunctation in excess of porosity (smcmax)
+!                  for a given soil layer at the end of a time step (m s-1).
+!SFCRUNOFF     Surface Runoff (mm)
+!UDRUNOFF      Total Underground Runoff (mm), which is the sum of RUNOFF2 and RUNOFF3
+! ----------------------------------------------------------------------
+!-- RC          canopy resistance (s m-1)
+!-- PC          plant coefficient (unitless fraction, 0-1) where PC*ETP = actual transp
+!-- RSMIN       minimum canopy resistance (s m-1)
+!-- RCS         incoming solar rc factor (dimensionless)
+!-- RCT         air temperature rc factor (dimensionless)
+!-- RCQ         atmos vapor pressure deficit rc factor (dimensionless)
+!-- RCSOIL      soil moisture rc factor (dimensionless)
+
+!-- EMISS       surface emissivity (between 0 and 1)
+!-- EMBCK       Background surface emissivity (between 0 and 1)
+
+!-- ROVCP       R/CP
+!               (R_d/R_v) (dimensionless)
+!-- ids         start index for i in domain
+!-- ide         end index for i in domain
+!-- jds         start index for j in domain
+!-- jde         end index for j in domain
+!-- kds         start index for k in domain
+!-- kde         end index for k in domain
+!-- ims         start index for i in memory
+!-- ime         end index for i in memory
+!-- jms         start index for j in memory
+!-- jme         end index for j in memory
+!-- kms         start index for k in memory
+!-- kme         end index for k in memory
+!-- its         start index for i in tile
+!-- ite         end index for i in tile
+!-- jts         start index for j in tile
+!-- jte         end index for j in tile
+!-- kts         start index for k in tile
+!-- kte         end index for k in tile
+!
+!-- SR          fraction of frozen precip (0.0 to 1.0)
+!----------------------------------------------------------------
+
+! IN only
+
+   INTEGER,  INTENT(IN   )   ::     ids,ide, jds,jde, kds,kde,  &
+                                    ims,ime, jms,jme, kms,kme,  &
+                                    its,ite, jts,jte, kts,kte
+
+   INTEGER,  INTENT(IN   )   ::  sf_urban_physics               !urban
+   INTEGER,  INTENT(IN   )   ::  isurban
+   INTEGER,  INTENT(IN   )   ::  isice
+   INTEGER,  INTENT(IN   )   ::  julian,julyr
+
+!added by Wei Yu  for routing
+    REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+             INTENT(INOUT)  :: sfcheadrt,INFXSRT,soldrain 
+    real :: etpnd1
+!end added
+
+   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(IN   )    ::                            TMN, &
+                                                         XLAND, &
+                                                          XICE, &
+                                                        VEGFRA, &
+                                                        SHDMIN, &
+                                                        SHDMAX, &
+                                                        SNOALB, &
+                                                           GSW, &
+                                                        SWDOWN, & !added 10 jan 2007
+                                                           GLW, &
+                                                        RAINBL, &
+                                                        SR
+
+   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(INOUT)    ::                         ALBBCK, &
+                                                            Z0, &
+                                                         EMBCK                  ! danli mosaic
+                                                         
+   CHARACTER(LEN=*), INTENT(IN   )    ::                 MMINLU
+
+   REAL,    DIMENSION( ims:ime, kms:kme, jms:jme )            , &
+            INTENT(IN   )    ::                           QV3D, &
+                                                         p8w3D, &
+                                                          DZ8W, &
+                                                          T3D
+   REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+             INTENT(IN   )               ::               QGH,  &
+                                                          CPM
+
+   INTEGER, DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(IN   )    ::                          ISLTYP
+                                                        
+   INTEGER, DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(INOUT   )    ::                         IVGTYP                   ! for mosaic danli
+
+   INTEGER, INTENT(IN)       ::     num_soil_layers,ITIMESTEP
+
+   REAL,     INTENT(IN   )   ::     DT,ROVCP
+
+   REAL,     DIMENSION(1:num_soil_layers), INTENT(IN)::DZS
+
+! IN and OUT
+
+   REAL,     DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &
+             INTENT(INOUT)   ::                          SMOIS, & ! total soil moisture
+                                                         SH2O,  & ! new soil liquid
+                                                         TSLB     ! TSLB     STEMP
+
+   REAL,     DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &
+             INTENT(OUT)     ::                         SMCREL
+
+   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(INOUT)    ::                            TSK, & !was TGB (temperature)
+                                                           HFX, &
+                                                           QFX, &
+                                                            LH, &
+                                                        GRDFLX, &
+                                                          QSFC,&
+                                                          CQS2,&
+                                                          CHS,   &
+                                                          CHS2,&
+                                                          SNOW, &
+                                                         SNOWC, &
+                                                         SNOWH, & !new
+                                                        CANWAT, &
+                                                        SMSTAV, &
+                                                        SMSTOT, &
+                                                     SFCRUNOFF, &
+                                                      UDRUNOFF, &
+                                                        ACSNOM, &
+                                                        ACSNOW, &
+                                                       SNOTIME, &
+                                                        SNOPCX, &
+                                                        EMISS,  &
+                                                          RIB,  &
+                                                        POTEVP, &
+                                                        ALBEDO, &
+                                                           ZNT
+   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(OUT)      ::                         NOAHRES
+   INTEGER,                                INTENT(IN)  :: OPT_THCND
+
+! Noah UA changes
+   LOGICAL,                                INTENT(IN)  :: UA_PHYS
+   REAL,    DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: FLX4_2D,FVB_2D,FBUR_2D,FGSN_2D
+   REAL                                                :: FLX4,FVB,FBUR,FGSN
+
+   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+               INTENT(OUT)    ::                        CHKLOWQ
+   REAL,    DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LAI
+   REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) ::        QZ0
+   REAL,    DIMENSION( ims:ime, jms:jme ), INTENT(OUT)   :: RC2, XLAI2
+
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMR_SFCDIF
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHR_SFCDIF
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMGR_SFCDIF
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHGR_SFCDIF
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMC_SFCDIF
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHC_SFCDIF
+! Local variables (moved here from driver to make routine thread safe, 20031007 jm)
+
+      REAL, DIMENSION(1:num_soil_layers) ::  ET
+
+      REAL, DIMENSION(1:num_soil_layers) ::  SMAV
+
+      REAL  ::  BETA, ETP, SSOIL,EC, EDIR, ESNOW, ETT,        &
+                FLX1,FLX2,FLX3, DRIP,DEW,FDOWN,RC,PC,RSMIN,XLAI,  &
+!                RCS,RCT,RCQ,RCSOIL
+                RCS,RCT,RCQ,RCSOIL,FFROZP
+
+    LOGICAL,    INTENT(IN   )    ::     myj,frpcpn
+
+! DECLARATIONS - LOGICAL
+! ----------------------------------------------------------------------
+      LOGICAL, PARAMETER :: LOCAL=.false.
+      LOGICAL :: FRZGRA, SNOWNG
+
+      LOGICAL :: IPRINT
+
+! ----------------------------------------------------------------------
+! DECLARATIONS - INTEGER
+! ----------------------------------------------------------------------
+      INTEGER :: I,J, ICE,NSOIL,SLOPETYP,SOILTYP,VEGTYP
+      INTEGER :: NROOT
+      INTEGER :: KZ ,K
+      INTEGER :: NS
+! ----------------------------------------------------------------------
+! DECLARATIONS - REAL
+! ----------------------------------------------------------------------
+
+      REAL  :: SHMIN,SHMAX,DQSDT2,LWDN,PRCP,PRCPRAIN,                    &
+               Q2SAT,Q2SATI,SFCPRS,SFCSPD,SFCTMP,SHDFAC,SNOALB1,         &
+               SOLDN,TBOT,ZLVL, Q2K,ALBBRD, ALBEDOK, ETA, ETA_KINEMATIC, &
+               EMBRD,                                                    &
+               Z0K,RUNOFF1,RUNOFF2,RUNOFF3,SHEAT,SOLNET,E2SAT,SFCTSNO,   &
+! mek, WRF testing, expanded diagnostics
+               SOLUP,LWUP,RNET,RES,Q1SFC,TAIRV,SATFLG
+! MEK MAY 2007
+      REAL ::  FDTLIW
+! MEK JUL2007 for pot. evap.
+      REAL :: RIBB
+      REAL ::  FDTW
+
+      REAL  :: EMISSI
+
+      REAL  :: SNCOVR,SNEQV,SNOWHK,CMC, CHK,TH2
+
+      REAL  :: SMCDRY,SMCMAX,SMCREF,SMCWLT,SNOMLT,SOILM,SOILW,Q1,T1
+      REAL  :: SNOTIME1    ! LSTSNW1 INITIAL NUMBER OF TIMESTEPS SINCE LAST SNOWFALL
+
+      REAL  :: DUMMY,Z0BRD
+!
+      REAL  :: COSZ, SOLARDIRECT
+!
+      REAL, DIMENSION(1:num_soil_layers)::  SLDPTH, STC,SMC,SWC
+!
+      REAL, DIMENSION(1:num_soil_layers) ::     ZSOIL, RTDIS
+      REAL, PARAMETER  :: TRESH=.95E0, A2=17.67,A3=273.15,A4=29.65,   &
+                          T0=273.16E0, ELWV=2.50E6,  A23M4=A2*(A3-A4)
+! MEK MAY 2007
+      REAL, PARAMETER  :: ROW=1.E3,ELIW=XLF,ROWLIW=ROW*ELIW
+
+! ----------------------------------------------------------------------
+! DECLARATIONS START - urban
+! ----------------------------------------------------------------------
+
+! input variables surface_driver --> lsm
+     INTEGER, INTENT(IN) :: num_roof_layers
+     INTEGER, INTENT(IN) :: num_wall_layers
+     INTEGER, INTENT(IN) :: num_road_layers
+     REAL, OPTIONAL, DIMENSION(1:num_roof_layers), INTENT(IN) :: DZR
+     REAL, OPTIONAL, DIMENSION(1:num_wall_layers), INTENT(IN) :: DZB
+     REAL, OPTIONAL, DIMENSION(1:num_road_layers), INTENT(IN) :: DZG
+     REAL, OPTIONAL, INTENT(IN) :: DECLIN_URB
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZ_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: OMG_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: XLAT_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: U_PHY
+     REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: V_PHY
+     REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: TH_PHY
+     REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: P_PHY
+     REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: RHO
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UST
+
+     LOGICAL, intent(in) :: rdlai2d
+     LOGICAL, intent(in) :: USEMONALB
+
+! input variables lsm --> urban
+     INTEGER :: UTYPE_URB ! urban type [urban=1, suburban=2, rural=3]
+     REAL :: TA_URB       ! potential temp at 1st atmospheric level [K]
+     REAL :: QA_URB       ! mixing ratio at 1st atmospheric level  [kg/kg]
+     REAL :: UA_URB       ! wind speed at 1st atmospheric level    [m/s]
+     REAL :: U1_URB       ! u at 1st atmospheric level             [m/s]
+     REAL :: V1_URB       ! v at 1st atmospheric level             [m/s]
+     REAL :: SSG_URB      ! downward total short wave radiation    [W/m/m]
+     REAL :: LLG_URB      ! downward long wave radiation           [W/m/m]
+     REAL :: RAIN_URB     ! precipitation                          [mm/h]
+     REAL :: RHOO_URB     ! air density                            [kg/m^3]
+     REAL :: ZA_URB       ! first atmospheric level                [m]
+     REAL :: DELT_URB     ! time step                              [s]
+     REAL :: SSGD_URB     ! downward direct short wave radiation   [W/m/m]
+     REAL :: SSGQ_URB     ! downward diffuse short wave radiation  [W/m/m]
+     REAL :: XLAT_URB     ! latitude                               [deg]
+     REAL :: COSZ_URB     ! cosz
+     REAL :: OMG_URB      ! hour angle
+     REAL :: ZNT_URB      ! roughness length                       [m]
+     REAL :: TR_URB
+     REAL :: TB_URB
+     REAL :: TG_URB
+     REAL :: TC_URB
+     REAL :: QC_URB
+     REAL :: UC_URB
+     REAL :: XXXR_URB
+     REAL :: XXXB_URB
+     REAL :: XXXG_URB
+     REAL :: XXXC_URB
+     REAL, DIMENSION(1:num_roof_layers) :: TRL_URB  ! roof layer temp [K]
+     REAL, DIMENSION(1:num_wall_layers) :: TBL_URB  ! wall layer temp [K]
+     REAL, DIMENSION(1:num_road_layers) :: TGL_URB  ! road layer temp [K]
+     LOGICAL  :: LSOLAR_URB
+
+!===Yang,2014/10/08,hydrological variable for single layer UCM===
+     INTEGER :: jmonth, jday, tloc
+     INTEGER :: IRIOPTION, USOIL, DSOIL
+     REAL :: AOASIS, OMG
+     REAL :: DRELR_URB
+     REAL :: DRELB_URB
+     REAL :: DRELG_URB
+     REAL :: FLXHUMR_URB
+     REAL :: FLXHUMB_URB
+     REAL :: FLXHUMG_URB
+     REAL :: CMCR_URB
+     REAL :: TGR_URB
+     REAL, DIMENSION(1:num_roof_layers) :: SMR_URB  ! green roof layer moisture
+     REAL, DIMENSION(1:num_roof_layers) :: TGRL_URB ! green roof layer temp [K]
+
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELR_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELB_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELG_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMR_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMB_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMG_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMCR_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TGR_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TGRL_URB3D
+     REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: SMR_URB3D
+
+! state variable surface_driver <--> lsm <--> urban
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UC_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D
+!
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D
+
+     REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D
+     REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_wall_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D
+     REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_road_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D
+
+! output variable lsm --> surface_driver
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: PSIM_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: PSIH_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: GZ1OZ0_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: U10_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: V10_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: TH2_URB2D
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: Q2_URB2D
+!
+     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: AKMS_URB2D
+!
+     REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: UST_URB2D
+     REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D                ! change this to inout, danli mosaic
+     INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: UTYPE_URB2D
+
+! output variables urban --> lsm
+     REAL :: TS_URB     ! surface radiative temperature    [K]
+     REAL :: QS_URB     ! surface humidity                 [-]
+     REAL :: SH_URB     ! sensible heat flux               [W/m/m]
+     REAL :: LH_URB     ! latent heat flux                 [W/m/m]
+     REAL :: LH_KINEMATIC_URB ! latent heat flux, kinetic  [kg/m/m/s]
+     REAL :: SW_URB     ! upward short wave radiation flux [W/m/m]
+     REAL :: ALB_URB    ! time-varying albedo            [fraction]
+     REAL :: LW_URB     ! upward long wave radiation flux  [W/m/m]
+     REAL :: G_URB      ! heat flux into the ground        [W/m/m]
+     REAL :: RN_URB     ! net radiation                    [W/m/m]
+     REAL :: PSIM_URB   ! shear f for momentum             [-]
+     REAL :: PSIH_URB   ! shear f for heat                 [-]
+     REAL :: GZ1OZ0_URB   ! shear f for heat                 [-]
+     REAL :: U10_URB    ! wind u component at 10 m         [m/s]
+     REAL :: V10_URB    ! wind v component at 10 m         [m/s]
+     REAL :: TH2_URB    ! potential temperature at 2 m     [K]
+     REAL :: Q2_URB     ! humidity at 2 m                  [-]
+     REAL :: CHS_URB
+     REAL :: CHS2_URB
+     REAL :: UST_URB
+! NUDAPT Parameters urban --> lam
+     REAL :: mh_urb
+     REAL :: stdh_urb
+     REAL :: lp_urb
+     REAL :: hgt_urb
+     REAL, DIMENSION(4) :: lf_urb
+! Variables for multi-layer UCM (Martilli et al. 2002)
+   REAL, OPTIONAL, INTENT(IN  )   ::                                   GMT 
+   INTEGER, OPTIONAL, INTENT(IN  ) ::                               JULDAY
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   )        ::XLAT, XLONG
+   INTEGER, INTENT(IN  ) ::                               NUM_URBAN_LAYERS
+   INTEGER, INTENT(IN  ) ::                               NUM_URBAN_HI
+   REAL, OPTIONAL, DIMENSION( ims:ime,                     jms:jme ), INTENT(INOUT) :: tsk_rural_bep
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: trb_urb4d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw1_urb4d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw2_urb4d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tgb_urb4d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tlev_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: qlev_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw1lev_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw2lev_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tglev_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tflev_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lf_ac_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sf_ac_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: cm_ac_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sfvent_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lfvent_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfwin1_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfwin2_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfw1_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfw2_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfr_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfg_urb3d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_hi, jms:jme ), INTENT(IN) :: hi_urb2d
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: lp_urb2d
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: lb_urb2d
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: hgt_urb2d
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: mh_urb2d
+   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: stdh_urb2d
+   REAL, OPTIONAL, DIMENSION( ims:ime, 4, jms:jme ), INTENT(IN) :: lf_urb2d
+   REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_u_bep   !Implicit momemtum component X-direction
+   REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_v_bep   !Implicit momemtum component Y-direction
+   REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_t_bep   !Implicit component pot. temperature
+   REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_q_bep   !Implicit momemtum component X-direction
+   REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_e_bep   !Implicit component TKE
+   REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_u_bep   !Explicit momentum component X-direction
+   REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_v_bep   !Explicit momentum component Y-direction
+   REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_t_bep   !Explicit component pot. temperature
+   REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_q_bep   !Implicit momemtum component Y-direction
+   REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_e_bep   !Explicit component TKE
+   REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::vl_bep    !Fraction air volume in grid cell
+   REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::dlg_bep   !Height above ground
+   REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::sf_bep  !Fraction air at the face of grid cell
+   REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::dl_u_bep  !Length scale
+
+! Local variables for multi-layer UCM (Martilli et al. 2002)
+   REAL,    DIMENSION( its:ite, jts:jte ) :: HFX_RURAL,LH_RURAL,GRDFLX_RURAL ! ,RN_RURAL
+   REAL,    DIMENSION( its:ite, jts:jte ) :: QFX_RURAL ! ,QSFC_RURAL,UMOM_RURAL,VMOM_RURAL
+   REAL,    DIMENSION( its:ite, jts:jte ) :: ALB_RURAL,EMISS_RURAL,TSK_RURAL ! ,UST_RURAL
+!   REAL,    DIMENSION( ims:ime, jms:jme ) :: QSFC_URB
+   REAL,    DIMENSION( its:ite, jts:jte ) :: HFX_URB,UMOM_URB,VMOM_URB
+   REAL,    DIMENSION( its:ite, jts:jte ) :: QFX_URB
+!   REAL,    DIMENSION( ims:ime, jms:jme ) :: ALBEDO_URB,EMISS_URB,UMOM,VMOM,UST
+   REAL, DIMENSION(its:ite,jts:jte) ::EMISS_URB
+   REAL, DIMENSION(its:ite,jts:jte) :: RL_UP_URB
+   REAL, DIMENSION(its:ite,jts:jte) ::RS_ABS_URB
+   REAL, DIMENSION(its:ite,jts:jte) ::GRDFLX_URB
+   REAL :: SIGMA_SB,RL_UP_RURAL,RL_UP_TOT,RS_ABS_TOT,UMOM,VMOM
+   REAL :: CMR_URB, CHR_URB, CMC_URB, CHC_URB, CMGR_URB, CHGR_URB
+   REAL :: frc_urb,lb_urb
+   REAL :: check 
+! ----------------------------------------------------------------------
+! DECLARATIONS END - urban
+! ----------------------------------------------------------------------
+!-------------------------------------------------
+! Noah-mosaic related variables are added to declaration  (danli)
+!-------------------------------------------------
+  
+  INTEGER, INTENT(IN) :: sf_surface_mosaic    
+  INTEGER, INTENT(IN) :: mosaic_cat, NLCAT
+  REAL, DIMENSION( ims:ime, NLCAT, jms:jme ), INTENT(IN) :: landusef 
+  REAL, DIMENSION( ims:ime, NLCAT, jms:jme ), INTENT(INOUT) ::landusef2 
+  INTEGER, DIMENSION( ims:ime, NLCAT, jms:jme ), INTENT(INOUT) :: mosaic_cat_index 
+
+  REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT)::   &
+        TSK_mosaic, QSFC_mosaic, CANWAT_mosaic, SNOW_mosaic,SNOWH_mosaic, SNOWC_mosaic 
+  REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT)::   &
+        ALBEDO_mosaic,ALBBCK_mosaic, EMISS_mosaic, EMBCK_mosaic, ZNT_mosaic, Z0_mosaic,   &
+        HFX_mosaic,QFX_mosaic, LH_mosaic, GRDFLX_mosaic,SNOTIME_mosaic    
+  REAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), OPTIONAL, INTENT(INOUT)::   &
+        TSLB_mosaic,SMOIS_mosaic,SH2O_mosaic
+  REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ), OPTIONAL, INTENT(INOUT):: LAI_mosaic, RC_mosaic
+
+  REAL, DIMENSION( ims:ime, jms:jme ) :: TSK_mosaic_avg, QSFC_mosaic_avg, CANWAT_mosaic_avg,SNOW_mosaic_avg,SNOWH_mosaic_avg, &
+                                         SNOWC_mosaic_avg, HFX_mosaic_avg, QFX_mosaic_avg, LH_mosaic_avg, GRDFLX_mosaic_avg,  &
+                                         ALBEDO_mosaic_avg, ALBBCK_mosaic_avg, EMISS_mosaic_avg, EMBCK_mosaic_avg,            &
+                                         ZNT_mosaic_avg, Z0_mosaic_avg, LAI_mosaic_avg, RC_mosaic_avg, SNOTIME_mosaic_avg,    &
+                                         FAREA_mosaic_avg
+  REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme )                     ::   &
+        TSLB_mosaic_avg,SMOIS_mosaic_avg,SH2O_mosaic_avg
+  
+  REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT)::   &
+        TR_URB2D_mosaic, TB_URB2D_mosaic, TG_URB2D_mosaic, TC_URB2D_mosaic,QC_URB2D_mosaic, UC_URB2D_mosaic, &
+        SH_URB2D_mosaic,LH_URB2D_mosaic,G_URB2D_mosaic,RN_URB2D_mosaic,TS_URB2D_mosaic, TS_RUL2D_mosaic  
+                  
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_roof_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TRL_URB3D_mosaic
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_wall_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TBL_URB3D_mosaic
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_road_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TGL_URB3D_mosaic
+
+  INTEGER, DIMENSION( ims:ime, jms:jme ) ::    IVGTYP_dominant
+  INTEGER ::  mosaic_i, URBAN_METHOD, zo_avg_option
+  REAL :: FAREA
+  LOGICAL :: IPRINT_mosaic, Noah_call
+!-------------------------------------------------
+! Noah-mosaic related variables declaration end (danli)
+!-------------------------------------------------
+
+  REAL, PARAMETER  :: CAPA=R_D/CP
+  REAL :: APELM,APES,SFCTH2,PSFC
+  real, intent(in) :: xice_threshold
+  character(len=80) :: message_text
+!
+!  FASDAS: it doesn't work for mosaic, but we need the variables to call sflx
+!
+   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(INOUT)  ::   SDA_HFX, SDA_QFX, HFX_BOTH, QFX_BOTH, QNORM
+   INTEGER, INTENT(IN   )  ::  fasdas
+   REAL                    ::  XSDA_HFX, XSDA_QFX, XQNORM
+   REAL                    ::  HFX_PHY, QFX_PHY
+   REAL                    ::  DZQ
+   REAL                    ::  HCPCT_FASDAS
+
+   HFX_PHY = 0.0   ! initialize
+   QFX_PHY = 0.0
+   XQNORM  = 0.0
+   XSDA_HFX = 0.0
+   XSDA_QFX = 0.0
+!
+!  END FASDAS
+!
+! MEK MAY 2007
+      FDTLIW=DT/ROWLIW
+! MEK JUL2007
+      FDTW=DT/(XLV*RHOWATER)
+! debug printout
+      IPRINT=.false.
+      IPRINT_mosaic=.false.
+
+!      SLOPETYP=2
+      SLOPETYP=1
+!      SHDMIN=0.00
+
+      NSOIL=num_soil_layers
+
+     DO NS=1,NSOIL
+     SLDPTH(NS)=DZS(NS)
+     ENDDO
+
+     JLOOP : DO J=jts,jte
+
+      IF(ITIMESTEP.EQ.1)THEN
+        DO 50 I=its,ite
+!*** initialize soil conditions for IHOP 31 May case
+!         IF((XLAND(I,J)-1.5) < 0.)THEN
+!            if (I==108.and.j==85) then
+!                  DO NS=1,NSOIL
+!                      SMOIS(I,NS,J)=0.10
+!                      SH2O(I,NS,J)=0.10
+!                  enddo
+!             endif
+!         ENDIF
+
+!*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS
+          IF((XLAND(I,J)-1.5).GE.0.)THEN
+! check sea-ice point
+#if 0
+            IF( XICE(I,J).GE. XICE_THRESHOLD .and. IPRINT ) PRINT*, ' sea-ice at water point, I=',I,'J=',J
+#endif
+!***   Open Water Case
+            SMSTAV(I,J)=1.0
+            SMSTOT(I,J)=1.0
+            DO NS=1,NSOIL
+              SMOIS(I,NS,J)=1.0
+              TSLB(I,NS,J)=273.16                                          !STEMP
+              SMCREL(I,NS,J)=1.0
+            ENDDO
+          ELSE
+            IF ( XICE(I,J) .GE. XICE_THRESHOLD ) THEN
+!***        SEA-ICE CASE
+              SMSTAV(I,J)=1.0
+              SMSTOT(I,J)=1.0
+              DO NS=1,NSOIL
+                SMOIS(I,NS,J)=1.0
+                SMCREL(I,NS,J)=1.0
+              ENDDO
+            ENDIF
+          ENDIF
+!
+   50   CONTINUE
+      ENDIF                                                               ! end of initialization over ocean
+
+!-----------------------------------------------------------------------
+      ILOOP : DO I=its,ite
+      
+         IF (((XLAND(I,J)-1.5).LT.0.) .AND. (XICE(I,J) < XICE_THRESHOLD) ) THEN
+               
+               IVGTYP_dominant(I,J)=IVGTYP(I,J)                                   ! save this
+      
+            ! INITIALIZE THE AREA-AVERAGED FLUXES 
+               
+                 TSK_mosaic_avg(i,j)= 0.0                              ! from 3D to 2D
+                 QSFC_mosaic_avg(i,j)= 0.0
+                 CANWAT_mosaic_avg(i,j)= 0.0
+                 SNOW_mosaic_avg(i,j)= 0.0
+                 SNOWH_mosaic_avg(i,j)= 0.0
+                 SNOWC_mosaic_avg(i,j)= 0.0
+            
+                          DO NS=1,NSOIL
+            
+                     TSLB_mosaic_avg(i,NS,j)=0.0
+                     SMOIS_mosaic_avg(i,NS,j)=0.0
+                     SH2O_mosaic_avg(i,NS,j)=0.0
+            
+                         ENDDO
+            
+                 HFX_mosaic_avg(i,j)= 0.0
+                 QFX_mosaic_avg(i,j)= 0.0
+                 LH_mosaic_avg(i,j)=  0.0
+                 GRDFLX_mosaic_avg(i,j)= 0.0
+                 ALBEDO_mosaic_avg(i,j)=0.0
+                 ALBBCK_mosaic_avg(i,j)=0.0
+                 EMISS_mosaic_avg(i,j)=0.0
+                 EMBCK_mosaic_avg(i,j)=0.0
+                 ZNT_mosaic_avg(i,j)=0.0
+                 Z0_mosaic_avg(i,j)=0.0
+                 LAI_mosaic_avg(i,j)=0.0
+                 RC_mosaic_avg(i,j)=0.0
+                 FAREA_mosaic_avg(i,j)=0.0
+            
+            ! add a new loop for the mosaic_cat
+            
+               DO mosaic_i = mosaic_cat, 1, -1
+               
+            !   if (mosaic_cat_index(I,mosaic_i,J) .EQ. 16 ) then
+            !   PRINT*, 'you still have water tiles at','i=',i,'j=',j, 'mosaic_i',mosaic_i
+            !   PRINT*, 'xland',xland(i,j),'xice',xice(i,j)
+            !   endif
+               
+               IVGTYP(I,J)=mosaic_cat_index(I,mosaic_i,J)                         ! replace it with the mosaic one          
+               TSK(I,J)=TSK_mosaic(I,mosaic_i,J)                                  ! from 3D to 2D
+               QSFC(i,j)=QSFC_mosaic(I,mosaic_i,J)
+               CANWAT(i,j)=CANWAT_mosaic(i,mosaic_i,j) 
+               SNOW(i,j)=SNOW_mosaic(i,mosaic_i,j) 
+               SNOWH(i,j)=SNOWH_mosaic(i,mosaic_i,j)  
+               SNOWC(i,j)=SNOWC_mosaic(i,mosaic_i,j)
+            
+                ALBEDO(i,j) = ALBEDO_mosaic(i,mosaic_i,j)
+                ALBBCK(i,j)= ALBBCK_mosaic(i,mosaic_i,j) 
+                EMISS(i,j)= EMISS_mosaic(i,mosaic_i,j) 
+                EMBCK(i,j)= EMBCK_mosaic(i,mosaic_i,j) 
+                ZNT(i,j)= ZNT_mosaic(i,mosaic_i,j) 
+                Z0(i,j)= Z0_mosaic(i,mosaic_i,j)    
+            
+                 SNOTIME(i,j)= SNOTIME_mosaic(i,mosaic_i,j)          
+              
+                          DO NS=1,NSOIL
+            
+                     TSLB(i,NS,j)=TSLB_mosaic(i,NSOIL*(mosaic_i-1)+NS,j)
+                     SMOIS(i,NS,j)=SMOIS_mosaic(i,NSOIL*(mosaic_i-1)+NS,j)
+                     SH2O(i,NS,j)=SH2O_mosaic(i,NSOIL*(mosaic_i-1)+NS,j)
+            
+                          ENDDO
+            
+                       IF(IPRINT_mosaic) THEN
+            
+                   print*, 'BEFORE SFLX, in Noahdrv.F'
+                   print*, 'mosaic_cat', mosaic_cat, 'IVGTYP',IVGTYP(i,j), 'TSK',TSK(i,j),'HFX',HFX(i,j), 'QSFC', QSFC(i,j),   &
+                   'CANWAT', CANWAT(i,j), 'SNOW',SNOW(i,j), 'ALBEDO',ALBEDO(i,j), 'TSLB',TSLB(i,1,j),'CHS',CHS(i,j),'ZNT',ZNT(i,j)
+            
+                       ENDIF
+            
+            !-----------------------------------------------------------------------
+            ! insert the NOAH model here for the non-urban one and the urban one  DANLI
+            !-----------------------------------------------------------------------
+            
+      ! surface pressure
+              PSFC=P8w3D(i,1,j)
+      ! pressure in middle of lowest layer
+              SFCPRS=(P8W3D(I,KTS+1,j)+P8W3D(i,KTS,j))*0.5
+      ! convert from mixing ratio to specific humidity
+               Q2K=QV3D(i,1,j)/(1.0+QV3D(i,1,j))
+      !
+      !         Q2SAT=QGH(I,j)
+               Q2SAT=QGH(I,J)/(1.0+QGH(I,J))        ! Q2SAT is sp humidity
+      ! add check on myj=.true.
+      !        IF((Q2K.GE.Q2SAT*TRESH).AND.Q2K.LT.QZ0(I,J))THEN
+              IF((myj).AND.(Q2K.GE.Q2SAT*TRESH).AND.Q2K.LT.QZ0(I,J))THEN
+                SATFLG=0.
+                CHKLOWQ(I,J)=0.
+              ELSE
+                SATFLG=1.0
+                CHKLOWQ(I,J)=1.
+              ENDIF
+      
+              SFCTMP=T3D(i,1,j)
+              ZLVL=0.5*DZ8W(i,1,j)
+      
+      !        TH2=SFCTMP+(0.0097545*ZLVL)
+      ! calculate SFCTH2 via Exner function vs lapse-rate (above)
+               APES=(1.E5/PSFC)**CAPA
+               APELM=(1.E5/SFCPRS)**CAPA
+               SFCTH2=SFCTMP*APELM
+               TH2=SFCTH2/APES
+      !
+               EMISSI = EMISS(I,J)
+               LWDN=GLW(I,J)*EMISSI
+      ! SOLDN is total incoming solar
+              SOLDN=SWDOWN(I,J)
+      ! GSW is net downward solar
+      !        SOLNET=GSW(I,J)
+      ! use mid-day albedo to determine net downward solar (no solar zenith angle correction)
+              SOLNET=SOLDN*(1.-ALBEDO(I,J))
+              PRCP=RAINBL(i,j)/DT
+              VEGTYP=IVGTYP(I,J)
+              SOILTYP=ISLTYP(I,J)
+              SHDFAC=VEGFRA(I,J)/100.
+              T1=TSK(I,J)
+              CHK=CHS(I,J)
+              SHMIN=SHDMIN(I,J)/100. !NEW
+              SHMAX=SHDMAX(I,J)/100. !NEW
+      ! convert snow water equivalent from mm to meter
+              SNEQV=SNOW(I,J)*0.001
+      ! snow depth in meters
+              SNOWHK=SNOWH(I,J)
+              SNCOVR=SNOWC(I,J)
+      
+      ! if "SR" present, set frac of frozen precip ("FFROZP") = snow-ratio ("SR", range:0-1)
+      ! SR from e.g. Ferrier microphysics
+      ! otherwise define from 1st atmos level temperature
+             IF(FRPCPN) THEN
+                FFROZP=SR(I,J)
+              ELSE
+                IF (SFCTMP <=  273.15) THEN
+                  FFROZP = 1.0
+      	  ELSE
+      	    FFROZP = 0.0
+      	  ENDIF
+              ENDIF
+      !***
+              IF((XLAND(I,J)-1.5).GE.0.)THEN                                  ! begining of land/sea if block
+      ! Open water points
+                TSK_RURAL(I,J)=TSK(I,J)
+                HFX_RURAL(I,J)=HFX(I,J)
+                QFX_RURAL(I,J)=QFX(I,J)
+                LH_RURAL(I,J)=LH(I,J)
+                EMISS_RURAL(I,J)=EMISS(I,J)
+                GRDFLX_RURAL(I,J)=GRDFLX(I,J)
+              ELSE
+      ! Land or sea-ice case
+      
+                IF (XICE(I,J) >= XICE_THRESHOLD) THEN
+                   ! Sea-ice point
+                   ICE = 1
+                ELSE IF ( VEGTYP == ISICE ) THEN
+                   ! Land-ice point
+                   ICE = -1
+                ELSE
+                   ! Neither sea ice or land ice.
+                   ICE=0
+                ENDIF
+                DQSDT2=Q2SAT*A23M4/(SFCTMP-A4)**2
+      
+                IF(SNOW(I,J).GT.0.0)THEN
+      ! snow on surface (use ice saturation properties)
+                  SFCTSNO=SFCTMP
+                  E2SAT=611.2*EXP(6174.*(1./273.15 - 1./SFCTSNO))
+                  Q2SATI=0.622*E2SAT/(SFCPRS-E2SAT)
+                  Q2SATI=Q2SATI/(1.0+Q2SATI)    ! spec. hum.
+                  IF (T1 .GT. 273.14) THEN
+      ! warm ground temps, weight the saturation between ice and water according to SNOWC
+                    Q2SAT=Q2SAT*(1.-SNOWC(I,J)) + Q2SATI*SNOWC(I,J)
+                    DQSDT2=DQSDT2*(1.-SNOWC(I,J)) + Q2SATI*6174./(SFCTSNO**2)*SNOWC(I,J)
+                  ELSE
+      ! cold ground temps, use ice saturation only
+                    Q2SAT=Q2SATI
+                    DQSDT2=Q2SATI*6174./(SFCTSNO**2)
+                  ENDIF
+      ! for snow cover fraction at 0 C, ground temp will not change, so DQSDT2 effectively zero
+                  IF(T1 .GT. 273. .AND. SNOWC(I,J) .GT. 0.)DQSDT2=DQSDT2*(1.-SNOWC(I,J))
+                ENDIF
+      
+                ! Land-ice or land points use the usual deep-soil temperature.
+                TBOT=TMN(I,J)
+      
+                IF(VEGTYP.EQ.25) SHDFAC=0.0000
+                IF(VEGTYP.EQ.26) SHDFAC=0.0000
+                IF(VEGTYP.EQ.27) SHDFAC=0.0000
+                IF(SOILTYP.EQ.14.AND.XICE(I,J).EQ.0.)THEN
+#if 0
+               IF(IPRINT)PRINT*,' SOIL TYPE FOUND TO BE WATER AT A LAND-POINT'
+               IF(IPRINT)PRINT*,i,j,'RESET SOIL in surfce.F'
+#endif
+                  SOILTYP=7
+                ENDIF
+                SNOALB1 = SNOALB(I,J)
+! converts canwat in mm to CMC in meters
+                CMC=CANWAT(I,J)/1000.
+      
+      !-------------------------------------------
+      !*** convert snow depth from mm to meter
+      !
+      !          IF(RDMAXALB) THEN
+      !           SNOALB=ALBMAX(I,J)*0.01
+      !         ELSE
+      !           SNOALB=MAXALB(IVGTPK)*0.01
+      !         ENDIF
+      
+      !        SNOALB1=0.80
+      !        SHMIN=0.00
+              ALBBRD=ALBBCK(I,J)
+              Z0BRD=Z0(I,J)
+              EMBRD=EMBCK(I,J)
+              SNOTIME1 = SNOTIME(I,J)
+              RIBB=RIB(I,J)
+      !FEI: temporaray arrays above need to be changed later by using SI
+      
+                DO NS=1,NSOIL
+                  SMC(NS)=SMOIS(I,NS,J)
+                  STC(NS)=TSLB(I,NS,J)                                          !STEMP
+                  SWC(NS)=SH2O(I,NS,J)
+                ENDDO
+      !
+                if ( (SNEQV.ne.0..AND.SNOWHK.eq.0.).or.(SNOWHK.le.SNEQV) )THEN
+                  SNOWHK= 5.*SNEQV
+                endif
+      !
+      
+      !Fei: urban. for urban surface, if calling UCM, redefine the natural surface in cities as
+      ! the "NATURAL" category in the VEGPARM.TBL
+      	
+      	!   IF(SF_URBAN_PHYSICS == 1.OR. SF_URBAN_PHYSICS==2.OR.SF_URBAN_PHYSICS==3 ) THEN
+                       
+      
+           !           IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LOW_DENSITY_RESIDENTIAL .or. &
+           !            IVGTYP(I,J) == HIGH_DENSITY_RESIDENTIAL .or. IVGTYP(I,J) == HIGH_INTENSITY_INDUSTRIAL) THEN
+           !	 VEGTYP = NATURAL
+           !            SHDFAC = SHDTBL(NATURAL)
+           !            ALBEDOK =0.2         !  0.2
+           !            ALBBRD  =0.2         !0.2
+           !            EMISSI = 0.98                                 !for VEGTYP=5
+           !	 IF ( FRC_URB2D(I,J) < 0.99 ) THEN
+          !               if(sf_urban_physics.eq.1)then
+          !       T1= ( TSK(I,J) -FRC_URB2D(I,J) * TS_URB2D (I,J) )/ (1-FRC_URB2D(I,J))
+          !               elseif((sf_urban_physics.eq.2).OR.(sf_urban_physics.eq.3))then
+          !            r1= (tsk(i,j)**4.)
+          !            r2= frc_urb2d(i,j)*(ts_urb2d(i,j)**4.)
+          !            r3= (1.-frc_urb2d(i,j))
+         !             t1= ((r1-r2)/r3)**.25
+         !                endif
+         !	         ELSE
+         !		 T1 = TSK(I,J)
+         !              ENDIF
+         !             ENDIF
+          !       ELSE
+           !            IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LOW_DENSITY_RESIDENTIAL .or. &
+          !              IVGTYP(I,J) == HIGH_DENSITY_RESIDENTIAL .or. IVGTYP(I,J) == HIGH_INTENSITY_INDUSTRIAL) THEN
+           !             VEGTYP = ISURBAN
+           !      	 ENDIF
+           !      ENDIF
+      
+            Noah_call=.TRUE.
+      
+            If ( SF_URBAN_PHYSICS == 0 ) THEN   ! ONLY NOAH
+      
+                 IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LOW_DENSITY_RESIDENTIAL .or. &
+                       IVGTYP(I,J) == HIGH_DENSITY_RESIDENTIAL .or. IVGTYP(I,J) == HIGH_INTENSITY_INDUSTRIAL) THEN
+                       Noah_call = .TRUE.                 
+                       VEGTYP = ISURBAN
+                 ENDIF
+      
+            ENDIF
+            
+            IF(SF_URBAN_PHYSICS == 1) THEN
+      
+                 IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LOW_DENSITY_RESIDENTIAL .or. &
+                       IVGTYP(I,J) == HIGH_DENSITY_RESIDENTIAL .or. IVGTYP(I,J) == HIGH_INTENSITY_INDUSTRIAL) THEN   
+              	
+                       Noah_call = .TRUE.                       
+              	       VEGTYP = NATURAL                                              
+                       SHDFAC = SHDTBL(NATURAL)
+                       ALBEDOK =0.2         !  0.2
+                       ALBBRD  =0.2         !  0.2
+                       EMISSI = 0.98        !  for VEGTYP=5       
+                       
+      		      T1= TS_RUL2D_mosaic(I,mosaic_i,J)
+                       
+                 ENDIF
+      
+            ENDIF
+
+!===Yang, 2014/10/08, hydrological processes for urban vegetation in single layer UCM===
+           AOASIS = 1.0
+           USOIL = 1
+           DSOIL = 2
+           IRIOPTION=IRI_SCHEME
+           OMG= OMG_URB2D(I,J)   
+           tloc=mod(int(OMG/3.14159*180./15.+12.+0.5 ),24)
+           if (tloc.lt.0) tloc=tloc+24
+           if (tloc==0) tloc=24
+           CALL cal_mon_day(julian,julyr,jmonth,jday) 
+	  IF(SF_URBAN_PHYSICS == 1) THEN
+           IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LOW_DENSITY_RESIDENTIAL .or. &
+                IVGTYP(I,J) == HIGH_DENSITY_RESIDENTIAL .or. IVGTYP(I,J) == HIGH_INTENSITY_INDUSTRIAL) THEN
+            AOASIS = oasis  ! urban oasis effect
+                   IF (IRIOPTION ==1) THEN
+                   IF (tloc==21 .or. tloc==22) THEN  !irrigation on vegetaion in urban area, MAY-SEP, 9-10pm
+                   IF (jmonth==5 .or. jmonth==6 .or. jmonth==7 .or. jmonth==8 .or. jmonth==9) THEN
+                      IF (SMC(USOIL) .LT. SMCREF) SMC(USOIL)= REFSMC(ISLTYP(I,J))
+                      IF (SMC(DSOIL) .LT. SMCREF) SMC(DSOIL)= REFSMC(ISLTYP(I,J))
+                   ENDIF
+                   ENDIF
+                   ENDIF
+                ENDIF
+           ENDIF
+
+	  IF(SF_URBAN_PHYSICS == 2 .or. SF_URBAN_PHYSICS == 3) THEN
+          IF(AOASIS > 1.0) THEN
+          CALL wrf_error_fatal('Urban oasis option is for SF_URBAN_PHYSICS == 1 only')
+          ENDIF
+          IF(IRIOPTION == 1) THEN
+          CALL wrf_error_fatal('Urban irrigation option is for SF_URBAN_PHYSICS == 1 only')
+          ENDIF
+          ENDIF
+            
+            IF( SF_URBAN_PHYSICS==2.OR.SF_URBAN_PHYSICS==3 ) THEN
+!             print*, 'MOSAIC is not designed to work with SF_URBAN_PHYSICS=2 or SF_URBAN_PHYSICS=3'
+            ENDIF
+      
+         IF (Noah_call) THEN
+#if 0
+                IF(IPRINT) THEN
+      !
+             print*, 'BEFORE SFLX, in Noahlsm_driver'
+             print*, 'ICE', ICE, 'DT',DT, 'ZLVL',ZLVL, 'NSOIL', NSOIL,   &
+             'SLDPTH', SLDPTH, 'LOCAL',LOCAL, 'LUTYPE',&
+              LUTYPE, 'SLTYPE',SLTYPE, 'LWDN',LWDN, 'SOLDN',SOLDN,      &
+              'SFCPRS',SFCPRS, 'PRCP',PRCP,'SFCTMP',SFCTMP,'Q2K',Q2K,   &
+               'TH2',TH2,'Q2SAT',Q2SAT,'DQSDT2',DQSDT2,'VEGTYP', VEGTYP,&
+               'SOILTYP',SOILTYP, 'SLOPETYP',SLOPETYP, 'SHDFAC',SHDFAC,&
+               'SHMIN',SHMIN, 'ALBBRD',ALBBRD,'SNOALB1',SNOALB1,'TBOT',&
+                TBOT, 'Z0BRD',Z0BRD, 'Z0K',Z0K, 'CMC',CMC, 'T1',T1,'STC',&
+                STC, 'SMC',SMC, 'SWC',SWC,'SNOWHK',SNOWHK,'SNEQV',SNEQV,&
+                'ALBEDOK',ALBEDOK,'CHK',CHK,'ETA',ETA,'SHEAT',SHEAT,      &
+                'ETA_KINEMATIC',ETA_KINEMATIC, 'FDOWN',FDOWN,'EC',EC,   &
+                'EDIR',EDIR,'ET',ET,'ETT',ETT,'ESNOW',ESNOW,'DRIP',DRIP,&
+                'DEW',DEW,'BETA',BETA,'ETP',ETP,'SSOIL',SSOIL,'FLX1',FLX1,&
+                'FLX2',FLX2,'FLX3',FLX3,'SNOMLT',SNOMLT,'SNCOVR',SNCOVR,&
+                'RUNOFF1',RUNOFF1,'RUNOFF2',RUNOFF2,'RUNOFF3',RUNOFF3, &
+                'RC',RC, 'PC',PC,'RSMIN',RSMIN,'XLAI',XLAI,'RCS',RCS,  &
+                'RCT',RCT,'RCQ',RCQ,'RCSOIL',RCSOIL,'SOILW',SOILW,     &
+                'SOILM',SOILM,'Q1',Q1,'SMCWLT',SMCWLT,'SMCDRY',SMCDRY,&
+                'SMCREF',SMCREF,'SMCMAX',SMCMAX,'NROOT',NROOT
+                 endif
+#endif
+      
+                IF (rdlai2d) THEN
+                   IF (SHDFAC > 0.0 .AND. LAI(I,J) <= 0.0) LAI(I,J) = 0.01
+                   xlai = lai(i,j)
+                endif
+      
+          IF ( ICE == 1 ) THEN
+      
+             ! Sea-ice case
+      
+             DO NS = 1, NSOIL
+                SH2O(I,NS,J) = 1.0
+             ENDDO
+             LAI(I,J) = 0.01
+      
+             CYCLE ILOOP
+      
+          ELSEIF (ICE == 0) THEN
+      
+             ! Non-glacial land
+      
+             CALL SFLX (I,J,FFROZP, ISURBAN, DT,ZLVL,NSOIL,SLDPTH,       &    !C
+                       LOCAL,                                            &    !L
+                       LUTYPE, SLTYPE,                                   &    !CL
+                       LWDN,SOLDN,SOLNET,SFCPRS,PRCP,SFCTMP,Q2K,DUMMY,   &    !F
+                       DUMMY,DUMMY, DUMMY,                               &    !F PRCPRAIN not used
+                       TH2,Q2SAT,DQSDT2,                                 &    !I
+                       VEGTYP,SOILTYP,SLOPETYP,SHDFAC,SHMIN,SHMAX,       &    !I
+                       ALBBRD, SNOALB1,TBOT, Z0BRD, Z0K, EMISSI, EMBRD,  &    !S
+                       CMC,T1,STC,SMC,SWC,SNOWHK,SNEQV,ALBEDOK,CHK,dummy,&    !H
+                       ETA,SHEAT, ETA_KINEMATIC,FDOWN,                   &    !O
+                       EC,EDIR,ET,ETT,ESNOW,DRIP,DEW,                    &    !O
+                       BETA,ETP,SSOIL,                                   &    !O
+                       FLX1,FLX2,FLX3,                                   &    !O
+      		 FLX4,FVB,FBUR,FGSN,UA_PHYS,                             &    !UA 
+                       SNOMLT,SNCOVR,                                    &    !O
+                       RUNOFF1,RUNOFF2,RUNOFF3,                          &    !O
+                       RC,PC,RSMIN,XLAI,RCS,RCT,RCQ,RCSOIL,              &    !O
+                       SOILW,SOILM,Q1,SMAV,                              &    !D
+                       RDLAI2D,USEMONALB,                                &
+                       SNOTIME1,                                         &
+                       RIBB,                                             &
+                       SMCWLT,SMCDRY,SMCREF,SMCMAX,NROOT,                &
+                       sfcheadrt(i,j),                                   &    !I
+                       INFXSRT(i,j),ETPND1,OPT_THCND,AOASIS              &    !O
+                ,XSDA_QFX, HFX_PHY, QFX_PHY, XQNORM, fasdas, HCPCT_FASDAS    & ! fasdas vars
+                       )
+      
+#ifdef WRF_HYDRO
+                       soldrain(i,j) = RUNOFF2*DT*1000.0
+#endif
+          ELSEIF (ICE == -1) THEN
+      
+             !
+             ! Set values that the LSM is expected to update,
+             ! but don't get updated for glacial points.
+             !
+             SOILM = 0.0 !BSINGH(PNNL)- SOILM is undefined for this case, it is used for diagnostics so setting it to zero
+             XLAI = 0.01 ! KWM Should this be Zero over land ice?  Does this value matter?
+             RUNOFF2 = 0.0
+             RUNOFF3 = 0.0
+             DO NS = 1, NSOIL
+                SWC(NS) = 1.0
+                SMC(NS) = 1.0
+                SMAV(NS) = 1.0
+             ENDDO
+             CALL SFLX_GLACIAL(I,J,ISICE,FFROZP,DT,ZLVL,NSOIL,SLDPTH,   &    !C
+                  &    LWDN,SOLNET,SFCPRS,PRCP,SFCTMP,Q2K,              &    !F
+                  &    TH2,Q2SAT,DQSDT2,                                &    !I
+                  &    ALBBRD, SNOALB1,TBOT, Z0BRD, Z0K, EMISSI, EMBRD, &    !S
+                  &    T1,STC(1:NSOIL),SNOWHK,SNEQV,ALBEDOK,CHK,        &    !H
+                  &    ETA,SHEAT,ETA_KINEMATIC,FDOWN,                   &    !O
+                  &    ESNOW,DEW,                                       &    !O
+                  &    ETP,SSOIL,                                       &    !O
+                  &    FLX1,FLX2,FLX3,                                  &    !O
+                  &    SNOMLT,SNCOVR,                                   &    !O
+                  &    RUNOFF1,                                         &    !O
+                  &    Q1,                                              &    !D
+                  &    SNOTIME1,                                        &
+                  &    RIBB)
+      
+          ENDIF
+             lai(i,j) = xlai
+#if 0
+                IF(IPRINT) THEN
+      
+             print*, 'AFTER SFLX, in Noahlsm_driver'
+             print*, 'ICE', ICE, 'DT',DT, 'ZLVL',ZLVL, 'NSOIL', NSOIL,   &
+             'SLDPTH', SLDPTH, 'LOCAL',LOCAL, 'LUTYPE',&
+              LUTYPE, 'SLTYPE',SLTYPE, 'LWDN',LWDN, 'SOLDN',SOLDN,      &
+              'SFCPRS',SFCPRS, 'PRCP',PRCP,'SFCTMP',SFCTMP,'Q2K',Q2K,   &
+               'TH2',TH2,'Q2SAT',Q2SAT,'DQSDT2',DQSDT2,'VEGTYP', VEGTYP,&
+                'SOILTYP',SOILTYP, 'SLOPETYP',SLOPETYP, 'SHDFAC',SHDFAC,&
+               'SHDMIN',SHMIN, 'ALBBRD',ALBBRD,'SNOALB',SNOALB1,'TBOT',&
+                TBOT, 'Z0BRD',Z0BRD, 'Z0K',Z0K, 'CMC',CMC, 'T1',T1,'STC',&
+                STC, 'SMC',SMC, 'SWc',SWC,'SNOWHK',SNOWHK,'SNEQV',SNEQV,&
+                'ALBEDOK',ALBEDOK,'CHK',CHK,'ETA',ETA,'SHEAT',SHEAT,      &
+                'ETA_KINEMATIC',ETA_KINEMATIC, 'FDOWN',FDOWN,'EC',EC,   &
+                'EDIR',EDIR,'ET',ET,'ETT',ETT,'ESNOW',ESNOW,'DRIP',DRIP,&
+                'DEW',DEW,'BETA',BETA,'ETP',ETP,'SSOIL',SSOIL,'FLX1',FLX1,&
+                'FLX2',FLX2,'FLX3',FLX3,'SNOMLT',SNOMLT,'SNCOVR',SNCOVR,&
+                'RUNOFF1',RUNOFF1,'RUNOFF2',RUNOFF2,'RUNOFF3',RUNOFF3, &
+                'RC',RC, 'PC',PC,'RSMIN',RSMIN,'XLAI',XLAI,'RCS',RCS,  &
+                'RCT',RCT,'RCQ',RCQ,'RCSOIL',RCSOIL,'SOILW',SOILW,     &
+                'SOILM',SOILM,'Q1',Q1,'SMCWLT',SMCWLT,'SMCDRY',SMCDRY,&
+                'SMCREF',SMCREF,'SMCMAX',SMCMAX,'NROOT',NROOT
+                 endif
+#endif
+      
+      !***  UPDATE STATE VARIABLES
+                CANWAT(I,J)=CMC*1000.
+                SNOW(I,J)=SNEQV*1000.
+      !          SNOWH(I,J)=SNOWHK*1000.
+                SNOWH(I,J)=SNOWHK                   ! SNOWHK in meters
+                ALBEDO(I,J)=ALBEDOK
+                ALB_RURAL(I,J)=ALBEDOK
+                ALBBCK(I,J)=ALBBRD
+                Z0(I,J)=Z0BRD
+                EMISS(I,J) = EMISSI
+                EMISS_RURAL(I,J) = EMISSI
+      ! Noah: activate time-varying roughness length (V3.3 Feb 2011)
+                ZNT(I,J)=Z0K
+                TSK(I,J)=T1
+                TSK_RURAL(I,J)=T1
+                HFX(I,J)=SHEAT
+                HFX_RURAL(I,J)=SHEAT
+      ! MEk Jul07 add potential evap accum
+              POTEVP(I,J)=POTEVP(I,J)+ETP*FDTW
+                QFX(I,J)=ETA_KINEMATIC
+                QFX_RURAL(I,J)=ETA_KINEMATIC
+      
+#ifdef WRF_HYDRO
+      !added by Wei Yu
+      !         QFX(I,J) = QFX(I,J) + ETPND1
+      !         ETA = ETA + ETPND1/2.501E6*dt
+      !end added by Wei Yu
+#endif
+      
+                LH(I,J)=ETA
+                LH_RURAL(I,J)=ETA
+                GRDFLX(I,J)=SSOIL
+                GRDFLX_RURAL(I,J)=SSOIL
+                SNOWC(I,J)=SNCOVR
+                CHS2(I,J)=CQS2(I,J)
+                SNOTIME(I,J) = SNOTIME1
+      !      prevent diagnostic ground q (q1) from being greater than qsat(tsk)
+      !      as happens over snow cover where the cqs2 value also becomes irrelevant
+      !      by setting cqs2=chs in this situation the 2m q should become just qv(k=1)
+                IF (Q1 .GT. QSFC(I,J)) THEN
+                  CQS2(I,J) = CHS(I,J)
+                ENDIF
+      !          QSFC(I,J)=Q1
+      ! Convert QSFC back to mixing ratio
+                 QSFC(I,J)= Q1/(1.0-Q1)
+      !
+                 ! QSFC_RURAL(I,J)= Q1/(1.0-Q1)
+      ! Calculate momentum flux from rural surface for use with multi-layer UCM (Martilli et al. 2002)
+      
+                DO 81 NS=1,NSOIL
+                 SMOIS(I,NS,J)=SMC(NS)
+                 TSLB(I,NS,J)=STC(NS)                                        !  STEMP
+                 SH2O(I,NS,J)=SWC(NS)
+         81     CONTINUE
+      !       ENDIF
+      
+              FLX4_2D(I,J)  = FLX4
+      	FVB_2D(I,J)   = FVB
+      	FBUR_2D(I,J)  = FBUR
+      	FGSN_2D(I,J)  = FGSN
+      
+           !
+           ! Residual of surface energy balance equation terms
+           !
+      
+           IF ( UA_PHYS ) THEN
+               noahres(i,j) = ( solnet + lwdn ) - sheat + ssoil - eta &
+                    - ( emissi * STBOLT * (t1**4) ) - flx1 - flx2 - flx3 - flx4
+      
+           ELSE
+               noahres(i,j) = ( solnet + lwdn ) - sheat + ssoil - eta &
+                    - ( emissi * STBOLT * (t1**4) ) - flx1 - flx2 - flx3
+           ENDIF
+      
+               ENDIF   !ENDIF FOR Noah_call
+               
+              IF (SF_URBAN_PHYSICS == 1 ) THEN                                              ! Beginning of UCM CALL if block
+      !--------------------------------------
+      ! URBAN CANOPY MODEL START - urban
+      !--------------------------------------
+      ! Input variables lsm --> urban
+      
+                IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LOW_DENSITY_RESIDENTIAL .or. &
+                    IVGTYP(I,J) == HIGH_DENSITY_RESIDENTIAL .or. IVGTYP(I,J) == HIGH_INTENSITY_INDUSTRIAL ) THEN            
+      
+                !  UTYPE_URB = UTYPE_URB2D(I,J) !urban type (low, high or industrial)
+                !  this need to be changed in the mosaic danli
+      
+                IF(IVGTYP(I,J)==ISURBAN) UTYPE_URB=2
+                IF(IVGTYP(I,J)==LOW_DENSITY_RESIDENTIAL) UTYPE_URB=1
+                IF(IVGTYP(I,J)==HIGH_DENSITY_RESIDENTIAL) UTYPE_URB=2
+                IF(IVGTYP(I,J)==HIGH_INTENSITY_INDUSTRIAL) UTYPE_URB=3
+                        
+                IF(UTYPE_URB==1) FRC_URB2D(I,J)=0.5
+                IF(UTYPE_URB==2) FRC_URB2D(I,J)=0.9
+                IF(UTYPE_URB==3) FRC_URB2D(I,J)=0.95
+      
+                  TA_URB    = SFCTMP           ! [K]
+                  QA_URB    = Q2K              ! [kg/kg]
+                  UA_URB    = SQRT(U_PHY(I,1,J)**2.+V_PHY(I,1,J)**2.)
+                  U1_URB    = U_PHY(I,1,J)
+                  V1_URB    = V_PHY(I,1,J)
+                  IF(UA_URB < 1.) UA_URB=1.    ! [m/s]
+                  SSG_URB   = SOLDN            ! [W/m/m]
+                  SSGD_URB  = 0.8*SOLDN        ! [W/m/m]
+                  SSGQ_URB  = SSG_URB-SSGD_URB ! [W/m/m]
+                  LLG_URB   = GLW(I,J)         ! [W/m/m]
+                  RAIN_URB  = RAINBL(I,J)      ! [mm]
+                  RHOO_URB  = SFCPRS / (287.04 * SFCTMP * (1.0+ 0.61 * Q2K)) ![kg/m/m/m]
+                  ZA_URB    = ZLVL             ! [m]
+                  DELT_URB  = DT               ! [sec]
+                  XLAT_URB  = XLAT_URB2D(I,J)  ! [deg]
+                  COSZ_URB  = COSZ_URB2D(I,J)  !
+                  OMG_URB   = OMG_URB2D(I,J)   !
+                  ZNT_URB   = ZNT(I,J)
+      
+                  LSOLAR_URB = .FALSE.
+                  
+      ! mosaic 3D to 2D
+      
+         TR_URB2D(I,J)=TR_URB2D_mosaic(I,mosaic_i,J)                         ! replace it with the mosaic one          
+         TB_URB2D(I,J)=TB_URB2D_mosaic(I,mosaic_i,J)                         ! replace it with the mosaic one          
+         TG_URB2D(I,J)=TG_URB2D_mosaic(I,mosaic_i,J)                         ! replace it with the mosaic one          
+         TC_URB2D(I,J)=TC_URB2D_mosaic(I,mosaic_i,J)                         ! replace it with the mosaic one          
+         QC_URB2D(I,J)=QC_URB2D_mosaic(I,mosaic_i,J)                         ! replace it with the mosaic one          
+         UC_URB2D(I,J)=UC_URB2D_mosaic(I,mosaic_i,J)                         ! replace it with the mosaic one          
+         TS_URB2D(I,J)=TS_URB2D_mosaic(I,mosaic_i,J)                         ! replace it with the mosaic one          
+      
+                  DO K = 1,num_roof_layers
+                    TRL_URB3D(I,K,J) = TRL_URB3D_mosaic(I,K+(mosaic_i-1)*num_roof_layers,J)
+                  END DO
+                  DO K = 1,num_wall_layers
+                    TBL_URB3D(I,K,J) = TBL_URB3D_mosaic(I,K+(mosaic_i-1)*num_roof_layers,J)
+                  END DO
+                  DO K = 1,num_road_layers
+                    TGL_URB3D(I,K,J) = TGL_URB3D_mosaic(I,K+(mosaic_i-1)*num_roof_layers,J)
+                  END DO
+      
+      ! mosaic 2D to 1D            
+      
+                  TR_URB = TR_URB2D(I,J)
+                  TB_URB = TB_URB2D(I,J)
+                  TG_URB = TG_URB2D(I,J)
+                  TC_URB = TC_URB2D(I,J)
+                  QC_URB = QC_URB2D(I,J)
+                  UC_URB = UC_URB2D(I,J)
+      
+                  DO K = 1,num_roof_layers
+                    TRL_URB(K) = TRL_URB3D(I,K,J)
+                    SMR_URB(K) = SMR_URB3D(I,K,J)
+                    TGRL_URB(K)= TGRL_URB3D(I,K,J)
+                  END DO
+                  DO K = 1,num_wall_layers
+                    TBL_URB(K) = TBL_URB3D(I,K,J)
+                  END DO
+                  DO K = 1,num_road_layers
+                    TGL_URB(K) = TGL_URB3D(I,K,J)
+                  END DO
+                  
+                  TGR_URB   = TGR_URB2D(I,J)
+                  CMCR_URB  = CMCR_URB2D(I,J)
+                  FLXHUMR_URB = FLXHUMR_URB2D(I,J)
+                  FLXHUMB_URB = FLXHUMB_URB2D(I,J)
+                  FLXHUMG_URB = FLXHUMG_URB2D(I,J)
+                  DRELR_URB = DRELR_URB2D(I,J)
+                  DRELB_URB = DRELB_URB2D(I,J)
+                  DRELG_URB = DRELG_URB2D(I,J)
+      
+                  XXXR_URB = XXXR_URB2D(I,J)
+                  XXXB_URB = XXXB_URB2D(I,J)
+                  XXXG_URB = XXXG_URB2D(I,J)
+                  XXXC_URB = XXXC_URB2D(I,J)
+      !
+      !      Limits to avoid dividing by small number
+                  if (CHS(I,J) < 1.0E-02) then
+                     CHS(I,J)  = 1.0E-02
+                  endif
+                  if (CHS2(I,J) < 1.0E-02) then
+                     CHS2(I,J)  = 1.0E-02
+                  endif
+                  if (CQS2(I,J) < 1.0E-02) then
+                     CQS2(I,J)  = 1.0E-02
+                  endif
+      !
+                  CHS_URB  = CHS(I,J)
+                  CHS2_URB = CHS2(I,J)
+                  IF (PRESENT(CMR_SFCDIF)) THEN
+                     CMR_URB = CMR_SFCDIF(I,J)
+                     CHR_URB = CHR_SFCDIF(I,J)
+                     CMGR_URB = CMGR_SFCDIF(I,J)
+                     CHGR_URB = CHGR_SFCDIF(I,J)
+                     CMC_URB = CMC_SFCDIF(I,J)
+                     CHC_URB = CHC_SFCDIF(I,J)
+                  ENDIF
+      
+      ! NUDAPT for SLUCM
+                  mh_urb = mh_urb2d(I,J)
+                  stdh_urb = stdh_urb2d(I,J)
+                  lp_urb = lp_urb2d(I,J)
+                  hgt_urb = hgt_urb2d(I,J)
+                  lf_urb = 0.0
+                  DO K = 1,4
+                    lf_urb(K)=lf_urb2d(I,K,J)
+                  ENDDO
+                  frc_urb = frc_urb2d(I,J)
+                  lb_urb = lb_urb2d(I,J)
+                  check = 0
+                  if (I.eq.73.and.J.eq.125)THEN
+                     check = 1
+                  end if
+      !
+      ! Call urban
+                  CALL cal_mon_day(julian,julyr,jmonth,jday)      
+                  CALL urban(LSOLAR_URB,                                      & ! I
+                             num_roof_layers,num_wall_layers,num_road_layers, & ! C
+                             DZR,DZB,DZG,                                     & ! C
+                             UTYPE_URB,TA_URB,QA_URB,UA_URB,U1_URB,V1_URB,SSG_URB, & ! I
+                             SSGD_URB,SSGQ_URB,LLG_URB,RAIN_URB,RHOO_URB,     & ! I
+                             ZA_URB,DECLIN_URB,COSZ_URB,OMG_URB,              & ! I
+                             XLAT_URB,DELT_URB,ZNT_URB,                       & ! I
+                             CHS_URB, CHS2_URB,                               & ! I
+                             TR_URB, TB_URB, TG_URB, TC_URB, QC_URB,UC_URB,   & ! H
+                             TRL_URB,TBL_URB,TGL_URB,                         & ! H
+                             XXXR_URB, XXXB_URB, XXXG_URB, XXXC_URB,          & ! H
+                             TS_URB,QS_URB,SH_URB,LH_URB,LH_KINEMATIC_URB,    & ! O
+                             SW_URB,ALB_URB,LW_URB,G_URB,RN_URB,PSIM_URB,PSIH_URB, & ! O
+                             GZ1OZ0_URB,                                      & !O
+                             CMR_URB, CHR_URB, CMC_URB, CHC_URB,              &
+                             U10_URB, V10_URB, TH2_URB, Q2_URB,               & ! O
+                             UST_URB,mh_urb, stdh_urb, lf_urb, lp_urb,        & ! 0
+                             hgt_urb,frc_urb,lb_urb, check,CMCR_URB,TGR_URB,  & ! H
+                             TGRL_URB,SMR_URB,CMGR_URB,CHGR_URB,jmonth,       & ! H
+                             DRELR_URB,DRELB_URB,                             & ! H
+                             DRELG_URB,FLXHUMR_URB,FLXHUMB_URB,FLXHUMG_URB)     
+      
+#if 0
+                IF(IPRINT) THEN
+      
+             print*, 'AFTER CALL URBAN'
+             print*,'num_roof_layers',num_roof_layers, 'num_wall_layers',  &
+              num_wall_layers,                                             &
+             'DZR',DZR,'DZB',DZB,'DZG',DZG,'UTYPE_URB',UTYPE_URB,'TA_URB', &
+              TA_URB,                                                      &
+              'QA_URB',QA_URB,'UA_URB',UA_URB,'U1_URB',U1_URB,'V1_URB',    &
+               V1_URB,                                                     &
+               'SSG_URB',SSG_URB,'SSGD_URB',SSGD_URB,'SSGQ_URB',SSGQ_URB,  &
+              'LLG_URB',LLG_URB,'RAIN_URB',RAIN_URB,'RHOO_URB',RHOO_URB,   &
+              'ZA_URB',ZA_URB, 'DECLIN_URB',DECLIN_URB,'COSZ_URB',COSZ_URB,&
+              'OMG_URB',OMG_URB,'XLAT_URB',XLAT_URB,'DELT_URB',DELT_URB,   &
+               'ZNT_URB',ZNT_URB,'TR_URB',TR_URB, 'TB_URB',TB_URB,'TG_URB',&
+               TG_URB,'TC_URB',TC_URB,'QC_URB',QC_URB,'TRL_URB',TRL_URB,   &
+                'TBL_URB',TBL_URB,'TGL_URB',TGL_URB,'XXXR_URB',XXXR_URB,   &
+               'XXXB_URB',XXXB_URB,'XXXG_URB',XXXG_URB,'XXXC_URB',XXXC_URB,&
+               'TS_URB',TS_URB,'QS_URB',QS_URB,'SH_URB',SH_URB,'LH_URB',   &
+               LH_URB, 'LH_KINEMATIC_URB',LH_KINEMATIC_URB,'SW_URB',SW_URB,&
+               'ALB_URB',ALB_URB,'LW_URB',LW_URB,'G_URB',G_URB,'RN_URB',   &
+                RN_URB, 'PSIM_URB',PSIM_URB,'PSIH_URB',PSIH_URB,          &
+               'U10_URB',U10_URB,'V10_URB',V10_URB,'TH2_URB',TH2_URB,      &
+                'Q2_URB',Q2_URB,'CHS_URB',CHS_URB,'CHS2_URB',CHS2_URB
+                 endif
+#endif
+      
+                  TS_URB2D(I,J) = TS_URB
+      
+                  ALBEDO(I,J) = FRC_URB2D(I,J)*ALB_URB+(1-FRC_URB2D(I,J))*ALBEDOK   ![-]
+                  HFX(I,J) = FRC_URB2D(I,J)*SH_URB+(1-FRC_URB2D(I,J))*SHEAT         ![W/m/m]
+                  QFX(I,J) = FRC_URB2D(I,J)*LH_KINEMATIC_URB &
+                           + (1-FRC_URB2D(I,J))*ETA_KINEMATIC                ![kg/m/m/s]
+                  LH(I,J) = FRC_URB2D(I,J)*LH_URB+(1-FRC_URB2D(I,J))*ETA            ![W/m/m]
+                  GRDFLX(I,J) = FRC_URB2D(I,J)*G_URB+(1-FRC_URB2D(I,J))*SSOIL       ![W/m/m]
+                  TSK(I,J) = FRC_URB2D(I,J)*TS_URB+(1-FRC_URB2D(I,J))*T1            ![K]
+                  Q1 = FRC_URB2D(I,J)*QS_URB+(1-FRC_URB2D(I,J))*Q1            ![-]
+      ! Convert QSFC back to mixing ratio
+                  QSFC(I,J)= Q1/(1.0-Q1)
+                  UST(I,J)= FRC_URB2D(I,J)*UST_URB+(1-FRC_URB2D(I,J))*UST(I,J)      ![m/s]
+                  ZNT(I,J)= EXP(FRC_URB2D(I,J)*ALOG(ZNT_URB)+(1-FRC_URB2D(I,J))* ALOG(ZNT(I,J)))   ! ADD BY DAN
+
+#if 0
+          IF(IPRINT)THEN
+      
+          print*, ' FRC_URB2D', FRC_URB2D,                        &
+          'ALB_URB',ALB_URB, 'ALBEDOK',ALBEDOK, &
+          'ALBEDO(I,J)',  ALBEDO(I,J),                  &
+          'SH_URB',SH_URB,'SHEAT',SHEAT, 'HFX(I,J)',HFX(I,J),  &
+          'LH_KINEMATIC_URB',LH_KINEMATIC_URB,'ETA_KINEMATIC',  &
+           ETA_KINEMATIC, 'QFX(I,J)',QFX(I,J),                  &
+          'LH_URB',LH_URB, 'ETA',ETA, 'LH(I,J)',LH(I,J),        &
+          'G_URB',G_URB,'SSOIL',SSOIL,'GRDFLX(I,J)', GRDFLX(I,J),&
+          'TS_URB',TS_URB,'T1',T1,'TSK(I,J)',TSK(I,J),          &
+          'QS_URB',QS_URB,'Q1',Q1,'QSFC(I,J)',QSFC(I,J)
+           endif
+#endif
+      
+      ! Renew Urban State Varialbes
+      
+                  TR_URB2D(I,J) = TR_URB
+                  TB_URB2D(I,J) = TB_URB
+                  TG_URB2D(I,J) = TG_URB
+                  TC_URB2D(I,J) = TC_URB
+                  QC_URB2D(I,J) = QC_URB
+                  UC_URB2D(I,J) = UC_URB
+      
+                  DO K = 1,num_roof_layers
+                    TRL_URB3D(I,K,J) = TRL_URB(K)
+                    SMR_URB3D(I,K,J) = SMR_URB(K)
+                    TGRL_URB3D(I,K,J)= TGRL_URB(K)
+                  END DO
+                  DO K = 1,num_wall_layers
+                    TBL_URB3D(I,K,J) = TBL_URB(K)
+                  END DO
+                  DO K = 1,num_road_layers
+                    TGL_URB3D(I,K,J) = TGL_URB(K)
+                  END DO
+
+                  TGR_URB2D(I,J) =TGR_URB 
+                  CMCR_URB2D(I,J)=CMCR_URB
+            	    FLXHUMR_URB2D(I,J)=FLXHUMR_URB 
+                  FLXHUMB_URB2D(I,J)=FLXHUMB_URB
+                  FLXHUMG_URB2D(I,J)=FLXHUMG_URB
+                  DRELR_URB2D(I,J) = DRELR_URB 
+                  DRELB_URB2D(I,J) = DRELB_URB 
+                  DRELG_URB2D(I,J) = DRELG_URB
+           
+                  XXXR_URB2D(I,J) = XXXR_URB
+                  XXXB_URB2D(I,J) = XXXB_URB
+                  XXXG_URB2D(I,J) = XXXG_URB
+                  XXXC_URB2D(I,J) = XXXC_URB
+      
+                  SH_URB2D(I,J)    = SH_URB
+                  LH_URB2D(I,J)    = LH_URB
+                  G_URB2D(I,J)     = G_URB
+                  RN_URB2D(I,J)    = RN_URB
+                  PSIM_URB2D(I,J)  = PSIM_URB
+                  PSIH_URB2D(I,J)  = PSIH_URB
+                  GZ1OZ0_URB2D(I,J)= GZ1OZ0_URB
+                  U10_URB2D(I,J)   = U10_URB
+                  V10_URB2D(I,J)   = V10_URB
+                  TH2_URB2D(I,J)   = TH2_URB
+                  Q2_URB2D(I,J)    = Q2_URB
+                  UST_URB2D(I,J)   = UST_URB
+                  AKMS_URB2D(I,J)  = KARMAN * UST_URB2D(I,J)/(GZ1OZ0_URB2D(I,J)-PSIM_URB2D(I,J))
+                  IF (PRESENT(CMR_SFCDIF)) THEN
+                     CMR_SFCDIF(I,J) = CMR_URB
+                     CHR_SFCDIF(I,J) = CHR_URB
+                     CMGR_SFCDIF(I,J) = CMGR_URB
+                     CHGR_SFCDIF(I,J) = CHGR_URB
+                     CMC_SFCDIF(I,J) = CMC_URB
+                     CHC_SFCDIF(I,J) = CHC_URB
+                  ENDIF
+                  
+                     ! 2D to 3D  mosaic danli
+      	    	              
+      	    	                       TR_URB2D_mosaic(I,mosaic_i,J)=TR_URB2D(I,J)                               
+      	    	    	               TB_URB2D_mosaic(I,mosaic_i,J)=TB_URB2D(I,J)                                   
+      	    	    	               TG_URB2D_mosaic(I,mosaic_i,J)=TG_URB2D(I,J)                                   
+      	    	    	               TC_URB2D_mosaic(I,mosaic_i,J)=TC_URB2D(I,J)                                  
+      	    	    	               QC_URB2D_mosaic(I,mosaic_i,J)=QC_URB2D(I,J)                                   
+      	    	    	               UC_URB2D_mosaic(I,mosaic_i,J)=UC_URB2D(I,J)                                   
+      	    	    	               TS_URB2D_mosaic(I,mosaic_i,J)=TS_URB2D(I,J)                                   
+      	    	    	               TS_RUL2D_mosaic(I,mosaic_i,J)=T1                                
+      	    	    	  	  
+      	    	    	  	              DO K = 1,num_roof_layers
+      	    	    	  	                TRL_URB3D_mosaic(I,K+(mosaic_i-1)*num_roof_layers,J)=TRL_URB3D(I,K,J) 
+      	    	    	  	              END DO
+      	    	    	  	              DO K = 1,num_wall_layers
+      	    	    	  	                TBL_URB3D_mosaic(I,K+(mosaic_i-1)*num_roof_layers,J)=TBL_URB3D(I,K,J) 
+      	    	    	  	              END DO
+      	    	    	  	              DO K = 1,num_road_layers
+      	    	    	  	                TGL_URB3D_mosaic(I,K+(mosaic_i-1)*num_roof_layers,J)=TGL_URB3D(I,K,J) 
+      	    	    	                        END DO
+      	    	    	            
+      	    	    	              SH_URB2D_mosaic(I,mosaic_i,J) = SH_URB2D(I,J)
+      	    	    	  	      LH_URB2D_mosaic(I,mosaic_i,J) = LH_URB2D(I,J)
+      	    	    	              G_URB2D_mosaic(I,mosaic_i,J)  = G_URB2D(I,J)
+                                    RN_URB2D_mosaic(I,mosaic_i,J) = RN_URB2D(I,J)
+                                    
+                END IF
+      
+               ENDIF                                   ! end of UCM CALL if block
+      !--------------------------------------
+      ! Urban Part End - urban
+      !--------------------------------------
+      
+      !***  DIAGNOSTICS
+                SMSTAV(I,J)=SOILW
+                SMSTOT(I,J)=SOILM*1000.
+                DO NS=1,NSOIL
+                SMCREL(I,NS,J)=SMAV(NS)
+                ENDDO
+      
+      !         Convert the water unit into mm
+                SFCRUNOFF(I,J)=SFCRUNOFF(I,J)+RUNOFF1*DT*1000.0
+                UDRUNOFF(I,J)=UDRUNOFF(I,J)+RUNOFF2*DT*1000.0
+      ! snow defined when fraction of frozen precip (FFROZP) > 0.5,
+                IF(FFROZP.GT.0.5)THEN
+                  ACSNOW(I,J)=ACSNOW(I,J)+PRCP*DT
+                ENDIF
+                IF(SNOW(I,J).GT.0.)THEN
+                  ACSNOM(I,J)=ACSNOM(I,J)+SNOMLT*1000.
+      ! accumulated snow-melt energy
+                  SNOPCX(I,J)=SNOPCX(I,J)-SNOMLT/FDTLIW
+                ENDIF
+      
+              ENDIF                                                           ! endif of land-sea test
+      
+      !-----------------------------------------------------------------------
+      ! Done with the Noah-UCM MOSAIC  DANLI
+      !-----------------------------------------------------------------------
+      
+                  TSK_mosaic(i,mosaic_i,j)=TSK(i,j)                           ! from 2D to 3D
+                  QSFC_mosaic(i,mosaic_i,j)=QSFC(i,j)
+                  CANWAT_mosaic(i,mosaic_i,j)=CANWAT(i,j) 
+                  SNOW_mosaic(i,mosaic_i,j)=SNOW(i,j) 
+                  SNOWH_mosaic(i,mosaic_i,j)=SNOWH(i,j)  
+                  SNOWC_mosaic(i,mosaic_i,j)=SNOWC(i,j) 
+      
+                  ALBEDO_mosaic(i,mosaic_i,j)=ALBEDO(i,j) 
+                  ALBBCK_mosaic(i,mosaic_i,j)=ALBBCK(i,j)  
+                  EMISS_mosaic(i,mosaic_i,j)=EMISS(i,j) 
+                  EMBCK_mosaic(i,mosaic_i,j)=EMBCK(i,j)  
+                  ZNT_mosaic(i,mosaic_i,j)=ZNT(i,j)  
+                  Z0_mosaic(i,mosaic_i,j)=Z0(i,j)    
+                  LAI_mosaic(i,mosaic_i,j)=XLAI
+                  RC_mosaic(i,mosaic_i,j)=RC
+                                                                                       
+                  HFX_mosaic(i,mosaic_i,j)=HFX(i,j) 
+                  QFX_mosaic(i,mosaic_i,j)=QFX(i,j)  
+                  LH_mosaic(i,mosaic_i,j)=LH(i,j)  
+                  GRDFLX_mosaic(i,mosaic_i,j)=GRDFLX(i,j) 
+                  SNOTIME_mosaic(i,mosaic_i,j)=SNOTIME(i,j) 
+       
+                  DO NS=1,NSOIL
+        
+                  TSLB_mosaic(i,NSOIL*(mosaic_i-1)+NS,j)=TSLB(i,NS,j)
+                  SMOIS_mosaic(i,NSOIL*(mosaic_i-1)+NS,j)=SMOIS(i,NS,j)
+                  SH2O_mosaic(i,NSOIL*(mosaic_i-1)+NS,j)=SH2O(i,NS,j)  
+      
+                  ENDDO
+                  
+#if 0
+            IF(TSK_mosaic(i,mosaic_i,j) > 350 .OR. TSK_mosaic(i,mosaic_i,j) < 250 .OR. abs(HFX_mosaic(i,mosaic_i,j)) > 700 ) THEN
+                  print*, 'I', I, 'J', J, 'MOSAIC_I', MOSAIC_I
+                  print*, 'mosaic_cat_index',mosaic_cat_index(I,mosaic_i,J), 'landusef2',landusef2(i,mosaic_i,j)
+                  print*, 'TSK_mosaic', TSK_mosaic(i,mosaic_i,j), 'HFX_mosaic', HFX_mosaic(i,mosaic_i,j), &
+                          'LH_mosaic',LH_mosaic(i,mosaic_i,j),'GRDFLX_mosaic',GRDFLX_mosaic(i,mosaic_i,j)
+                  print*, 'ZNT_mosaic', ZNT_mosaic(i, mosaic_i,j), 'Z0_mosaic', Z0_mosaic(i,mosaic_i,j)
+                  print*, 'LAI_mosaic', LAI_mosaic(i, mosaic_i,j)
+                  print*, 'FRC_URB2D',FRC_URB2D(I,J)
+                  print*, 'TS_URB',TS_URB2D(I,J),'T1',T1
+                  print*, 'SH_URB2D',SH_URB2D(I,J),'SHEAT',SHEAT
+                  print*, 'LH_URB',LH_URB2D(I,J),'ETA',ETA
+                  print*, 'TS_RUL2D',TS_RUL2D_mosaic(I,mosaic_i,J)
+                  
+            ENDIF
+#endif
+                  
+      !-----------------------------------------------------------------------
+      ! Now let's do the grid-averaging
+      !-----------------------------------------------------------------------
+      
+                  FAREA  = landusef2(i,mosaic_i,j)
+      
+                  TSK_mosaic_avg(i,j) = TSK_mosaic_avg(i,j) + (EMISS_mosaic(i,mosaic_i,j)*TSK_mosaic(i,mosaic_i,j)**4)*FAREA    ! conserve the longwave radiation
+                  
+                  QSFC_mosaic_avg(i,j) = QSFC_mosaic_avg(i,j) + QSFC_mosaic(i,mosaic_i,j)*FAREA
+                  CANWAT_mosaic_avg(i,j) = CANWAT_mosaic_avg(i,j) + CANWAT_mosaic(i,mosaic_i,j)*FAREA
+                  SNOW_mosaic_avg(i,j) = SNOW_mosaic_avg(i,j) + SNOW_mosaic(i,mosaic_i,j)*FAREA
+                  SNOWH_mosaic_avg(i,j) = SNOWH_mosaic_avg(i,j) + SNOWH_mosaic(i,mosaic_i,j)*FAREA
+                  SNOWC_mosaic_avg(i,j) = SNOWC_mosaic_avg(i,j) + SNOWC_mosaic(i,mosaic_i,j)*FAREA
+      
+                   DO NS=1,NSOIL
+      
+                 TSLB_mosaic_avg(i,NS,j)=TSLB_mosaic_avg(i,NS,j) + TSLB_mosaic(i,NS*mosaic_i,j)*FAREA
+                 SMOIS_mosaic_avg(i,NS,j)=SMOIS_mosaic_avg(i,NS,j) + SMOIS_mosaic(i,NS*mosaic_i,j)*FAREA
+                 SH2O_mosaic_avg(i,NS,j)=SH2O_mosaic_avg(i,NS,j) + SH2O_mosaic(i,NS*mosaic_i,j)*FAREA
+      
+                   ENDDO
+      
+                  FAREA_mosaic_avg(i,j)=FAREA_mosaic_avg(i,j)+FAREA
+                  HFX_mosaic_avg(i,j) = HFX_mosaic_avg(i,j) + HFX_mosaic(i,mosaic_i,j)*FAREA
+                  QFX_mosaic_avg(i,j) = QFX_mosaic_avg(i,j) + QFX_mosaic(i,mosaic_i,j)*FAREA
+                  LH_mosaic_avg(i,j) = LH_mosaic_avg(i,j) + LH_mosaic(i,mosaic_i,j)*FAREA
+                  GRDFLX_mosaic_avg(i,j)=GRDFLX_mosaic_avg(i,j)+GRDFLX_mosaic(i,mosaic_i,j)*FAREA
+                  
+                  ALBEDO_mosaic_avg(i,j)=ALBEDO_mosaic_avg(i,j)+ALBEDO_mosaic(i,mosaic_i,j)*FAREA
+                  ALBBCK_mosaic_avg(i,j)=ALBBCK_mosaic_avg(i,j)+ALBBCK_mosaic(i,mosaic_i,j)*FAREA
+                  EMISS_mosaic_avg(i,j)=EMISS_mosaic_avg(i,j)+EMISS_mosaic(i,mosaic_i,j)*FAREA
+                  EMBCK_mosaic_avg(i,j)=EMBCK_mosaic_avg(i,j)+EMBCK_mosaic(i,mosaic_i,j)*FAREA
+                  ZNT_mosaic_avg(i,j)=ZNT_mosaic_avg(i,j)+ALOG(ZNT_mosaic(i,mosaic_i,j))*FAREA
+                  Z0_mosaic_avg(i,j)=Z0_mosaic_avg(i,j)+ALOG(Z0_mosaic(i,mosaic_i,j))*FAREA
+                  LAI_mosaic_avg(i,j)=LAI_mosaic_avg(i,j)+LAI_mosaic(i,mosaic_i,j)*FAREA
+                  if(RC_mosaic(i,mosaic_i,j) .Gt. 0.0) Then
+                     RC_mosaic_avg(i,j) = RC_mosaic_avg(i,j)+1.0/RC_mosaic(i,mosaic_i,j)*FAREA
+                  else 
+                     RC_mosaic_avg(i,j) = RC_mosaic_avg(i,j) + RC_mosaic(i,mosaic_i,j)*FAREA
+                  End If
+                  ENDDO                     ! ENDDO FOR mosaic_i = 1, mosaic_cat
+
+      !-----------------------------------------------------------------------
+      ! Now let's send the 3D values to the 2D variables that might be needed in other routines
+      !-----------------------------------------------------------------------
+      
+          IVGTYP(I,J)=IVGTYP_dominant(I,J)                                 ! the dominant vege category 
+          ALBEDO(i,j)=ALBEDO_mosaic_avg(i,j)
+          ALBBCK(i,j)=ALBBCK_mosaic_avg(i,j) 
+          EMISS(i,j)= EMISS_mosaic_avg(i,j) 
+          EMBCK(i,j)= EMBCK_mosaic_avg(i,j)  
+          ZNT(i,j)= EXP(ZNT_mosaic_avg(i,j)/FAREA_mosaic_avg(i,j))
+          Z0(i,j)= EXP(Z0_mosaic_avg(i,j)/FAREA_mosaic_avg(i,j))
+          XLAI2(i,j)= LAI_mosaic_avg(i,j)
+          IF (RC_mosaic_avg(i,j) .Gt. 0.0) THEN
+              rc2(i,j) = 1.0/(RC_mosaic_avg(i,j))
+          ELSE
+!RC_mosaic_avg was zero for all tiles (cell over water), thus RC2 set to zero to avoid infinity
+              rc2(i,j) = RC_mosaic_avg(i,j)
+          END IF
+          TSK(i,j)=(TSK_mosaic_avg(I,J)/EMISS_mosaic_avg(I,J))**(0.25)                                  ! from 3D to 2D
+          QSFC(i,j)=QSFC_mosaic_avg(I,J)
+          CANWAT(i,j) = CANWAT_mosaic_avg(i,j)
+          SNOW(i,j) = SNOW_mosaic_avg(i,j)
+          SNOWH(i,j) = SNOWH_mosaic_avg(i,j)  
+          SNOWC(i,j) = SNOWC_mosaic_avg(i,j)    
+          
+          HFX(i,j) = HFX_mosaic_avg(i,j) 
+          QFX(i,j) = QFX_mosaic_avg(i,j) 
+          LH(i,j) = LH_mosaic_avg(i,j) 
+          GRDFLX(i,j)=GRDFLX_mosaic_avg(i,j)
+        
+                    DO NS=1,NSOIL
+      
+               TSLB(i,NS,j)=TSLB_mosaic_avg(i,NS,j)
+               SMOIS(i,NS,j)=SMOIS_mosaic_avg(i,NS,j)
+               SH2O(i,NS,j)=SH2O_mosaic_avg(i,NS,j)
+      
+                    ENDDO
+      
+      ELSE    ! This corresponds to IF ((sf_surface_mosaic == 1) .AND. ((XLAND(I,J)-1.5).LT.0.) .AND. (XICE(I,J) < XICE_THRESHOLD) ) THEN
+      
+      ! surface pressure
+              PSFC=P8w3D(i,1,j)
+      ! pressure in middle of lowest layer
+              SFCPRS=(P8W3D(I,KTS+1,j)+P8W3D(i,KTS,j))*0.5
+      ! convert from mixing ratio to specific humidity
+               Q2K=QV3D(i,1,j)/(1.0+QV3D(i,1,j))
+      !
+      !         Q2SAT=QGH(I,j)
+               Q2SAT=QGH(I,J)/(1.0+QGH(I,J))        ! Q2SAT is sp humidity
+      ! add check on myj=.true.
+      !        IF((Q2K.GE.Q2SAT*TRESH).AND.Q2K.LT.QZ0(I,J))THEN
+              IF((myj).AND.(Q2K.GE.Q2SAT*TRESH).AND.Q2K.LT.QZ0(I,J))THEN
+                SATFLG=0.
+                CHKLOWQ(I,J)=0.
+              ELSE
+                SATFLG=1.0
+                CHKLOWQ(I,J)=1.
+              ENDIF
+      
+              SFCTMP=T3D(i,1,j)
+              ZLVL=0.5*DZ8W(i,1,j)
+      
+      !        TH2=SFCTMP+(0.0097545*ZLVL)
+      ! calculate SFCTH2 via Exner function vs lapse-rate (above)
+               APES=(1.E5/PSFC)**CAPA
+               APELM=(1.E5/SFCPRS)**CAPA
+               SFCTH2=SFCTMP*APELM
+               TH2=SFCTH2/APES
+      !
+               EMISSI = EMISS(I,J)
+               LWDN=GLW(I,J)*EMISSI
+      ! SOLDN is total incoming solar
+              SOLDN=SWDOWN(I,J)
+      ! GSW is net downward solar
+      !        SOLNET=GSW(I,J)
+      ! use mid-day albedo to determine net downward solar (no solar zenith angle correction)
+              SOLNET=SOLDN*(1.-ALBEDO(I,J))
+              PRCP=RAINBL(i,j)/DT
+              VEGTYP=IVGTYP(I,J)
+              SOILTYP=ISLTYP(I,J)
+              SHDFAC=VEGFRA(I,J)/100.
+              T1=TSK(I,J)
+              CHK=CHS(I,J)
+              SHMIN=SHDMIN(I,J)/100. !NEW
+              SHMAX=SHDMAX(I,J)/100. !NEW
+      ! convert snow water equivalent from mm to meter
+              SNEQV=SNOW(I,J)*0.001
+      ! snow depth in meters
+              SNOWHK=SNOWH(I,J)
+              SNCOVR=SNOWC(I,J)
+      
+      ! if "SR" present, set frac of frozen precip ("FFROZP") = snow-ratio ("SR", range:0-1)
+      ! SR from e.g. Ferrier microphysics
+      ! otherwise define from 1st atmos level temperature
+             IF(FRPCPN) THEN
+                FFROZP=SR(I,J)
+              ELSE
+                IF (SFCTMP <=  273.15) THEN
+                  FFROZP = 1.0
+      	  ELSE
+      	    FFROZP = 0.0
+      	  ENDIF
+              ENDIF
+      !***
+              IF((XLAND(I,J)-1.5).GE.0.)THEN                                  ! begining of land/sea if block
+      ! Open water points
+                TSK_RURAL(I,J)=TSK(I,J)
+                HFX_RURAL(I,J)=HFX(I,J)
+                QFX_RURAL(I,J)=QFX(I,J)
+                LH_RURAL(I,J)=LH(I,J)
+                EMISS_RURAL(I,J)=EMISS(I,J)
+                GRDFLX_RURAL(I,J)=GRDFLX(I,J)
+              ELSE
+      ! Land or sea-ice case
+      
+                IF (XICE(I,J) >= XICE_THRESHOLD) THEN
+                   ! Sea-ice point
+                   ICE = 1
+                ELSE IF ( VEGTYP == ISICE ) THEN
+                   ! Land-ice point
+                   ICE = -1
+                ELSE
+                   ! Neither sea ice or land ice.
+                   ICE=0
+                ENDIF
+                DQSDT2=Q2SAT*A23M4/(SFCTMP-A4)**2
+      
+                IF(SNOW(I,J).GT.0.0)THEN
+      ! snow on surface (use ice saturation properties)
+                  SFCTSNO=SFCTMP
+                  E2SAT=611.2*EXP(6174.*(1./273.15 - 1./SFCTSNO))
+                  Q2SATI=0.622*E2SAT/(SFCPRS-E2SAT)
+                  Q2SATI=Q2SATI/(1.0+Q2SATI)    ! spec. hum.
+                  IF (T1 .GT. 273.14) THEN
+      ! warm ground temps, weight the saturation between ice and water according to SNOWC
+                    Q2SAT=Q2SAT*(1.-SNOWC(I,J)) + Q2SATI*SNOWC(I,J)
+                    DQSDT2=DQSDT2*(1.-SNOWC(I,J)) + Q2SATI*6174./(SFCTSNO**2)*SNOWC(I,J)
+                  ELSE
+      ! cold ground temps, use ice saturation only
+                    Q2SAT=Q2SATI
+                    DQSDT2=Q2SATI*6174./(SFCTSNO**2)
+                  ENDIF
+      ! for snow cover fraction at 0 C, ground temp will not change, so DQSDT2 effectively zero
+                  IF(T1 .GT. 273. .AND. SNOWC(I,J) .GT. 0.)DQSDT2=DQSDT2*(1.-SNOWC(I,J))
+                ENDIF
+      
+                ! Land-ice or land points use the usual deep-soil temperature.
+                TBOT=TMN(I,J)
+      
+                IF(VEGTYP.EQ.25) SHDFAC=0.0000
+                IF(VEGTYP.EQ.26) SHDFAC=0.0000
+                IF(VEGTYP.EQ.27) SHDFAC=0.0000
+                IF(SOILTYP.EQ.14.AND.XICE(I,J).EQ.0.)THEN
+#if 0
+               IF(IPRINT)PRINT*,' SOIL TYPE FOUND TO BE WATER AT A LAND-POINT'
+               IF(IPRINT)PRINT*,i,j,'RESET SOIL in surfce.F'
+#endif
+                  SOILTYP=7
+                ENDIF
+                SNOALB1 = SNOALB(I,J)
+                CMC=CANWAT(I,J)/1000.
+      
+      !-------------------------------------------
+      !*** convert snow depth from mm to meter
+      !
+      !          IF(RDMAXALB) THEN
+      !           SNOALB=ALBMAX(I,J)*0.01
+      !         ELSE
+      !           SNOALB=MAXALB(IVGTPK)*0.01
+      !         ENDIF
+      
+      !        SNOALB1=0.80
+      !        SHMIN=0.00
+              ALBBRD=ALBBCK(I,J)
+              Z0BRD=Z0(I,J)
+              EMBRD=EMBCK(I,J)
+              SNOTIME1 = SNOTIME(I,J)
+              RIBB=RIB(I,J)
+      !FEI: temporaray arrays above need to be changed later by using SI
+      
+                DO NS=1,NSOIL
+                  SMC(NS)=SMOIS(I,NS,J)
+                  STC(NS)=TSLB(I,NS,J)                                          !STEMP
+                  SWC(NS)=SH2O(I,NS,J)
+                ENDDO
+      !
+                if ( (SNEQV.ne.0..AND.SNOWHK.eq.0.).or.(SNOWHK.le.SNEQV) )THEN
+                  SNOWHK= 5.*SNEQV
+                endif
+      !
+      
+      !Fei: urban. for urban surface, if calling UCM, redefine the natural surface in cities as
+      ! the "NATURAL" category in the VEGPARM.TBL
+      	
+      	   IF(SF_URBAN_PHYSICS == 1.OR. SF_URBAN_PHYSICS==2.OR.SF_URBAN_PHYSICS==3 ) THEN
+                      IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LOW_DENSITY_RESIDENTIAL .or. &
+                        IVGTYP(I,J) == HIGH_DENSITY_RESIDENTIAL .or. IVGTYP(I,J) == HIGH_INTENSITY_INDUSTRIAL) THEN
+      		 VEGTYP = NATURAL
+                       SHDFAC = SHDTBL(NATURAL)
+                       ALBEDOK =0.2         !  0.2
+                       ALBBRD  =0.2         !0.2
+                       EMISSI = 0.98                                 !for VEGTYP=5
+      		 IF ( FRC_URB2D(I,J) < 0.99 ) THEN
+                   if(sf_urban_physics.eq.1)then
+                     T1= ( TSK(I,J) -FRC_URB2D(I,J) * TS_URB2D (I,J) )/ (1-FRC_URB2D(I,J))
+                   elseif((sf_urban_physics.eq.2).OR.(sf_urban_physics.eq.3))then
+                     T1=tsk_rural_bep(i,j)
+                   endif
+     	         ELSE
+      		 T1 = TSK(I,J)
+                       ENDIF
+                      ENDIF
+                 ELSE
+                       IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LOW_DENSITY_RESIDENTIAL .or. &
+                        IVGTYP(I,J) == HIGH_DENSITY_RESIDENTIAL .or. IVGTYP(I,J) == HIGH_INTENSITY_INDUSTRIAL) THEN
+                        VEGTYP = ISURBAN
+                 	 ENDIF
+                 ENDIF
+
+
+!===Yang, 2014/10/08, hydrological processes for urban vegetation in single layer UCM===
+           AOASIS = 1.0
+           USOIL = 1
+           DSOIL = 2
+           IRIOPTION=IRI_SCHEME
+           OMG= OMG_URB2D(I,J)   
+           tloc=mod(int(OMG/3.14159*180./15.+12.+0.5 ),24)
+           if (tloc.lt.0) tloc=tloc+24
+           if (tloc==0) tloc=24
+           CALL cal_mon_day(julian,julyr,jmonth,jday) 
+	  IF(SF_URBAN_PHYSICS == 1) THEN
+           IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LOW_DENSITY_RESIDENTIAL .or. &
+                IVGTYP(I,J) == HIGH_DENSITY_RESIDENTIAL .or. IVGTYP(I,J) == HIGH_INTENSITY_INDUSTRIAL) THEN
+            AOASIS = oasis  ! urban oasis effect
+                   IF (IRIOPTION ==1) THEN
+                   IF (tloc==21 .or. tloc==22) THEN  !irrigation on vegetaion in urban area, MAY-SEP, 9-10pm
+                   IF (jmonth==5 .or. jmonth==6 .or. jmonth==7 .or. jmonth==8 .or. jmonth==9) THEN
+                      IF (SMC(USOIL) .LT. SMCREF) SMC(USOIL)= REFSMC(ISLTYP(I,J))
+                      IF (SMC(DSOIL) .LT. SMCREF) SMC(DSOIL)= REFSMC(ISLTYP(I,J))
+                   ENDIF
+                   ENDIF
+                   ENDIF
+                ENDIF
+           ENDIF
+
+	  IF(SF_URBAN_PHYSICS == 2 .or. SF_URBAN_PHYSICS == 3) THEN
+          IF(AOASIS > 1.0) THEN
+          CALL wrf_error_fatal('Urban oasis option is for SF_URBAN_PHYSICS == 1 only')
+          ENDIF
+          IF(IRIOPTION == 1) THEN
+          CALL wrf_error_fatal('Urban irrigation option is for SF_URBAN_PHYSICS == 1 only')
+          ENDIF
+          ENDIF
+
+#if 0
+                IF(IPRINT) THEN
+      !
+             print*, 'BEFORE SFLX, in Noahlsm_driver'
+             print*, 'ICE', ICE, 'DT',DT, 'ZLVL',ZLVL, 'NSOIL', NSOIL,   &
+             'SLDPTH', SLDPTH, 'LOCAL',LOCAL, 'LUTYPE',&
+              LUTYPE, 'SLTYPE',SLTYPE, 'LWDN',LWDN, 'SOLDN',SOLDN,      &
+              'SFCPRS',SFCPRS, 'PRCP',PRCP,'SFCTMP',SFCTMP,'Q2K',Q2K,   &
+               'TH2',TH2,'Q2SAT',Q2SAT,'DQSDT2',DQSDT2,'VEGTYP', VEGTYP,&
+               'SOILTYP',SOILTYP, 'SLOPETYP',SLOPETYP, 'SHDFAC',SHDFAC,&
+               'SHMIN',SHMIN, 'ALBBRD',ALBBRD,'SNOALB1',SNOALB1,'TBOT',&
+                TBOT, 'Z0BRD',Z0BRD, 'Z0K',Z0K, 'CMC',CMC, 'T1',T1,'STC',&
+                STC, 'SMC',SMC, 'SWC',SWC,'SNOWHK',SNOWHK,'SNEQV',SNEQV,&
+                'ALBEDOK',ALBEDOK,'CHK',CHK,'ETA',ETA,'SHEAT',SHEAT,      &
+                'ETA_KINEMATIC',ETA_KINEMATIC, 'FDOWN',FDOWN,'EC',EC,   &
+                'EDIR',EDIR,'ET',ET,'ETT',ETT,'ESNOW',ESNOW,'DRIP',DRIP,&
+                'DEW',DEW,'BETA',BETA,'ETP',ETP,'SSOIL',SSOIL,'FLX1',FLX1,&
+                'FLX2',FLX2,'FLX3',FLX3,'SNOMLT',SNOMLT,'SNCOVR',SNCOVR,&
+                'RUNOFF1',RUNOFF1,'RUNOFF2',RUNOFF2,'RUNOFF3',RUNOFF3, &
+                'RC',RC, 'PC',PC,'RSMIN',RSMIN,'XLAI',XLAI,'RCS',RCS,  &
+                'RCT',RCT,'RCQ',RCQ,'RCSOIL',RCSOIL,'SOILW',SOILW,     &
+                'SOILM',SOILM,'Q1',Q1,'SMCWLT',SMCWLT,'SMCDRY',SMCDRY,&
+                'SMCREF',SMCREF,'SMCMAX',SMCMAX,'NROOT',NROOT
+                 endif
+#endif
+      
+                IF (rdlai2d) THEN
+                   xlai = lai(i,j)
+                endif
+      
+          IF ( ICE == 1 ) THEN
+      
+             ! Sea-ice case
+      
+             DO NS = 1, NSOIL
+                SH2O(I,NS,J) = 1.0
+             ENDDO
+             LAI(I,J) = 0.01
+      
+             CYCLE ILOOP
+      
+          ELSEIF (ICE == 0) THEN
+      
+             ! Non-glacial land
+      
+             CALL SFLX (I,J,FFROZP, ISURBAN, DT,ZLVL,NSOIL,SLDPTH,       &    !C
+                       LOCAL,                                            &    !L
+                       LUTYPE, SLTYPE,                                   &    !CL
+                       LWDN,SOLDN,SOLNET,SFCPRS,PRCP,SFCTMP,Q2K,DUMMY,   &    !F
+                       DUMMY,DUMMY, DUMMY,                               &    !F PRCPRAIN not used
+                       TH2,Q2SAT,DQSDT2,                                 &    !I
+                       VEGTYP,SOILTYP,SLOPETYP,SHDFAC,SHMIN,SHMAX,       &    !I
+                       ALBBRD, SNOALB1,TBOT, Z0BRD, Z0K, EMISSI, EMBRD,  &    !S
+                       CMC,T1,STC,SMC,SWC,SNOWHK,SNEQV,ALBEDOK,CHK,dummy,&    !H
+                       ETA,SHEAT, ETA_KINEMATIC,FDOWN,                   &    !O
+                       EC,EDIR,ET,ETT,ESNOW,DRIP,DEW,                    &    !O
+                       BETA,ETP,SSOIL,                                   &    !O
+                       FLX1,FLX2,FLX3,                                   &    !O
+      		 FLX4,FVB,FBUR,FGSN,UA_PHYS,                             &    !UA 
+                       SNOMLT,SNCOVR,                                    &    !O
+                       RUNOFF1,RUNOFF2,RUNOFF3,                          &    !O
+                       RC,PC,RSMIN,XLAI,RCS,RCT,RCQ,RCSOIL,              &    !O
+                       SOILW,SOILM,Q1,SMAV,                              &    !D
+                       RDLAI2D,USEMONALB,                                &
+                       SNOTIME1,                                         &
+                       RIBB,                                             &
+                       SMCWLT,SMCDRY,SMCREF,SMCMAX,NROOT,                &
+                       sfcheadrt(i,j),                                   &    !I
+                       INFXSRT(i,j),ETPND1,OPT_THCND,AOASIS              &    !O
+                ,XSDA_QFX, HFX_PHY, QFX_PHY, XQNORM, fasdas, HCPCT_FASDAS    & ! fasdas vars
+                       )
+      
+#ifdef WRF_HYDRO
+                       soldrain(i,j) = RUNOFF2*DT*1000.0
+#endif
+          ELSEIF (ICE == -1) THEN
+      
+             !
+             ! Set values that the LSM is expected to update,
+             ! but don't get updated for glacial points.
+             !
+             SOILM = 0.0 !BSINGH(PNNL)- SOILM is undefined for this case, it is used for diagnostics so setting it to zero
+             XLAI = 0.01 ! KWM Should this be Zero over land ice?  Does this value matter?
+             RUNOFF2 = 0.0
+             RUNOFF3 = 0.0
+             DO NS = 1, NSOIL
+                SWC(NS) = 1.0
+                SMC(NS) = 1.0
+                SMAV(NS) = 1.0
+             ENDDO
+             CALL SFLX_GLACIAL(I,J,ISICE,FFROZP,DT,ZLVL,NSOIL,SLDPTH,   &    !C
+                  &    LWDN,SOLNET,SFCPRS,PRCP,SFCTMP,Q2K,              &    !F
+                  &    TH2,Q2SAT,DQSDT2,                                &    !I
+                  &    ALBBRD, SNOALB1,TBOT, Z0BRD, Z0K, EMISSI, EMBRD, &    !S
+                  &    T1,STC(1:NSOIL),SNOWHK,SNEQV,ALBEDOK,CHK,        &    !H
+                  &    ETA,SHEAT,ETA_KINEMATIC,FDOWN,                   &    !O
+                  &    ESNOW,DEW,                                       &    !O
+                  &    ETP,SSOIL,                                       &    !O
+                  &    FLX1,FLX2,FLX3,                                  &    !O
+                  &    SNOMLT,SNCOVR,                                   &    !O
+                  &    RUNOFF1,                                         &    !O
+                  &    Q1,                                              &    !D
+                  &    SNOTIME1,                                        &
+                  &    RIBB)
+      
+          ENDIF
+      
+             lai(i,j) = xlai
+
+#if 0
+                IF(IPRINT) THEN
+      
+             print*, 'AFTER SFLX, in Noahlsm_driver'
+             print*, 'ICE', ICE, 'DT',DT, 'ZLVL',ZLVL, 'NSOIL', NSOIL,   &
+             'SLDPTH', SLDPTH, 'LOCAL',LOCAL, 'LUTYPE',&
+              LUTYPE, 'SLTYPE',SLTYPE, 'LWDN',LWDN, 'SOLDN',SOLDN,      &
+              'SFCPRS',SFCPRS, 'PRCP',PRCP,'SFCTMP',SFCTMP,'Q2K',Q2K,   &
+               'TH2',TH2,'Q2SAT',Q2SAT,'DQSDT2',DQSDT2,'VEGTYP', VEGTYP,&
+                'SOILTYP',SOILTYP, 'SLOPETYP',SLOPETYP, 'SHDFAC',SHDFAC,&
+               'SHDMIN',SHMIN, 'ALBBRD',ALBBRD,'SNOALB',SNOALB1,'TBOT',&
+                TBOT, 'Z0BRD',Z0BRD, 'Z0K',Z0K, 'CMC',CMC, 'T1',T1,'STC',&
+                STC, 'SMC',SMC, 'SWc',SWC,'SNOWHK',SNOWHK,'SNEQV',SNEQV,&
+                'ALBEDOK',ALBEDOK,'CHK',CHK,'ETA',ETA,'SHEAT',SHEAT,      &
+                'ETA_KINEMATIC',ETA_KINEMATIC, 'FDOWN',FDOWN,'EC',EC,   &
+                'EDIR',EDIR,'ET',ET,'ETT',ETT,'ESNOW',ESNOW,'DRIP',DRIP,&
+                'DEW',DEW,'BETA',BETA,'ETP',ETP,'SSOIL',SSOIL,'FLX1',FLX1,&
+                'FLX2',FLX2,'FLX3',FLX3,'SNOMLT',SNOMLT,'SNCOVR',SNCOVR,&
+                'RUNOFF1',RUNOFF1,'RUNOFF2',RUNOFF2,'RUNOFF3',RUNOFF3, &
+                'RC',RC, 'PC',PC,'RSMIN',RSMIN,'XLAI',XLAI,'RCS',RCS,  &
+                'RCT',RCT,'RCQ',RCQ,'RCSOIL',RCSOIL,'SOILW',SOILW,     &
+                'SOILM',SOILM,'Q1',Q1,'SMCWLT',SMCWLT,'SMCDRY',SMCDRY,&
+                'SMCREF',SMCREF,'SMCMAX',SMCMAX,'NROOT',NROOT
+                 endif
+#endif
+      
+      !***  UPDATE STATE VARIABLES
+                CANWAT(I,J)=CMC*1000.
+                SNOW(I,J)=SNEQV*1000.
+      !          SNOWH(I,J)=SNOWHK*1000.
+                SNOWH(I,J)=SNOWHK                   ! SNOWHK in meters
+                ALBEDO(I,J)=ALBEDOK
+                ALB_RURAL(I,J)=ALBEDOK
+                ALBBCK(I,J)=ALBBRD
+                Z0(I,J)=Z0BRD
+                EMISS(I,J) = EMISSI
+                EMISS_RURAL(I,J) = EMISSI
+      ! Noah: activate time-varying roughness length (V3.3 Feb 2011)
+                ZNT(I,J)=Z0K
+                TSK(I,J)=T1
+                TSK_RURAL(I,J)=T1
+                HFX(I,J)=SHEAT
+                HFX_RURAL(I,J)=SHEAT
+      ! MEk Jul07 add potential evap accum
+              POTEVP(I,J)=POTEVP(I,J)+ETP*FDTW
+                QFX(I,J)=ETA_KINEMATIC
+                QFX_RURAL(I,J)=ETA_KINEMATIC
+      
+#ifdef WRF_HYDRO
+      !added by Wei Yu
+      !         QFX(I,J) = QFX(I,J) + ETPND1
+      !         ETA = ETA + ETPND1/2.501E6*dt
+      !end added by Wei Yu
+#endif
+      
+                LH(I,J)=ETA
+                LH_RURAL(I,J)=ETA
+                GRDFLX(I,J)=SSOIL
+                GRDFLX_RURAL(I,J)=SSOIL
+                SNOWC(I,J)=SNCOVR
+                CHS2(I,J)=CQS2(I,J)
+                SNOTIME(I,J) = SNOTIME1
+      !      prevent diagnostic ground q (q1) from being greater than qsat(tsk)
+      !      as happens over snow cover where the cqs2 value also becomes irrelevant
+      !      by setting cqs2=chs in this situation the 2m q should become just qv(k=1)
+                IF (Q1 .GT. QSFC(I,J)) THEN
+                  CQS2(I,J) = CHS(I,J)
+                ENDIF
+      !          QSFC(I,J)=Q1
+      ! Convert QSFC back to mixing ratio
+                 QSFC(I,J)= Q1/(1.0-Q1)
+      !
+                 ! QSFC_RURAL(I,J)= Q1/(1.0-Q1)
+      ! Calculate momentum flux from rural surface for use with multi-layer UCM (Martilli et al. 2002)
+      
+                DO 80 NS=1,NSOIL
+                 SMOIS(I,NS,J)=SMC(NS)
+                 TSLB(I,NS,J)=STC(NS)                                        !  STEMP
+                 SH2O(I,NS,J)=SWC(NS)
+         80     CONTINUE
+      !       ENDIF
+      
+              FLX4_2D(I,J)  = FLX4
+      	FVB_2D(I,J)   = FVB
+      	FBUR_2D(I,J)  = FBUR
+      	FGSN_2D(I,J)  = FGSN
+           !
+           ! Residual of surface energy balance equation terms
+           !
+      
+           IF ( UA_PHYS ) THEN
+               noahres(i,j) = ( solnet + lwdn ) - sheat + ssoil - eta &
+                    - ( emissi * STBOLT * (t1**4) ) - flx1 - flx2 - flx3 - flx4
+      
+           ELSE
+               noahres(i,j) = ( solnet + lwdn ) - sheat + ssoil - eta &
+                    - ( emissi * STBOLT * (t1**4) ) - flx1 - flx2 - flx3
+           ENDIF
+      
+              IF (SF_URBAN_PHYSICS == 1 ) THEN                                              ! Beginning of UCM CALL if block
+      !--------------------------------------
+      ! URBAN CANOPY MODEL START - urban
+      !--------------------------------------
+      ! Input variables lsm --> urban
+      
+                IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LOW_DENSITY_RESIDENTIAL .or. &
+                    IVGTYP(I,J) == HIGH_DENSITY_RESIDENTIAL .or. IVGTYP(I,J) ==  HIGH_INTENSITY_INDUSTRIAL) THEN
+      
+      ! Call urban
+      !
+                  UTYPE_URB = UTYPE_URB2D(I,J) !urban type (low, high or industrial)
+      
+                  TA_URB    = SFCTMP           ! [K]
+                  QA_URB    = Q2K              ! [kg/kg]
+                  UA_URB    = SQRT(U_PHY(I,1,J)**2.+V_PHY(I,1,J)**2.)
+                  U1_URB    = U_PHY(I,1,J)
+                  V1_URB    = V_PHY(I,1,J)
+                  IF(UA_URB < 1.) UA_URB=1.    ! [m/s]
+                  SSG_URB   = SOLDN            ! [W/m/m]
+                  SSGD_URB  = 0.8*SOLDN        ! [W/m/m]
+                  SSGQ_URB  = SSG_URB-SSGD_URB ! [W/m/m]
+                  LLG_URB   = GLW(I,J)         ! [W/m/m]
+                  RAIN_URB  = RAINBL(I,J)      ! [mm]
+                  RHOO_URB  = SFCPRS / (287.04 * SFCTMP * (1.0+ 0.61 * Q2K)) ![kg/m/m/m]
+                  ZA_URB    = ZLVL             ! [m]
+                  DELT_URB  = DT               ! [sec]
+                  XLAT_URB  = XLAT_URB2D(I,J)  ! [deg]
+                  COSZ_URB  = COSZ_URB2D(I,J)  !
+                  OMG_URB   = OMG_URB2D(I,J)   !
+                  ZNT_URB   = ZNT(I,J)
+      
+                  LSOLAR_URB = .FALSE.
+      
+                  TR_URB = TR_URB2D(I,J)
+                  TB_URB = TB_URB2D(I,J)
+                  TG_URB = TG_URB2D(I,J)
+                  TC_URB = TC_URB2D(I,J)
+                  QC_URB = QC_URB2D(I,J)
+                  UC_URB = UC_URB2D(I,J)
+      
+                  DO K = 1,num_roof_layers
+                    TRL_URB(K) = TRL_URB3D(I,K,J)
+                    SMR_URB(K) = SMR_URB3D(I,K,J)
+             	      TGRL_URB(K)= TGRL_URB3D(I,K,J)
+                  END DO
+                  DO K = 1,num_wall_layers
+                    TBL_URB(K) = TBL_URB3D(I,K,J)
+                  END DO
+                  DO K = 1,num_road_layers
+                    TGL_URB(K) = TGL_URB3D(I,K,J)
+                  END DO
+
+                  TGR_URB   = TGR_URB2D(I,J)
+                  CMCR_URB  = CMCR_URB2D(I,J)
+                  FLXHUMR_URB = FLXHUMR_URB2D(I,J)
+                  FLXHUMB_URB = FLXHUMB_URB2D(I,J)
+                  FLXHUMG_URB = FLXHUMG_URB2D(I,J)
+                  DRELR_URB = DRELR_URB2D(I,J)
+                  DRELB_URB = DRELB_URB2D(I,J)
+                  DRELG_URB = DRELG_URB2D(I,J)
+      
+                  XXXR_URB = XXXR_URB2D(I,J)
+                  XXXB_URB = XXXB_URB2D(I,J)
+                  XXXG_URB = XXXG_URB2D(I,J)
+                  XXXC_URB = XXXC_URB2D(I,J)
+      !
+      !      Limits to avoid dividing by small number
+                  if (CHS(I,J) < 1.0E-02) then
+                     CHS(I,J)  = 1.0E-02
+                  endif
+                  if (CHS2(I,J) < 1.0E-02) then
+                     CHS2(I,J)  = 1.0E-02
+                  endif
+                  if (CQS2(I,J) < 1.0E-02) then
+                     CQS2(I,J)  = 1.0E-02
+                  endif
+      !
+                  CHS_URB  = CHS(I,J)
+                  CHS2_URB = CHS2(I,J)
+                  IF (PRESENT(CMR_SFCDIF)) THEN
+                     CMR_URB = CMR_SFCDIF(I,J)
+                     CHR_URB = CHR_SFCDIF(I,J)
+                     CMGR_URB = CMGR_SFCDIF(I,J)
+                     CHGR_URB = CHGR_SFCDIF(I,J)
+                     CMC_URB = CMC_SFCDIF(I,J)
+                     CHC_URB = CHC_SFCDIF(I,J)
+                  ENDIF
+      
+      ! NUDAPT for SLUCM
+                  mh_urb = mh_urb2d(I,J)
+                  stdh_urb = stdh_urb2d(I,J)
+                  lp_urb = lp_urb2d(I,J)
+                  hgt_urb = hgt_urb2d(I,J)
+                  lf_urb = 0.0
+                  DO K = 1,4
+                    lf_urb(K)=lf_urb2d(I,K,J)
+                  ENDDO
+                  frc_urb = frc_urb2d(I,J)
+                  lb_urb = lb_urb2d(I,J)
+                  check = 0
+                  if (I.eq.73.and.J.eq.125)THEN
+                     check = 1
+                  end if
+      !
+      ! Call urban
+                  CALL cal_mon_day(julian,julyr,jmonth,jday)        
+                  CALL urban(LSOLAR_URB,                                      & ! I
+                             num_roof_layers,num_wall_layers,num_road_layers, & ! C
+                             DZR,DZB,DZG,                                     & ! C
+                             UTYPE_URB,TA_URB,QA_URB,UA_URB,U1_URB,V1_URB,SSG_URB, & ! I
+                             SSGD_URB,SSGQ_URB,LLG_URB,RAIN_URB,RHOO_URB,     & ! I
+                             ZA_URB,DECLIN_URB,COSZ_URB,OMG_URB,              & ! I
+                             XLAT_URB,DELT_URB,ZNT_URB,                       & ! I
+                             CHS_URB, CHS2_URB,                               & ! I
+                             TR_URB, TB_URB, TG_URB, TC_URB, QC_URB,UC_URB,   & ! H
+                             TRL_URB,TBL_URB,TGL_URB,                         & ! H
+                             XXXR_URB, XXXB_URB, XXXG_URB, XXXC_URB,          & ! H
+                             TS_URB,QS_URB,SH_URB,LH_URB,LH_KINEMATIC_URB,    & ! O
+                             SW_URB,ALB_URB,LW_URB,G_URB,RN_URB,PSIM_URB,PSIH_URB, & ! O
+                             GZ1OZ0_URB,                                      & !O
+                             CMR_URB, CHR_URB, CMC_URB, CHC_URB,              &
+                             U10_URB, V10_URB, TH2_URB, Q2_URB,               & ! O
+                             UST_URB,mh_urb, stdh_urb, lf_urb, lp_urb,        & ! 0
+                             hgt_urb,frc_urb,lb_urb, check,CMCR_URB,TGR_URB,  & ! H
+                             TGRL_URB,SMR_URB,CMGR_URB,CHGR_URB,jmonth,       & ! H
+                             DRELR_URB,DRELB_URB,                             & ! H
+                             DRELG_URB,FLXHUMR_URB,FLXHUMB_URB,FLXHUMG_URB)  
+      
+#if 0
+                IF(IPRINT) THEN
+      
+             print*, 'AFTER CALL URBAN'
+             print*,'num_roof_layers',num_roof_layers, 'num_wall_layers',  &
+              num_wall_layers,                                             &
+             'DZR',DZR,'DZB',DZB,'DZG',DZG,'UTYPE_URB',UTYPE_URB,'TA_URB', &
+              TA_URB,                                                      &
+              'QA_URB',QA_URB,'UA_URB',UA_URB,'U1_URB',U1_URB,'V1_URB',    &
+               V1_URB,                                                     &
+               'SSG_URB',SSG_URB,'SSGD_URB',SSGD_URB,'SSGQ_URB',SSGQ_URB,  &
+              'LLG_URB',LLG_URB,'RAIN_URB',RAIN_URB,'RHOO_URB',RHOO_URB,   &
+              'ZA_URB',ZA_URB, 'DECLIN_URB',DECLIN_URB,'COSZ_URB',COSZ_URB,&
+              'OMG_URB',OMG_URB,'XLAT_URB',XLAT_URB,'DELT_URB',DELT_URB,   &
+               'ZNT_URB',ZNT_URB,'TR_URB',TR_URB, 'TB_URB',TB_URB,'TG_URB',&
+               TG_URB,'TC_URB',TC_URB,'QC_URB',QC_URB,'TRL_URB',TRL_URB,   &
+                'TBL_URB',TBL_URB,'TGL_URB',TGL_URB,'XXXR_URB',XXXR_URB,   &
+               'XXXB_URB',XXXB_URB,'XXXG_URB',XXXG_URB,'XXXC_URB',XXXC_URB,&
+               'TS_URB',TS_URB,'QS_URB',QS_URB,'SH_URB',SH_URB,'LH_URB',   &
+               LH_URB, 'LH_KINEMATIC_URB',LH_KINEMATIC_URB,'SW_URB',SW_URB,&
+               'ALB_URB',ALB_URB,'LW_URB',LW_URB,'G_URB',G_URB,'RN_URB',   &
+                RN_URB, 'PSIM_URB',PSIM_URB,'PSIH_URB',PSIH_URB,          &
+               'U10_URB',U10_URB,'V10_URB',V10_URB,'TH2_URB',TH2_URB,      &
+                'Q2_URB',Q2_URB,'CHS_URB',CHS_URB,'CHS2_URB',CHS2_URB
+                 endif
+#endif
+      
+                  TS_URB2D(I,J) = TS_URB
+      
+                  ALBEDO(I,J) = FRC_URB2D(I,J)*ALB_URB+(1-FRC_URB2D(I,J))*ALBEDOK   ![-]
+                  HFX(I,J) = FRC_URB2D(I,J)*SH_URB+(1-FRC_URB2D(I,J))*SHEAT         ![W/m/m]
+                  QFX(I,J) = FRC_URB2D(I,J)*LH_KINEMATIC_URB &
+                           + (1-FRC_URB2D(I,J))*ETA_KINEMATIC                ![kg/m/m/s]
+                  LH(I,J) = FRC_URB2D(I,J)*LH_URB+(1-FRC_URB2D(I,J))*ETA            ![W/m/m]
+                  GRDFLX(I,J) = FRC_URB2D(I,J)*G_URB+(1-FRC_URB2D(I,J))*SSOIL       ![W/m/m]
+                  TSK(I,J) = FRC_URB2D(I,J)*TS_URB+(1-FRC_URB2D(I,J))*T1            ![K]
+                  Q1 = FRC_URB2D(I,J)*QS_URB+(1-FRC_URB2D(I,J))*Q1            ![-]
+      ! Convert QSFC back to mixing ratio
+                  QSFC(I,J)= Q1/(1.0-Q1)
+                  UST(I,J)= FRC_URB2D(I,J)*UST_URB+(1-FRC_URB2D(I,J))*UST(I,J)      ![m/s]
+      
+#if 0
+          IF(IPRINT)THEN
+      
+          print*, ' FRC_URB2D', FRC_URB2D,                        &
+          'ALB_URB',ALB_URB, 'ALBEDOK',ALBEDOK, &
+          'ALBEDO(I,J)',  ALBEDO(I,J),                  &
+          'SH_URB',SH_URB,'SHEAT',SHEAT, 'HFX(I,J)',HFX(I,J),  &
+          'LH_KINEMATIC_URB',LH_KINEMATIC_URB,'ETA_KINEMATIC',  &
+           ETA_KINEMATIC, 'QFX(I,J)',QFX(I,J),                  &
+          'LH_URB',LH_URB, 'ETA',ETA, 'LH(I,J)',LH(I,J),        &
+          'G_URB',G_URB,'SSOIL',SSOIL,'GRDFLX(I,J)', GRDFLX(I,J),&
+          'TS_URB',TS_URB,'T1',T1,'TSK(I,J)',TSK(I,J),          &
+          'QS_URB',QS_URB,'Q1',Q1,'QSFC(I,J)',QSFC(I,J)
+           endif
+#endif
+      
+      ! Renew Urban State Varialbes
+      
+                  TR_URB2D(I,J) = TR_URB
+                  TB_URB2D(I,J) = TB_URB
+                  TG_URB2D(I,J) = TG_URB
+                  TC_URB2D(I,J) = TC_URB
+                  QC_URB2D(I,J) = QC_URB
+                  UC_URB2D(I,J) = UC_URB
+      
+                  DO K = 1,num_roof_layers
+                    TRL_URB3D(I,K,J) = TRL_URB(K)
+                    SMR_URB3D(I,K,J) = SMR_URB(K)
+                    TGRL_URB3D(I,K,J)= TGRL_URB(K)
+                  END DO
+                  DO K = 1,num_wall_layers
+                    TBL_URB3D(I,K,J) = TBL_URB(K)
+                  END DO
+                  DO K = 1,num_road_layers
+                    TGL_URB3D(I,K,J) = TGL_URB(K)
+                  END DO
+                 
+                  TGR_URB2D(I,J) =TGR_URB 
+                  CMCR_URB2D(I,J)=CMCR_URB
+                  FLXHUMR_URB2D(I,J)=FLXHUMR_URB 
+                  FLXHUMB_URB2D(I,J)=FLXHUMB_URB
+                  FLXHUMG_URB2D(I,J)=FLXHUMG_URB
+                  DRELR_URB2D(I,J) = DRELR_URB 
+                  DRELB_URB2D(I,J) = DRELB_URB 
+                  DRELG_URB2D(I,J) = DRELG_URB
+
+                  XXXR_URB2D(I,J) = XXXR_URB
+                  XXXB_URB2D(I,J) = XXXB_URB
+                  XXXG_URB2D(I,J) = XXXG_URB
+                  XXXC_URB2D(I,J) = XXXC_URB
+      
+                  SH_URB2D(I,J)    = SH_URB
+                  LH_URB2D(I,J)    = LH_URB
+                  G_URB2D(I,J)     = G_URB
+                  RN_URB2D(I,J)    = RN_URB
+                  PSIM_URB2D(I,J)  = PSIM_URB
+                  PSIH_URB2D(I,J)  = PSIH_URB
+                  GZ1OZ0_URB2D(I,J)= GZ1OZ0_URB
+                  U10_URB2D(I,J)   = U10_URB
+                  V10_URB2D(I,J)   = V10_URB
+                  TH2_URB2D(I,J)   = TH2_URB
+                  Q2_URB2D(I,J)    = Q2_URB
+                  UST_URB2D(I,J)   = UST_URB
+                  AKMS_URB2D(I,J)  = KARMAN * UST_URB2D(I,J)/(GZ1OZ0_URB2D(I,J)-PSIM_URB2D(I,J))
+                  IF (PRESENT(CMR_SFCDIF)) THEN
+                     CMR_SFCDIF(I,J) = CMR_URB
+                     CHR_SFCDIF(I,J) = CHR_URB
+                     CMGR_SFCDIF(I,J) = CMGR_URB
+                     CHGR_SFCDIF(I,J) = CHGR_URB
+                     CMC_SFCDIF(I,J) = CMC_URB
+                     CHC_SFCDIF(I,J) = CHC_URB
+                  ENDIF
+                END IF
+      
+               ENDIF                                   ! end of UCM CALL if block
+      !--------------------------------------
+      ! Urban Part End - urban
+      !--------------------------------------
+      
+      !***  DIAGNOSTICS
+                SMSTAV(I,J)=SOILW
+                SMSTOT(I,J)=SOILM*1000.
+                DO NS=1,NSOIL
+                SMCREL(I,NS,J)=SMAV(NS)
+                ENDDO
+      
+      !         Convert the water unit into mm
+                SFCRUNOFF(I,J)=SFCRUNOFF(I,J)+RUNOFF1*DT*1000.0
+                UDRUNOFF(I,J)=UDRUNOFF(I,J)+RUNOFF2*DT*1000.0
+      ! snow defined when fraction of frozen precip (FFROZP) > 0.5,
+                IF(FFROZP.GT.0.5)THEN
+                  ACSNOW(I,J)=ACSNOW(I,J)+PRCP*DT
+                ENDIF
+                IF(SNOW(I,J).GT.0.)THEN
+                  ACSNOM(I,J)=ACSNOM(I,J)+SNOMLT*1000.
+      ! accumulated snow-melt energy
+                  SNOPCX(I,J)=SNOPCX(I,J)-SNOMLT/FDTLIW
+                ENDIF
+      
+              ENDIF                                                           ! endif of land-sea test
+
+      ENDIF                                           ! ENDIF FOR MOSAIC DANLI  ! This corresponds to IF ((sf_surface_mosaic == 1) .AND. ((XLAND(I,J)-1.5).LT.0.) .AND. (XICE(I,J) < XICE_THRESHOLD) ) THEN
+
+      ENDDO ILOOP                                                       ! of I loop
+   ENDDO JLOOP                                                          ! of J loop   
+       
+!------------------------------------------------------
+   END SUBROUTINE lsm_mosaic
+!------------------------------------------------------
+!===========================================================================
+!
+! subroutine lsm_mosaic_init: initialization of mosaic state variables
+!
+!===========================================================================   
+  
+   SUBROUTINE lsm_mosaic_init(IVGTYP,ISWATER,ISURBAN,ISICE, XLAND, XICE,fractional_seaice, &
+                  TSK,TSLB,SMOIS,SH2O,SNOW,SNOWC,SNOWH,CANWAT,    &
+                  ids,ide, jds,jde, kds,kde,                      &
+                  ims,ime, jms,jme, kms,kme,                      &
+                  its,ite, jts,jte, kts,kte, restart,             &
+                  landusef,landusef2,NLCAT,num_soil_layers        & 
+                  ,sf_surface_mosaic, mosaic_cat                  & 
+                  ,mosaic_cat_index                               &   
+                  ,TSK_mosaic,TSLB_mosaic                         &
+                  ,SMOIS_mosaic,SH2O_mosaic                       & 
+                  ,CANWAT_mosaic,SNOW_mosaic                      &
+                  ,SNOWH_mosaic,SNOWC_mosaic                      &
+                  ,ALBEDO,ALBBCK, EMISS, EMBCK,Z0                 &  !danli  
+                  ,ALBEDO_mosaic,ALBBCK_mosaic, EMISS_mosaic      &  !danli
+                  ,EMBCK_mosaic, ZNT_mosaic, Z0_mosaic            &  !danli
+                  ,TR_URB2D_mosaic,TB_URB2D_mosaic                &  !danli mosaic 
+                  ,TG_URB2D_mosaic,TC_URB2D_mosaic                &  !danli mosaic 
+                  ,QC_URB2D_mosaic                                &  !danli mosaic                  
+                  ,TRL_URB3D_mosaic,TBL_URB3D_mosaic              &  !danli mosaic 
+                  ,TGL_URB3D_mosaic                               &  !danli mosaic 
+                  ,SH_URB2D_mosaic,LH_URB2D_mosaic                &  !danli mosaic 
+                  ,G_URB2D_mosaic,RN_URB2D_mosaic                 &  !danli mosaic 
+                  ,TS_URB2D_mosaic                                &  !danli mosaic 
+                  ,TS_RUL2D_mosaic                                &  !danli mosaic                    
+                   ) 
+  
+    INTEGER,  INTENT(IN)   ::       ids,ide, jds,jde, kds,kde,  &
+                                    ims,ime, jms,jme, kms,kme,  &
+                                    its,ite, jts,jte, kts,kte 
+
+   INTEGER, INTENT(IN)       ::     NLCAT, num_soil_layers, ISWATER,ISURBAN, ISICE, fractional_seaice
+
+   LOGICAL , INTENT(IN) :: restart 
+
+!   REAL,    DIMENSION( num_soil_layers), INTENT(INOUT) :: ZS, DZS
+
+   REAL,    DIMENSION( ims:ime, num_soil_layers, jms:jme )    , &
+            INTENT(IN)    ::                             SMOIS, &  !Total soil moisture
+                                                         SH2O,  &  !liquid soil moisture       
+                                                         TSLB      !STEMP
+
+   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+            INTENT(IN)    ::                           SNOW, &
+                                                         SNOWH, &
+                                                         SNOWC, &
+                                                        CANWAT, &
+                                                        TSK, XICE, XLAND         
+  
+  INTEGER, INTENT(IN) :: sf_surface_mosaic  
+  INTEGER, INTENT(IN) :: mosaic_cat
+  INTEGER, DIMENSION( ims:ime, jms:jme ),INTENT(IN) :: IVGTYP
+  REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , INTENT(IN)::   LANDUSEF
+  REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , INTENT(INOUT)::   LANDUSEF2
+  
+  INTEGER, DIMENSION( ims:ime, NLCAT, jms:jme ), INTENT(INOUT) :: mosaic_cat_index 
+
+  REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT)::   &
+        TSK_mosaic, CANWAT_mosaic, SNOW_mosaic,SNOWH_mosaic, SNOWC_mosaic 
+  REAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), OPTIONAL, INTENT(INOUT)::   &
+        TSLB_mosaic,SMOIS_mosaic,SH2O_mosaic
+  
+  REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(IN)::   ALBEDO, ALBBCK, EMISS, EMBCK, Z0 
+  REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT)::   &
+        ALBEDO_mosaic,ALBBCK_mosaic, EMISS_mosaic, EMBCK_mosaic, ZNT_mosaic, Z0_mosaic
+
+  REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT)::   &
+        TR_URB2D_mosaic, TB_URB2D_mosaic, TG_URB2D_mosaic, TC_URB2D_mosaic,QC_URB2D_mosaic,  &
+        SH_URB2D_mosaic,LH_URB2D_mosaic,G_URB2D_mosaic,RN_URB2D_mosaic,TS_URB2D_mosaic, TS_RUL2D_mosaic  
+                    
+  REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TRL_URB3D_mosaic
+  REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TBL_URB3D_mosaic
+  REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TGL_URB3D_mosaic    
+
+  INTEGER :: ij,i,j,mosaic_i,LastSwap,NumPairs,soil_k, Temp2,Temp5,Temp7, ICE,temp_index
+  REAL :: Temp, Temp3,Temp4,Temp6,xice_threshold
+  LOGICAL :: IPRINT
+  CHARACTER(len=256) :: message_text
+
+  IPRINT=.false.
+
+  if ( fractional_seaice == 0 ) then
+     xice_threshold = 0.5
+  else if ( fractional_seaice == 1 ) then
+     xice_threshold = 0.02
+  endif
+
+    IF(.not.restart)THEN
+  !===========================================================================   
+  ! CHOOSE THE TILES
+  !===========================================================================  
+  
+  itf=min0(ite,ide-1)
+  jtf=min0(jte,jde-1)
+
+  ! simple test
+   
+  DO i = its,itf
+     DO j = jts,jtf 
+        IF ((xland(i,j).LT. 1.5 ) .AND. (IVGTYP(i,j) .EQ. ISWATER)) THEN
+           PRINT*, 'BEFORE MOSAIC_INIT'
+           CALL wrf_message("BEFORE MOSAIC_INIT")
+           WRITE(message_text,fmt='(a,2I6,2F8.2,2I6)') 'I,J,xland,xice,mosaic_cat_index,ivgtyp = ', &
+                 I,J,xland(i,j),xice(i,j),mosaic_cat_index(I,1,J),IVGTYP(i,j)
+           CALL wrf_message(message_text)
+        ENDIF
+     ENDDO
+  ENDDO
+
+     DO i = its,itf
+        DO j = jts,jtf
+           DO mosaic_i=1,NLCAT
+              LANDUSEF2(i,mosaic_i,j)=LANDUSEF(i,mosaic_i,j)
+              mosaic_cat_index(i,mosaic_i,j)=mosaic_i
+           ENDDO
+        ENDDO
+     ENDDO
+
+     DO i = its,itf
+        DO j = jts,jtf
+          
+          NumPairs=NLCAT-1
+          
+          DO 
+               IF (NumPairs == 0) EXIT
+                   LastSwap = 1
+          DO  mosaic_i=1, NumPairs
+            IF(LANDUSEF2(i,mosaic_i, j) < LANDUSEF2(i,mosaic_i+1, j)  ) THEN
+               Temp = LANDUSEF2(i,mosaic_i, j)
+               LANDUSEF2(i,mosaic_i, j)=LANDUSEF2(i,mosaic_i+1, j)
+               LANDUSEF2(i,mosaic_i+1, j)=Temp            
+               LastSwap = mosaic_i 
+            
+               Temp2 =  mosaic_cat_index(i,mosaic_i,j)
+               mosaic_cat_index(i,mosaic_i,j)=mosaic_cat_index(i,mosaic_i+1,j)
+               mosaic_cat_index(i,mosaic_i+1,j)=Temp2
+            ENDIF
+          ENDDO
+               NumPairs = LastSwap - 1
+          ENDDO
+          
+        ENDDO
+      ENDDO
+
+  !===========================================================================   
+  ! For non-seaice grids, eliminate the seaice-tiles
+  !=========================================================================== 
+
+     DO i = its,itf
+        DO j = jts,jtf
+        
+         IF   (XLAND(I,J).LT.1.5)  THEN
+
+             ICE = 0
+                 IF( XICE(I,J).GE. XICE_THRESHOLD ) THEN
+                   WRITE (message_text,fmt='(a,2I5)') 'sea-ice at point, I and J = ', i,j
+                   CALL wrf_message(message_text)
+                 ICE = 1
+                 ENDIF   
+           
+          IF (ICE == 1)   Then         ! sea-ice case , eliminate sea-ice if they are not the dominant ones
+
+          IF (IVGTYP(i,j) == isice)  THEN    ! if this grid cell is dominanted by ice, then do nothing
+
+          ELSE
+
+                DO mosaic_i=2,mosaic_cat
+                   IF (mosaic_cat_index(i,mosaic_i,j) == isice ) THEN
+                       Temp4=LANDUSEF2(i,mosaic_i,j)
+                       Temp5=mosaic_cat_index(i,mosaic_i,j)
+
+                       LANDUSEF2(i,mosaic_i:NLCAT-1,j)=LANDUSEF2(i,mosaic_i+1:NLCAT,j)                       
+                       mosaic_cat_index(i,mosaic_i:NLCAT-1,j)=mosaic_cat_index(i,mosaic_i+1:NLCAT,j)
+
+                       LANDUSEF2(i,NLCAT,j)=Temp4
+                       mosaic_cat_index(i,NLCAT,j)=Temp5
+                   ENDIF 
+                 ENDDO
+
+          ENDIF   ! for (IVGTYP(i,j) == isice )
+          
+          ELSEIF (ICE ==0)  THEN
+          
+          IF ((mosaic_cat_index(I,1,J) .EQ. ISWATER)) THEN    
+          
+          ! xland < 1.5 but the dominant land use category based on our calculation is water
+	             
+           IF (IVGTYP(i,j) .EQ. ISWATER) THEN  
+           
+           ! xland < 1.5 but the dominant land use category based on the geogrid calculation is water, this must be wrong
+           
+              CALL wrf_message("IN MOSAIC_INIT")
+              WRITE(message_text,fmt='(a,3I6,2F8.2)') 'I,J,IVGTYP,XLAND,XICE = ',I,J,IVGTYP(I,J),xland(i,j),xice(i,j) 
+              CALL wrf_message(message_text)
+              CALL wrf_message("xland < 1.5 but the dominant land use category based on our calculation is water."//&
+                   "In addition, the dominant land use category based on the geogrid calculation is water, this must be wrong")
+           
+           ENDIF  ! for (IVGTYP(i,j) .EQ. ISWATER)
+           
+           IF (IVGTYP(i,j) .NE. ISWATER) THEN 
+           
+           ! xland < 1.5,   the dominant land use category based on our calculation is water, but based on the geogrid calculation is not water, which might be due to the inconsistence between land use data and land-sea mask
+           
+	       Temp4=LANDUSEF2(i,1,j)
+	       Temp5=mosaic_cat_index(i,1,j)
+	  
+	       LANDUSEF2(i,1:NLCAT-1,j)=LANDUSEF2(i,2:NLCAT,j)                       
+	       mosaic_cat_index(i,1:NLCAT-1,j)=mosaic_cat_index(i,2:NLCAT,j)
+	  
+	       LANDUSEF2(i,NLCAT,j)=Temp4
+	       mosaic_cat_index(i,NLCAT,j)=Temp5
+	             
+              CALL wrf_message("IN MOSAIC_INIT")
+              WRITE(message_text,fmt='(a,3I6,2F8.2)') 'I,J,IVGTYP,XLAND,XICE = ',I,J,IVGTYP(I,J),xland(i,j),xice(i,j) 
+              CALL wrf_message(message_text)
+              CALL wrf_message("xland < 1.5 but the dominant land use category based on our calculation is water."//&
+                   "this is fine as long as we change our calculation so that the dominant land use category is"//&
+                   "stwiched back to not water.")
+              WRITE(message_text,fmt='(a,2I6)') 'land use category has been switched, before and after values are ', &
+                   temp5,mosaic_cat_index(i,1,j)
+              CALL wrf_message(message_text)
+              WRITE(message_text,fmt='(a,2I6)') 'new dominant and second dominant cat are ', mosaic_cat_index(i,1,j),mosaic_cat_index(i,2,j)
+              CALL wrf_message(message_text)
+	             
+           ENDIF  ! for (IVGTYP(i,j) .NE. ISWATER)
+          
+           ELSE    !  for (mosaic_cat_index(I,1,J) .EQ. ISWATER)
+           
+                     DO mosaic_i=2,mosaic_cat
+	                IF (mosaic_cat_index(i,mosaic_i,j) == iswater ) THEN
+	                   Temp4=LANDUSEF2(i,mosaic_i,j)
+	                   Temp5=mosaic_cat_index(i,mosaic_i,j)
+	   
+	                   LANDUSEF2(i,mosaic_i:NLCAT-1,j)=LANDUSEF2(i,mosaic_i+1:NLCAT,j)                       
+	                   mosaic_cat_index(i,mosaic_i:NLCAT-1,j)=mosaic_cat_index(i,mosaic_i+1:NLCAT,j)
+	  
+	                   LANDUSEF2(i,NLCAT,j)=Temp4
+	                   mosaic_cat_index(i,NLCAT,j)=Temp5
+	                ENDIF 
+	              ENDDO
+             
+           ENDIF !  for (mosaic_cat_index(I,1,J) .EQ. ISWATER)
+             
+          ENDIF  !  for ICE == 1
+          
+      ELSE  ! FOR (XLAND(I,J).LT.1.5)
+      
+                 ICE = 0
+      
+                     IF( XICE(I,J).GE. XICE_THRESHOLD ) THEN
+                       WRITE (message_text,fmt='(a,2I6)') 'sea-ice at water point, I and J = ', i,j
+                       CALL wrf_message(message_text)
+                       ICE = 1
+                     ENDIF  
+      
+           IF ((mosaic_cat_index(I,1,J) .NE. ISWATER)) THEN    
+                
+                ! xland > 1.5 and the dominant land use category based on our calculation is not water
+      	             
+                 IF (IVGTYP(i,j) .NE. ISWATER) THEN  
+                 
+                 ! xland > 1.5 but the dominant land use category based on the geogrid calculation is not water, this must be wrong
+                 CALL wrf_message("IN MOSAIC_INIT")
+                 WRITE(message_text,fmt='(a,3I6,2F8.2)') 'I,J,IVGTYP,XLAND,XICE = ',I,J,IVGTYP(I,J),xland(i,j),xice(i,j)
+                 CALL wrf_message(message_text)
+                 CALL wrf_message("xland > 1.5 but the dominant land use category based on our calculation is not water."// &
+                      "in addition, the dominant land use category based on the geogrid calculation is not water,"//  &
+                      "this must be wrong.")
+                 ENDIF  ! for (IVGTYP(i,j) .NE. ISWATER)
+                 
+                 IF (IVGTYP(i,j) .EQ. ISWATER) THEN 
+                 
+                 ! xland > 1.5,   the dominant land use category based on our calculation is not water, but based on the geogrid calculation is water, which might be due to the inconsistence between land use data and land-sea mask
+
+                 CALL wrf_message("IN MOSAIC_INIT")
+                 WRITE(message_text,fmt='(a,3I6,2F8.2)') 'I,J,IVGTYP,XLAND,XICE = ',I,J,IVGTYP(I,J),xland(i,j),xice(i,j)
+                 CALL wrf_message(message_text)
+                 CALL wrf_message("xland > 1.5 but the dominant land use category based on our calculation is not water."// &
+                      "however, the dominant land use category based on the geogrid calculation is water")
+                 CALL wrf_message("This is fine. We do not need to do anyting because in the noaddrv, "//&
+                      "we use xland as a criterion for whether using"// &
+                      "mosaic or not when xland > 1.5, no mosaic will be used anyway")
+      	             
+                 ENDIF  ! for (IVGTYP(i,j) .NE. ISWATER)
+                
+           ENDIF !  for (mosaic_cat_index(I,1,J) .NE. ISWATER)
+      
+        ENDIF  ! FOR (XLAND(I,J).LT.1.5)
+
+          ENDDO
+      ENDDO
+      
+  !===========================================================================   
+  ! normalize
+  !=========================================================================== 
+
+     DO i = its,itf
+        DO j = jts,jtf
+
+          Temp6=0
+
+            DO mosaic_i=1,mosaic_cat
+               Temp6=Temp6+LANDUSEF2(i,mosaic_i,j)
+            ENDDO
+            
+            if (Temp6 .LT. 1e-5)  then
+            
+            Temp6 = 1e-5
+            WRITE (message_text,fmt='(a,e8.1)') 'the total land surface fraction is less than ', temp6
+            CALL wrf_message(message_text)
+            WRITE (message_text,fmt='(a,2I6,4F8.2)') 'some landusef values at i,j are ', &
+                 i,j,landusef2(i,1,j),landusef2(i,2,j),landusef2(i,3,j),landusef2(i,4,j)
+            CALL wrf_message(message_text)
+            WRITE (message_text,fmt='(a,2I6,3I6)') 'some mosaic cat values at i,j are ', &
+                 i,j,mosaic_cat_index(i,1,j),mosaic_cat_index(i,2,j),mosaic_cat_index(i,3,j) 
+            CALL wrf_message(message_text)
+            
+            endif
+
+            LANDUSEF2(i,1:mosaic_cat, j)=LANDUSEF2(i,1:mosaic_cat,j)*(1/Temp6)
+
+          ENDDO
+      ENDDO
+      
+  !===========================================================================   
+  ! initilize the variables
+  !===========================================================================   
+
+     DO i = its,itf
+        DO j = jts,jtf
+    
+             DO mosaic_i=1,mosaic_cat
+        
+            TSK_mosaic(i,mosaic_i,j)=TSK(i,j)          
+            CANWAT_mosaic(i,mosaic_i,j)=CANWAT(i,j) 
+            SNOW_mosaic(i,mosaic_i,j)=SNOW(i,j) 
+            SNOWH_mosaic(i,mosaic_i,j)=SNOWH(i,j)  
+            SNOWC_mosaic(i,mosaic_i,j)=SNOWC(i,j) 
+
+            ALBEDO_mosaic(i,mosaic_i,j)=ALBEDO(i,j)
+            ALBBCK_mosaic(i,mosaic_i,j)=ALBBCK(i,j)
+            EMISS_mosaic(i,mosaic_i,j)=EMISS(i,j) 
+            EMBCK_mosaic(i,mosaic_i,j)=EMBCK(i,j) 
+            ZNT_mosaic(i,mosaic_i,j)=Z0(i,j)
+            Z0_mosaic(i,mosaic_i,j)=Z0(i,j)
+  
+              DO soil_k=1,num_soil_layers 
+  
+            TSLB_mosaic(i,num_soil_layers*(mosaic_i-1)+soil_k,j)=TSLB(i,soil_k,j)
+            SMOIS_mosaic(i,num_soil_layers*(mosaic_i-1)+soil_k,j)=SMOIS(i,soil_k,j)
+            SH2O_mosaic(i,num_soil_layers*(mosaic_i-1)+soil_k,j)=SH2O(i,soil_k,j)  
+          
+              ENDDO
+           
+           TR_URB2D_mosaic(i,mosaic_i,j)=TSK(i,j)   
+           TB_URB2D_mosaic(i,mosaic_i,j)=TSK(i,j)   
+           TG_URB2D_mosaic(i,mosaic_i,j)=TSK(i,j)   
+           TC_URB2D_mosaic(i,mosaic_i,j)=TSK(i,j)   
+           TS_URB2D_mosaic(i,mosaic_i,j)=TSK(i,j)   
+           TS_RUL2D_mosaic(i,mosaic_i,j)=TSK(i,j)   
+           QC_URB2D_mosaic(i,mosaic_i,j)=0.01
+           SH_URB2D_mosaic(i,mosaic_i,j)=0
+           LH_URB2D_mosaic(i,mosaic_i,j)=0
+           G_URB2D_mosaic(i,mosaic_i,j)=0
+           RN_URB2D_mosaic(i,mosaic_i,j)=0
+          
+          TRL_URB3D_mosaic(I,4*(mosaic_i-1)+1,J)=TSLB(I,1,J)+0.
+          TRL_URB3D_mosaic(I,4*(mosaic_i-1)+2,J)=0.5*(TSLB(I,1,J)+TSLB(I,2,J))
+          TRL_URB3D_mosaic(I,4*(mosaic_i-1)+3,J)=TSLB(I,2,J)+0.
+          TRL_URB3D_mosaic(I,4*(mosaic_i-1)+4,J)=TSLB(I,2,J)+(TSLB(I,3,J)-TSLB(I,2,J))*0.29
+
+          TBL_URB3D_mosaic(I,4*(mosaic_i-1)+1,J)=TSLB(I,1,J)+0.
+          TBL_URB3D_mosaic(I,4*(mosaic_i-1)+2,J)=0.5*(TSLB(I,1,J)+TSLB(I,2,J))
+          TBL_URB3D_mosaic(I,4*(mosaic_i-1)+3,J)=TSLB(I,2,J)+0.
+          TBL_URB3D_mosaic(I,4*(mosaic_i-1)+4,J)=TSLB(I,2,J)+(TSLB(I,3,J)-TSLB(I,2,J))*0.29           
+                    
+          TGL_URB3D_mosaic(I,4*(mosaic_i-1)+1,J)=TSLB(I,1,J)
+          TGL_URB3D_mosaic(I,4*(mosaic_i-1)+2,J)=TSLB(I,2,J)
+          TGL_URB3D_mosaic(I,4*(mosaic_i-1)+3,J)=TSLB(I,3,J)
+          TGL_URB3D_mosaic(I,4*(mosaic_i-1)+4,J)=TSLB(I,4,J)
+           
+            ENDDO
+          ENDDO
+      ENDDO
+
+   ! simple test
+   
+       DO i = its,itf
+        DO j = jts,jtf 
+   
+           IF ((xland(i,j).LT. 1.5 ) .AND. (mosaic_cat_index(I,1,J) .EQ. ISWATER)) THEN
+             CALL wrf_message("After MOSAIC_INIT")
+             WRITE (message_text,fmt='(a,2I6,2F8.2,2I6)') 'weird xland,xice,mosaic_cat_index and ivgtyp at I,J = ', &
+                i,j,xland(i,j),xice(i,j),mosaic_cat_index(I,1,J),IVGTYP(i,j)
+             CALL wrf_message(message_text)
+           ENDIF
+           
+        ENDDO
+      ENDDO
+      
+ ENDIF      !  for not restart
+      
+!--------------------------------      
+  END SUBROUTINE lsm_mosaic_init  
+!--------------------------------  
 #endif
 
 END MODULE module_sf_noahdrv
diff --git a/src/core_atmosphere/physics/physics_wrf/module_sf_noahlsm.F b/src/core_atmosphere/physics/physics_wrf/module_sf_noahlsm.F
index a854f41f88..5350a8e2c4 100644
--- a/src/core_atmosphere/physics/physics_wrf/module_sf_noahlsm.F
+++ b/src/core_atmosphere/physics/physics_wrf/module_sf_noahlsm.F
@@ -1,16 +1,24 @@
 MODULE module_sf_noahlsm
-
 #if defined(mpas)
-!MPAS specific (Laura D. Fowler):
-use mpas_atmphys_constants, rhowater => rho_w
-use mpas_atmphys_utilities,only: physics_error_fatal
+use mpas_atmphys_constants,only: CP=>cp,R_D=>R_d,XLF=>xlf,XLV=>xlv,RHOWATER=>rho_w,STBOLT=>stbolt,KARMAN=>karman
+use mpas_atmphys_utilities, only: physics_error_fatal
 #define FATAL_ERROR(M) call physics_error_fatal( M )
 #else
-USE module_model_constants
-#define FATAL_ERROR(M) write(0,*) M ; stop
+USE module_model_constants, only : CP, R_D, XLF, XLV, RHOWATER, STBOLT, KARMAN
+use module_wrf_error
+#define FATAL_ERROR(M) call wrf_error_fatal( M )
 #endif
-!MPAS specific end.
 
+!ckay=KIRAN ALAPATY @ US EPA -- November 01, 2015
+!
+! Tim Glotfelty@CNSU; AJ Deng@PSU
+!modified for use with FASDAS 
+!Flux Adjusting Surface Data Assimilation System to assimilate 
+!surface layer and soil layers temperature and moisture using
+! surfance reanalsys 
+!Reference: Alapaty et al., 2008: Development of the flux-adjusting surface
+! data assimilation system for mesoscale models. JAMC, 47, 2331-2350
+!
 
 !   REAL, PARAMETER    :: CP = 1004.5
   REAL, PARAMETER      :: RD = 287.04, SIGMA = 5.67E-8,                 &
@@ -21,6 +29,7 @@ MODULE module_sf_noahlsm
 ! VEGETATION PARAMETERS
         INTEGER :: LUCATS , BARE
         INTEGER :: NATURAL
+        INTEGER :: LOW_DENSITY_RESIDENTIAL, HIGH_DENSITY_RESIDENTIAL, HIGH_INTENSITY_INDUSTRIAL
         integer, PARAMETER :: NLUS=50
         CHARACTER(LEN=256) LUTYPE
         INTEGER, DIMENSION(1:NLUS) :: NROTBL
@@ -29,7 +38,8 @@ MODULE module_sf_noahlsm
                                     EMISSMINTBL, EMISSMAXTBL,                     &
                                     LAIMINTBL, LAIMAXTBL,                         &
                                     Z0MINTBL, Z0MAXTBL,                           &
-                                    ALBEDOMINTBL, ALBEDOMAXTBL
+                                    ALBEDOMINTBL, ALBEDOMAXTBL,                   &
+                                    ZTOPVTBL,ZBOTVTBL
         REAL ::   TOPT_DATA,CMCMAX_DATA,CFACTR_DATA,RSMAX_DATA
 
 ! SOIL PARAMETERS
@@ -50,11 +60,13 @@ MODULE module_sf_noahlsm
 
         CHARACTER*256  :: err_message
 
+        integer, private :: iloc, jloc
+!$omp threadprivate(iloc, jloc)
 !
 CONTAINS
 !
 
-      SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
+      SUBROUTINE SFLX (IILOC,JJLOC,FFROZP,ISURBAN,DT,ZLVL,NSOIL,SLDPTH, &    !C
                        LOCAL,                                           &    !L
                        LLANDUSE, LSOIL,                                 &    !CL
                        LWDN,SOLDN,SOLNET,SFCPRS,PRCP,SFCTMP,Q2,SFCSPD,  &    !F
@@ -72,6 +84,7 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
                        EC,EDIR,ET,ETT,ESNOW,DRIP,DEW,                   &    !O
                        BETA,ETP,SSOIL,                                  &    !O
                        FLX1,FLX2,FLX3,                                  &    !O
+		       FLX4,FVB,FBUR,FGSN,UA_PHYS,                      &    !UA 
                        SNOMLT,SNCOVR,                                   &    !O
                        RUNOFF1,RUNOFF2,RUNOFF3,                         &    !O
                        RC,PC,RSMIN,XLAI,RCS,RCT,RCQ,RCSOIL,             &    !O
@@ -79,7 +92,12 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
                        RDLAI2D,USEMONALB,                               &
                        SNOTIME1,                                        &
                        RIBB,                                            &
-                       SMCWLT,SMCDRY,SMCREF,SMCMAX,NROOT)                    !P
+                       SMCWLT,SMCDRY,SMCREF,SMCMAX,NROOT,   &
+                       SFHEAD1RT,                                       &    !I
+                       INFXS1RT,ETPND1,OPT_THCND,AOASIS                 &    !P
+                      ,XSDA_QFX,HFX_PHY,QFX_PHY,XQNORM                  &    !fasdas
+                      ,fasdas,HCPCT_FASDAS                              )    !fasdas
+
 ! ----------------------------------------------------------------------
 ! SUBROUTINE SFLX - UNIFIED NOAHLSM VERSION 1.0 JULY 2007
 ! ----------------------------------------------------------------------
@@ -106,7 +124,6 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
 ! ----------------------------------------------------------------------
 ! 1. CONFIGURATION INFORMATION (C):
 ! ----------------------------------------------------------------------
-!   ICE        SEA-ICE FLAG  (=1: SEA-ICE, =0: LAND (NO ICE), --1 LAND-ICE).
 !   DT         TIMESTEP (SEC) (DT SHOULD NOT EXCEED 3600 SECS, RECOMMEND
 !                1800 SECS OR LESS)
 !   ZLVL       HEIGHT (M) ABOVE GROUND OF ATMOSPHERIC FORCING VARIABLES
@@ -124,6 +141,7 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
 !                    roughness length) will be defined by three tables
 !   LLANDUSE  (=USGS, using USGS landuse classification)
 !   LSOIL     (=STAS, using FAO/STATSGO soil texture classification)
+!   OPT_THCND option for how to treat thermal conductivity
 ! ----------------------------------------------------------------------
 ! 3. FORCING DATA (F):
 ! ----------------------------------------------------------------------
@@ -203,7 +221,7 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
 !   ETA        ACTUAL LATENT HEAT FLUX (W m-2: NEGATIVE, IF UP FROM
 !              SURFACE)
 !  ETA_KINEMATIC atctual latent heat flux in Kg m-2 s-1
-!   SHEAT      SENSIBLE HEAT FLUX (W M-2: NEGATIVE, IF UPWARD FROM
+!   SHEAT      SENSIBLE HEAT FLUX (W M-2: POSITIVE, IF UPWARD FROM
 !              SURFACE)
 !   FDOWN      Radiation forcing at the surface (W m-2) = SOLDN*(1-alb)+LWDN
 ! ----------------------------------------------------------------------
@@ -253,7 +271,7 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
 !   SOILM      TOTAL SOIL COLUMN MOISTURE CONTENT (FROZEN+UNFROZEN) (M)
 !   Q1         Effective mixing ratio at surface (kg kg-1), used for
 !              diagnosing the mixing ratio at 2 meter for coupled model
-!   SMAV       Soil Moisture Availability for each layer, as a fraction 
+!   SMAV       Soil Moisture Availability for each layer, as a fraction
 !              between SMCWLT and SMCMAX.
 !  Documentation for SNOTIME1 and SNOABL2 ?????
 !  What categories of arguments do these variables fall into ????
@@ -279,6 +297,8 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
 
 ! DECLARATIONS - LOGICAL AND CHARACTERS
 ! ----------------------------------------------------------------------
+
+      INTEGER, INTENT(IN) :: IILOC, JJLOC
       LOGICAL, INTENT(IN)::  LOCAL
       LOGICAL            ::  FRZGRA, SNOWNG
       CHARACTER (LEN=256), INTENT(IN)::  LLANDUSE, LSOIL
@@ -286,9 +306,9 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
 ! ----------------------------------------------------------------------
 ! 1. CONFIGURATION INFORMATION (C):
 ! ----------------------------------------------------------------------
-      INTEGER,INTENT(IN) ::  ICE,NSOIL,SLOPETYP,SOILTYP,VEGTYP
+      INTEGER,INTENT(IN) ::  NSOIL,SLOPETYP,SOILTYP,VEGTYP
       INTEGER, INTENT(IN) :: ISURBAN
-      INTEGER,INTENT(INOUT)::  NROOT
+      INTEGER,INTENT(OUT)::  NROOT
       INTEGER  KZ, K, iout
 
 ! ----------------------------------------------------------------------
@@ -296,29 +316,44 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
 ! ----------------------------------------------------------------------
       LOGICAL, INTENT(IN) :: RDLAI2D
       LOGICAL, INTENT(IN) :: USEMONALB
+      INTEGER, INTENT(IN) :: OPT_THCND
+
+      REAL, INTENT(INOUT):: SFHEAD1RT,INFXS1RT, ETPND1
 
       REAL, INTENT(IN)   :: SHDMIN,SHDMAX,DT,DQSDT2,LWDN,PRCP,PRCPRAIN,     &
                             Q2,Q2SAT,SFCPRS,SFCSPD,SFCTMP, SNOALB,          &
-                            SOLDN,SOLNET,TBOT,TH2,ZLVL,                            &
-                            FFROZP
-      REAL, INTENT(INOUT)  :: EMBRD
-      REAL, INTENT(INOUT)  :: ALBEDO
+                            SOLDN,SOLNET,TBOT,TH2,ZLVL,                     &
+                            FFROZP,AOASIS
+      REAL, INTENT(OUT)  :: EMBRD
+      REAL, INTENT(OUT)  :: ALBEDO
       REAL, INTENT(INOUT):: COSZ, SOLARDIRECT,CH,CM,                        &
                             CMC,SNEQV,SNCOVR,SNOWH,T1,XLAI,SHDFAC,Z0BRD,    &
                             EMISSI, ALB
       REAL, INTENT(INOUT):: SNOTIME1
       REAL, INTENT(INOUT):: RIBB
       REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SLDPTH
-      REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: ET
-      REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: SMAV
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT):: ET
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT):: SMAV
       REAL, DIMENSION(1:NSOIL), INTENT(INOUT) ::  SH2O, SMC, STC
       REAL,DIMENSION(1:NSOIL)::   RTDIS, ZSOIL
 
-      REAL,INTENT(INOUT)   :: ETA_KINEMATIC,BETA,DEW,DRIP,EC,EDIR,ESNOW,ETA,  &
+      REAL,INTENT(OUT)   :: ETA_KINEMATIC,BETA,DEW,DRIP,EC,EDIR,ESNOW,ETA,  &
                             ETP,FLX1,FLX2,FLX3,SHEAT,PC,RUNOFF1,RUNOFF2,    &
                             RUNOFF3,RC,RSMIN,RCQ,RCS,RCSOIL,RCT,SSOIL,      &
                             SMCDRY,SMCMAX,SMCREF,SMCWLT,SNOMLT, SOILM,      &
                             SOILW,FDOWN,Q1
+      LOGICAL, INTENT(IN) :: UA_PHYS   ! UA: flag for UA option
+      REAL,INTENT(OUT)    :: FLX4      ! UA: energy added to sensible heat
+      REAL,INTENT(OUT)    :: FVB       ! UA: frac. veg. w/snow beneath
+      REAL,INTENT(OUT)    :: FBUR      ! UA: fraction of canopy buried
+      REAL,INTENT(OUT)    :: FGSN      ! UA: ground snow cover fraction
+      REAL                :: ZTOPV     ! UA: height of canopy top
+      REAL                :: ZBOTV     ! UA: height of canopy bottom
+      REAL                :: GAMA      ! UA: = EXP(-1.* XLAI)
+      REAL                :: FNET      ! UA:
+      REAL                :: ETPN      ! UA:
+      REAL                :: RU        ! UA:
+
       REAL :: BEXP,CFACTR,CMCMAX,CSOIL,CZIL,DF1,DF1H,DF1A,DKSAT,DWSAT,      &
               DSOIL,DTOT,ETT,FRCSNO,FRCSOI,EPSCA,F1,FXEXP,FRZX,HS,          &
               KDT,LVH2O,PRCP1,PSISAT,QUARTZ,R,RCH,REFKDT,RR,RGL,            &
@@ -340,39 +375,44 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
       PARAMETER (LVH2O = 2.501E+6)
       PARAMETER (LSUBS = 2.83E+6)
       PARAMETER (R = 287.04)
+!
+!  FASDAS
+!
+   INTEGER, INTENT(IN   )  ::  fasdas
+   REAL,    INTENT(INOUT)  ::  XSDA_QFX, XQNORM
+   REAL,    INTENT(INOUT)  ::  HFX_PHY, QFX_PHY
+   REAL,    INTENT(  OUT)  ::  HCPCT_FASDAS
+!
+!  END FASDAS
+!
 ! ----------------------------------------------------------------------
 !   INITIALIZATION
 ! ----------------------------------------------------------------------
-         RUNOFF1 = 0.0
-         RUNOFF2 = 0.0
-         RUNOFF3 = 0.0
-         SNOMLT = 0.0
+      ILOC = IILOC
+      JLOC = JJLOC
 
-! ----------------------------------------------------------------------
-!  THE VARIABLE "ICE" IS A FLAG DENOTING SEA-ICE / LAND-ICE / ICE-FREE LAND
-!     SEA-ICE CASE,          ICE =  1
-!     NON-GLACIAL LAND,      ICE =  0
-!     GLACIAL-ICE LAND,      ICE = -1
-      IF (ICE /= 0) SHDFAC = 0.0
-! ----------------------------------------------------------------------
-! SEA-ICE LAYERS ARE EQUAL THICKNESS AND SUM TO 3 METERS
-! ----------------------------------------------------------------------
-         IF (ICE == 1) THEN
-            DO KZ = 1,NSOIL
-               ZSOIL (KZ) = -3.* FLOAT (KZ)/ FLOAT (NSOIL)
-            END DO
+      RUNOFF1 = 0.0
+      RUNOFF2 = 0.0
+      RUNOFF3 = 0.0
+      SNOMLT = 0.0
+
+      IF ( .NOT. UA_PHYS ) THEN
+          FLX4 = 0.0
+          FVB  = 0.0
+          FBUR = 0.0
+          FGSN = 0.0
+      ENDIF
 
 ! ----------------------------------------------------------------------
 ! CALCULATE DEPTH (NEGATIVE) BELOW GROUND FROM TOP SKIN SFC TO BOTTOM OF
 !   EACH SOIL LAYER.  NOTE:  SIGN OF ZSOIL IS NEGATIVE (DENOTING BELOW
 !   GROUND)
 ! ----------------------------------------------------------------------
-         ELSE
-            ZSOIL (1) = - SLDPTH (1)
-            DO KZ = 2,NSOIL
-               ZSOIL (KZ) = - SLDPTH (KZ) + ZSOIL (KZ -1)
-            END DO
-         END IF
+      ZSOIL (1) = - SLDPTH (1)
+      DO KZ = 2,NSOIL
+         ZSOIL (KZ) = - SLDPTH (KZ) + ZSOIL (KZ -1)
+      END DO
+
 ! ----------------------------------------------------------------------
 ! NEXT IS CRUCIAL CALL TO SET THE LAND-SURFACE PARAMETERS, INCLUDING
 ! SOIL-TYPE AND VEG-TYPE DEPENDENT PARAMETERS.
@@ -384,7 +424,7 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
                          RTDIS,SLDPTH,ZSOIL,NROOT,NSOIL,CZIL,              &
                          LAIMIN, LAIMAX, EMISSMIN, EMISSMAX, ALBEDOMIN,    &
                          ALBEDOMAX, Z0MIN, Z0MAX, CSOIL, PTU, LLANDUSE,    &
-                         LSOIL,LOCAL,LVCOEF)
+                         LSOIL,LOCAL,LVCOEF,ZTOPV,ZBOTV)
 
 !urban
          IF(VEGTYP==ISURBAN)THEN
@@ -453,35 +493,6 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
          FRZGRA = .FALSE.
 
 ! ----------------------------------------------------------------------
-! OVER SEA-ICE OR GLACIAL-ICE, IF S.W.E. (SNEQV) BELOW THRESHOLD LOWER
-! BOUND (0.01 M FOR SEA-ICE, 0.10 M FOR GLACIAL-ICE), THEN SET AT LOWER
-! BOUND
-! ----------------------------------------------------------------------
-! IF SEA-ICE CASE, ASSIGN DEFAULT WATER-EQUIV SNOW ON TOP
-! ----------------------------------------------------------------------
-         IF (ICE == 1) THEN
-            ! Sea-ice case
-            IF ( SNEQV < 0.01 ) THEN
-               SNEQV = 0.01
-               SNOWH = 0.05
-            ENDIF
-         ELSE IF ( ICE == -1 ) THEN
-            ! Land-ice case
-            IF ( SNEQV < 0.10 ) THEN
-               SNEQV = 0.10
-               SNOWH = 0.50
-            ENDIF
-         END IF
-! ----------------------------------------------------------------------
-! FOR SEA-ICE AND GLACIAL-ICE CASES, SET SMC AND SH20 VALUES = 1.0
-! ----------------------------------------------------------------------
-         IF ( ICE /= 0 ) THEN
-            DO KZ = 1,NSOIL
-               SMC(KZ) = 1.0
-               SH2O(KZ) = 1.0
-            END DO
-         ENDIF
-! ----------------------------------------------------------------------
 ! IF INPUT SNOWPACK IS NONZERO, THEN COMPUTE SNOW DENSITY "SNDENS" AND
 !   SNOW THERMAL CONDUCTIVITY "SNCOND" (NOTE THAT CSNOW IS A FUNCTION
 !   SUBROUTINE)
@@ -530,16 +541,6 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
 ! UPDATE SNOW THERMAL CONDUCTIVITY
 ! ----------------------------------------------------------------------
             CALL SNOW_NEW (SFCTMP,SN_NEW,SNOWH,SNDENS)
-!
-! kmh 09/04/2006 set Snow Density at 0.2 g/cm**3
-! for "cold permanent ice" or new "dry" snow
-!
-           IF ( (ICE /= 0) .and. SNCOVR .GT. 0.99 ) THEN
-!  if soil temperature less than 268.15 K, treat as typical Antarctic/Greenland snow firn
-              IF ( STC(1) .LT. (TFREEZ - 5.) ) SNDENS = 0.2
-              IF ( SNOWNG .AND. (T1.LT.273.) .AND. (SFCTMP.LT.273.) ) SNDENS=0.2
-           ENDIF
-!
             CALL CSNOW (SNCOND,SNDENS)
 
 ! ----------------------------------------------------------------------
@@ -549,62 +550,43 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
 ! ----------------------------------------------------------------------
          ELSE
             PRCPF = PRCP
-         END IF
+         ENDIF
 ! ----------------------------------------------------------------------
 ! DETERMINE SNOWCOVER AND ALBEDO OVER LAND.
 ! ----------------------------------------------------------------------
 ! ----------------------------------------------------------------------
 ! IF SNOW DEPTH=0, SET SNOW FRACTION=0, ALBEDO=SNOW FREE ALBEDO.
 ! ----------------------------------------------------------------------
-         IF (ICE == 0 .OR. ICE == -1) THEN
-            IF (SNEQV  == 0.0) THEN
-               SNCOVR = 0.0
-               ALBEDO = ALB
-               EMISSI = EMBRD
-            ELSE
+         IF (SNEQV  == 0.0) THEN
+            SNCOVR = 0.0
+            ALBEDO = ALB
+            EMISSI = EMBRD
+	    IF(UA_PHYS) FGSN = 0.0
+	    IF(UA_PHYS) FVB = 0.0
+	    IF(UA_PHYS) FBUR = 0.0
+         ELSE
 ! ----------------------------------------------------------------------
 ! DETERMINE SNOW FRACTIONAL COVERAGE.
 ! DETERMINE SURFACE ALBEDO MODIFICATION DUE TO SNOWDEPTH STATE.
 ! ----------------------------------------------------------------------
-              CALL SNFRAC (SNEQV,SNUP,SALP,SNOWH,SNCOVR)
-!   Don't limit snow cover fraction over permanent ice kmh 2008/03/25
-            if ( ICE == 0 ) then
-              SNCOVR = MIN(SNCOVR,0.98)
-            endif
-              CALL ALCALC (ALB,SNOALB,EMBRD,SHDFAC,SHDMIN,SNCOVR,T1,ALBEDO,EMISSI,   &
-                         DT,SNOWNG,SNOTIME1,LVCOEF)
-            END IF
-! ----------------------------------------------------------------------
-! SNOW COVER, ALBEDO OVER SEA-ICE, GLACIAL ICE
-! ----------------------------------------------------------------------
-         ELSE
-            SNCOVR = 1.0
-!
-! Albedo of sea ice
-!
-! This value should vary seasonally. 0.65 may be good for Arctic Ocean summer bare ice
-!   value could be as low as 0.4 for Arctic bare ice and melt pond combo (Perovich data)
-!   0.82 may be good for Arctic spring/fall sea ice (Perovich data)
-!   0.81 may be good for Antarctic sea ice (Wendler et al. December cruise data)
-!
-            ALBEDO = 0.80
-!
-            EMISSI = 0.98
-         END IF
-! ----------------------------------------------------------------------
-! THERMAL CONDUCTIVITY FOR SEA-ICE CASE, GLACIAL-ICE CASE
-! ----------------------------------------------------------------------
-         IF ( (ICE == 1) .or. (ICE == -1) ) THEN
-            DF1 = 2.2
-!
-! kmh 09/03/2006
-! kmh 03/25/2008  change SNCOVR threshold to 0.97
-!
-            IF (  SNCOVR .GT. 0.97 ) THEN
-               DF1 = SNCOND
+            CALL SNFRAC (SNEQV,SNUP,SALP,SNOWH,SNCOVR, &
+                         XLAI,SHDFAC,FVB,GAMA,FBUR,    &
+                         FGSN,ZTOPV,ZBOTV,UA_PHYS)
+
+            IF ( UA_PHYS ) then
+              IF(SFCTMP <= T1) THEN
+                RU = 0.
+              ELSE
+                RU = 100.*SHDFAC*FGSN*MIN((SFCTMP-T1)/5., 1.)*(1.-EXP(-XLAI))
+              ENDIF
+              CH = CH/(1.+RU*CH)
             ENDIF
-!
-         ELSE
+
+            SNCOVR = MIN(SNCOVR,0.98) 
+
+            CALL ALCALC (ALB,SNOALB,EMBRD,SHDFAC,SHDMIN,SNCOVR,T1, &
+                 ALBEDO,EMISSI,DT,SNOWNG,SNOTIME1,LVCOEF)
+         ENDIF
 ! ----------------------------------------------------------------------
 ! NEXT CALCULATE THE SUBSURFACE HEAT FLUX, WHICH FIRST REQUIRES
 ! CALCULATION OF THE THERMAL DIFFUSIVITY.  TREATMENT OF THE
@@ -629,7 +611,7 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
 ! OVERLYING GREEN CANOPY, ADAPTED FROM SECTION 2.1.2 OF
 ! PETERS-LIDARD ET AL. (1997, JGR, VOL 102(D4))
 ! ----------------------------------------------------------------------
-            CALL TDFCND (DF1,SMC (1),QUARTZ,SMCMAX,SH2O (1))
+            CALL TDFCND (DF1,SMC (1),QUARTZ,SMCMAX,SH2O (1),BEXP, PSISAT, SOILTYP, OPT_THCND)
 
 !urban
             IF ( VEGTYP == ISURBAN ) DF1=3.24
@@ -648,7 +630,6 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
 ! V.J. LINARDINI REFERENCE CITED ABOVE. NOTE THAT DTOT IS
 ! COMBINED DEPTH OF SNOWDEPTH AND THICKNESS OF FIRST SOIL LAYER
 ! ----------------------------------------------------------------------
-         END IF
 
          DSOIL = - (0.5 * ZSOIL (1))
          IF (SNEQV == 0.) THEN
@@ -677,13 +658,6 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
 ! MID-LAYER SOIL TEMPERATURE
 ! ----------------------------------------------------------------------
             DF1 = DF1A * SNCOVR + DF1* (1.0- SNCOVR)
-            IF ( ICE /= 0 ) then
-               !  kmh  12/15/2005  correct for too deep snow layer
-               !  kmh  09/03/2006  adjust DTOT
-               IF ( DTOT .GT. 2.*DSOIL ) then
-                  DTOT = 2.*DSOIL
-               ENDIF
-            ENDIF
             SSOIL = DF1 * (T1- STC (1) ) / DTOT
          END IF
 ! ----------------------------------------------------------------------
@@ -691,9 +665,11 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
 ! THE PREVIOUS TIMESTEP.
 ! ----------------------------------------------------------------------
          IF (SNCOVR  > 0. ) THEN
-            CALL SNOWZ0 (SNCOVR,Z0,Z0BRD,SNOWH)
+            CALL SNOWZ0 (SNCOVR,Z0,Z0BRD,SNOWH,FBUR,FGSN,SHDMAX,UA_PHYS)
          ELSE
             Z0=Z0BRD
+            IF(UA_PHYS) CALL SNOWZ0 (SNCOVR,Z0,Z0BRD,SNOWH,FBUR,FGSN, &
+	                             SHDMAX,UA_PHYS)
          END IF
 ! ----------------------------------------------------------------------
 ! NEXT CALL ROUTINE SFCDIF TO CALCULATE THE SFC EXCHANGE COEF (CH) FOR
@@ -755,10 +731,8 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
 
          CALL PENMAN (SFCTMP,SFCPRS,CH,T2V,TH2,PRCP,FDOWN,T24,SSOIL,     &
                        Q2,Q2SAT,ETP,RCH,EPSCA,RR,SNOWNG,FRZGRA,          &
-!
-! kmh 01/09/2007 add T1,ICE,SNCOVR to call
-!
-                         DQSDT2,FLX2,EMISSI,SNEQV,T1,ICE,SNCOVR)
+                       DQSDT2,FLX2,EMISSI,SNEQV,T1,SNCOVR,AOASIS,        &
+		       ALBEDO,SOLDN,FVB,GAMA,STC(1),ETPN,FLX4,UA_PHYS)
 !
 ! ----------------------------------------------------------------------
 ! CALL CANRES TO CALCULATE THE CANOPY RESISTANCE AND CONVERT IT INTO PC
@@ -769,7 +743,7 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
 !  FROZEN GROUND EXTENSION: TOTAL SOIL WATER "SMC" WAS REPLACED
 !  BY UNFROZEN SOIL WATER "SH2O" IN CALL TO CANRES BELOW
 ! ----------------------------------------------------------------------
-         IF (SHDFAC > 0.) THEN
+         IF ( (SHDFAC > 0.) .AND. (XLAI > 0.) ) THEN
             CALL CANRES (SOLDN,CH,SFCTMP,Q2,SFCPRS,SH2O,ZSOIL,NSOIL,     &
                           SMCWLT,SMCREF,RSMIN,RC,PC,NROOT,Q2SAT,DQSDT2,  &
                           TOPT,RSMAX,RGL,HS,XLAI,                        &
@@ -791,9 +765,11 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
                             STC,EPSCA,BEXP,PC,RCH,RR,CFACTR,             &
                             SH2O,SLOPE,KDT,FRZX,PSISAT,ZSOIL,            &
                             DKSAT,DWSAT,TBOT,ZBOT,RUNOFF1,RUNOFF2,       &
-                            RUNOFF3,EDIR,EC,ET,ETT,NROOT,ICE,RTDIS,      &
+                            RUNOFF3,EDIR,EC,ET,ETT,NROOT,RTDIS,          &
                             QUARTZ,FXEXP,CSOIL,                          &
-                            BETA,DRIP,DEW,FLX1,FLX3,VEGTYP,ISURBAN)
+                            BETA,DRIP,DEW,FLX1,FLX3,VEGTYP,ISURBAN,      &
+                            SFHEAD1RT,INFXS1RT,ETPND1,SOILTYP,OPT_THCND  &
+                           ,XSDA_QFX,QFX_PHY,XQNORM,fasdas,HCPCT_FASDAS  ) !fasdas
             ETA_KINEMATIC = ETA
          ELSE
             CALL SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT,    &
@@ -804,12 +780,15 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
                          SNOWH,SH2O,SLOPE,KDT,FRZX,PSISAT,               &
                          ZSOIL,DWSAT,DKSAT,TBOT,ZBOT,SHDFAC,RUNOFF1,     &
                          RUNOFF2,RUNOFF3,EDIR,EC,ET,ETT,NROOT,SNOMLT,    &
-                         ICE,RTDIS,QUARTZ,FXEXP,CSOIL,                   &
+                         RTDIS,QUARTZ,FXEXP,CSOIL,                       &
                          BETA,DRIP,DEW,FLX1,FLX2,FLX3,ESNOW,ETNS,EMISSI, &
                          RIBB,SOLDN,                                     &
                          ISURBAN,                                        &
-                         VEGTYP)
-            ETA_KINEMATIC =  ESNOW + ETNS
+                         VEGTYP,                                         &
+                         ETPN,FLX4,UA_PHYS,                              &
+                         SFHEAD1RT,INFXS1RT,ETPND1,SOILTYP,OPT_THCND     &
+                        ,QFX_PHY,fasdas,HCPCT_FASDAS                     ) !fasdas
+            ETA_KINEMATIC =  ESNOW + ETNS - 1000.0*DEW
          END IF
 
 !     Calculate effective mixing ratio at grnd level (skin)
@@ -820,8 +799,18 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
 ! ----------------------------------------------------------------------
 ! DETERMINE SENSIBLE HEAT (H) IN ENERGY UNITS (W M-2)
 ! ----------------------------------------------------------------------
-         SHEAT = - (CH * CP * SFCPRS)/ (R * T2V) * ( TH2- T1 )
 
+         SHEAT = - (CH * CP * SFCPRS)/ (R * T2V) * ( TH2- T1 )
+         IF(UA_PHYS) SHEAT = SHEAT + FLX4   
+!
+! FASDAS
+!
+      IF ( fasdas == 1 ) THEN
+        HFX_PHY = SHEAT
+      ENDIF
+!
+! END FASDAS
+!
 ! ----------------------------------------------------------------------
 ! CONVERT EVAP TERMS FROM KINEMATIC (KG M-2 S-1) TO ENERGY UNITS (W M-2)
 ! ----------------------------------------------------------------------
@@ -831,8 +820,12 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
       ET(K) = ET(K) * LVH2O
       ENDDO
       ETT = ETT * LVH2O
+      
+      ETPND1=ETPND1 * LVH2O
+
       ESNOW = ESNOW * LSUBS
       ETP = ETP*((1.-SNCOVR)*LVH2O + SNCOVR*LSUBS)
+      IF(UA_PHYS) ETPN = ETPN*((1.-SNCOVR)*LVH2O + SNCOVR*LSUBS)
       IF (ETP .GT. 0.) THEN
          ETA = EDIR + EC + ETT + ESNOW
       ELSE
@@ -855,52 +848,36 @@ SUBROUTINE SFLX (FFROZP,ICE,ISURBAN,DT,ZLVL,NSOIL,SLDPTH,         &    !C
          SSOIL = -1.0* SSOIL
 
 ! ----------------------------------------------------------------------
-!  FOR THE CASE OF LAND (BUT NOT GLACIAL-ICE):
+!  FOR THE CASE OF LAND:
 !  CONVERT RUNOFF3 (INTERNAL LAYER RUNOFF FROM SUPERSAT) FROM M TO M S-1
 !  AND ADD TO SUBSURFACE RUNOFF/DRAINAGE/BASEFLOW.  RUNOFF2 IS ALREADY
 !  A RATE AT THIS POINT
 ! ----------------------------------------------------------------------
-         IF (ICE == 0) THEN
-            RUNOFF3 = RUNOFF3/ DT
-            RUNOFF2 = RUNOFF2+ RUNOFF3
-            SOILM = -1.0* SMC (1)* ZSOIL (1)
-            DO K = 2,NSOIL
-              SOILM = SOILM + SMC (K)* (ZSOIL (K -1) - ZSOIL (K))
-            END DO
-            SOILWM = -1.0* (SMCMAX - SMCWLT)* ZSOIL (1)
-            SOILWW = -1.0* (SMC (1) - SMCWLT)* ZSOIL (1)
-!
-            DO K = 1,NSOIL
-               SMAV(K)=(SMC(K) - SMCWLT)/(SMCMAX - SMCWLT)
-            END DO
+         RUNOFF3 = RUNOFF3/ DT
+         RUNOFF2 = RUNOFF2+ RUNOFF3
+         SOILM = -1.0* SMC (1)* ZSOIL (1)
+         DO K = 2,NSOIL
+            SOILM = SOILM + SMC (K)* (ZSOIL (K -1) - ZSOIL (K))
+         END DO
+         SOILWM = -1.0* (SMCMAX - SMCWLT)* ZSOIL (1)
+         SOILWW = -1.0* (SMC (1) - SMCWLT)* ZSOIL (1)
 
-            IF (NROOT >= 2) THEN
-              DO K = 2,NROOT
-               SOILWM = SOILWM + (SMCMAX - SMCWLT)* (ZSOIL (K -1) - ZSOIL (K))
-               SOILWW = SOILWW + (SMC(K) - SMCWLT)* (ZSOIL (K -1) - ZSOIL (K))
-              END DO
-            END IF
-            IF (SOILWM .LT. 1.E-6) THEN
-              SOILWM = 0.0
-              SOILW  = 0.0
-              SOILM  = 0.0
-            ELSE
-              SOILW = SOILWW / SOILWM
-            END IF
-         ELSE
-! ----------------------------------------------------------------------
-! FOR THE CASE OF SEA-ICE (ICE=1) OR GLACIAL-ICE (ICE=-1), ADD ANY
-! SNOWMELT DIRECTLY TO SURFACE RUNOFF (RUNOFF1) SINCE THERE IS NO
-! SOIL MEDIUM, AND THUS NO CALL TO SUBROUTINE SMFLX (FOR SOIL MOISTURE
-! TENDENCY).
-! ----------------------------------------------------------------------
-            RUNOFF1 = SNOMLT/DT
+         DO K = 1,NSOIL
+            SMAV(K)=(SMC(K) - SMCWLT)/(SMCMAX - SMCWLT)
+         END DO
+
+         IF (NROOT >= 2) THEN
+            DO K = 2,NROOT
+                SOILWM = SOILWM + (SMCMAX - SMCWLT)* (ZSOIL (K -1) - ZSOIL (K))
+                SOILWW = SOILWW + (SMC(K) - SMCWLT)* (ZSOIL (K -1) - ZSOIL (K))
+            END DO
+         END IF
+         IF (SOILWM .LT. 1.E-6) THEN
            SOILWM = 0.0
            SOILW  = 0.0
            SOILM  = 0.0
-           DO K = 1,NSOIL
-             SMAV(K)= 1.0
-           END DO
+         ELSE
+           SOILW = SOILWW / SOILWM
          END IF
 
 ! ----------------------------------------------------------------------
@@ -932,7 +909,7 @@ SUBROUTINE ALCALC (ALB,SNOALB,EMBRD,SHDFAC,SHDMIN,SNCOVR,TSNOW,ALBEDO,EMISSI,
       REAL, INTENT(IN)  :: DT
       LOGICAL, INTENT(IN) :: SNOWNG
       REAL, INTENT(INOUT):: SNOTIME1
-      REAL, INTENT(INOUT) ::  ALBEDO, EMISSI
+      REAL, INTENT(OUT) ::  ALBEDO, EMISSI
       REAL              :: SNOALB2
       REAL              :: TM,SNOALB1
       REAL, INTENT(IN)  :: LVCOEF
@@ -1073,7 +1050,7 @@ SUBROUTINE CANRES (SOLAR,CH,SFCTMP,Q2,SFCPRS,SMC,ZSOIL,NSOIL,       &
                              SFCPRS,SFCTMP,SMCREF,SMCWLT, SOLAR,TOPT,XLAI, &
                              EMISSI
       REAL,DIMENSION(1:NSOIL), INTENT(IN) :: SMC,ZSOIL
-      REAL,    INTENT(INOUT):: PC,RC,RCQ,RCS,RCSOIL,RCT
+      REAL,    INTENT(OUT):: PC,RC,RCQ,RCS,RCSOIL,RCT
       REAL                :: DELTA,FF,GX,P,RR
       REAL, DIMENSION(1:NSOIL) ::  PART
       REAL, PARAMETER     :: SLV = 2.501000E6
@@ -1174,7 +1151,7 @@ SUBROUTINE CSNOW (SNCOND,DSNOW)
 ! ----------------------------------------------------------------------
       IMPLICIT NONE
       REAL, INTENT(IN) :: DSNOW
-      REAL, INTENT(INOUT):: SNCOND
+      REAL, INTENT(OUT):: SNCOND
       REAL             :: C
       REAL, PARAMETER  :: UNIT = 0.11631
 
@@ -1205,7 +1182,6 @@ SUBROUTINE CSNOW (SNCOND,DSNOW)
 ! ----------------------------------------------------------------------
   END SUBROUTINE CSNOW
 ! ----------------------------------------------------------------------
-
       SUBROUTINE DEVAP (EDIR,ETP1,SMC,ZSOIL,SHDFAC,SMCMAX,BEXP,         &
                         DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP)
 
@@ -1218,7 +1194,7 @@ SUBROUTINE DEVAP (EDIR,ETP1,SMC,ZSOIL,SHDFAC,SMCMAX,BEXP,         &
       IMPLICIT NONE
       REAL, INTENT(IN) :: ETP1,SMC,BEXP,DKSAT,DWSAT,FXEXP,              &
                           SHDFAC,SMCDRY,SMCMAX,ZSOIL,SMCREF,SMCWLT
-      REAL, INTENT(INOUT):: EDIR
+      REAL, INTENT(OUT):: EDIR
       REAL             :: FX, SRATIO
 
 
@@ -1246,6 +1222,98 @@ SUBROUTINE DEVAP (EDIR,ETP1,SMC,ZSOIL,SHDFAC,SMCMAX,BEXP,         &
 
 ! ----------------------------------------------------------------------
   END SUBROUTINE DEVAP
+
+      SUBROUTINE DEVAP_hydro (EDIR,ETP1,SMC,ZSOIL,SHDFAC,SMCMAX,BEXP,         &
+                        DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP,         &
+                        SFHEAD1RT,ETPND1,DT)
+
+! ----------------------------------------------------------------------
+! SUBROUTINE DEVAP
+! FUNCTION DEVAP
+! ----------------------------------------------------------------------
+! CALCULATE DIRECT SOIL EVAPORATION
+! ----------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL, INTENT(IN) :: ETP1,SMC,BEXP,DKSAT,DWSAT,FXEXP,              &
+                          SHDFAC,SMCDRY,SMCMAX,ZSOIL,SMCREF,SMCWLT
+      REAL, INTENT(OUT):: EDIR
+      REAL             :: FX, SRATIO
+
+      REAL, INTENT(INOUT) :: SFHEAD1RT,ETPND1
+      REAL, INTENT(IN   ) :: DT
+       REAL             :: EDIRTMP
+
+
+
+! ----------------------------------------------------------------------
+! DIRECT EVAP A FUNCTION OF RELATIVE SOIL MOISTURE AVAILABILITY, LINEAR
+! WHEN FXEXP=1.
+! ----------------------------------------------------------------------
+! ----------------------------------------------------------------------
+! FX > 1 REPRESENTS DEMAND CONTROL
+! FX < 1 REPRESENTS FLUX CONTROL
+! ----------------------------------------------------------------------
+
+      SRATIO = (SMC - SMCDRY) / (SMCMAX - SMCDRY)
+      IF (SRATIO > 0.) THEN
+        FX = SRATIO**FXEXP
+        FX = MAX ( MIN ( FX, 1. ) ,0. )
+      ELSE
+        FX = 0.
+      ENDIF
+
+!DJG NDHMS/WRF-Hydro edits... Adjustment for ponded surface water : Reduce ETP1
+      EDIRTMP = 0.
+      ETPND1 = 0.
+
+!DJG NDHMS/WRF-Hydro edits...  Calc Max Potential Dir Evap. (ETP1 units: }=m/s)
+
+!DJG NDHMS/WRF-Hydro...currently set ponded water evap to 0.0 until further notice...11/5/2012
+!EDIRTMP = ( 1.0- SHDFAC ) * ETP1
+
+! Convert all units to (m)
+! Convert EDIRTMP  from (kg m{-2} s{-1}=m/s) to (m) ...
+      EDIRTMP = EDIRTMP * DT
+
+!DJG NDHMS/WRF-Hydro edits... Convert SFHEAD from (mm) to (m) ...
+      SFHEAD1RT=SFHEAD1RT * 0.001
+
+
+
+!DJG NDHMS/WRF-Hydro edits... Calculate ETPND as reduction in EDIR(TMP)...
+      IF (EDIRTMP > 0.) THEN
+       IF ( EDIRTMP > SFHEAD1RT ) THEN
+         ETPND1 = SFHEAD1RT
+         SFHEAD1RT=0.
+         EDIRTMP = EDIRTMP - ETPND1
+       ELSE
+         ETPND1 = EDIRTMP
+         EDIRTMP = 0.
+         SFHEAD1RT = SFHEAD1RT - ETPND1
+       END IF
+      END IF
+
+!DJG NDHMS/WRF-Hydro edits... Convert SFHEAD units back to (mm)
+      IF ( SFHEAD1RT /= 0.) SFHEAD1RT=SFHEAD1RT * 1000.
+
+!DJG NDHMS/WRF-Hydro edits...Convert ETPND and EDIRTMP back to (mm/s=kg m{-2} s{-1})
+      ETPND1 = ETPND1 / DT
+      EDIRTMP = EDIRTMP / DT
+!DEBUG    print *, "After DEVAP...SFCHEAD+ETPND1",SFHEAD1RT+ETPND1*DT
+
+
+! ----------------------------------------------------------------------
+! ALLOW FOR THE DIRECT-EVAP-REDUCING EFFECT OF SHADE
+! ----------------------------------------------------------------------
+!DJG NDHMS/WRF-Hydro edits...
+!       EDIR = FX * ( 1.0- SHDFAC ) * ETP1
+       EDIR = FX * EDIRTMP
+
+
+
+
+! ----------------------------------------------------------------------
+  END SUBROUTINE DEVAP_hydro
 ! ----------------------------------------------------------------------
 
       SUBROUTINE EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL,               &
@@ -1253,7 +1321,8 @@ SUBROUTINE EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL,               &
                          SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT,             &
                          SMCREF,SHDFAC,CMCMAX,                          &
                          SMCDRY,CFACTR,                                 &
-                         EDIR,EC,ET,ETT,SFCTMP,Q2,NROOT,RTDIS,FXEXP)
+                         EDIR,EC,ET,ETT,SFCTMP,Q2,NROOT,RTDIS,FXEXP,    &
+                         SFHEAD1RT,ETPND1)
 
 ! ----------------------------------------------------------------------
 ! SUBROUTINE EVAPO
@@ -1268,12 +1337,14 @@ SUBROUTINE EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL,               &
       INTEGER, INTENT(IN)   :: NSOIL, NROOT
       INTEGER               :: I,K
       REAL,    INTENT(IN)   :: BEXP, CFACTR,CMC,CMCMAX,DKSAT,           &
-                                 DT,DWSAT,ETP1,FXEXP,PC,Q2,SFCTMP,      &
+                                 DT,DWSAT,ETP1,FXEXP,PC,Q2,SFCTMP,           &
                                  SHDFAC,SMCDRY,SMCMAX,SMCREF,SMCWLT
-      REAL,    INTENT(INOUT)  :: EC,EDIR,ETA1,ETT
+      REAL,    INTENT(OUT)  :: EC,EDIR,ETA1,ETT
       REAL                  :: CMC2MS
       REAL,DIMENSION(1:NSOIL), INTENT(IN) :: RTDIS, SMC, SH2O, ZSOIL
-      REAL,DIMENSION(1:NSOIL), INTENT(INOUT) :: ET
+      REAL,DIMENSION(1:NSOIL), INTENT(OUT) :: ET
+
+      REAL,   INTENT(INOUT) :: SFHEAD1RT,ETPND1
 
 ! ----------------------------------------------------------------------
 ! EXECUTABLE CODE BEGINS HERE IF THE POTENTIAL EVAPOTRANSPIRATION IS
@@ -1293,8 +1364,21 @@ SUBROUTINE EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL,               &
 ! ----------------------------------------------------------------------
       IF (ETP1 > 0.0) THEN
          IF (SHDFAC <  1.) THEN
+#ifdef WRF_HYDRO
+!            CALL DEVAP_hydro (EDIR,ETP1,SMC (1),ZSOIL (1),SHDFAC,SMCMAX,      &
+!                        BEXP,DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP,    &
+!                         SFHEAD1RT,ETPND1,DT)
+!DJG Reduce ETP1 by EDIR & ETPND1...
+!                ETP1=ETP1-EDIR-ETPND1
+
+! following is the temparay setting ...
              CALL DEVAP (EDIR,ETP1,SMC (1),ZSOIL (1),SHDFAC,SMCMAX,      &
                          BEXP,DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP)
+!            ETP1=ETP1-EDIR
+#else
+             CALL DEVAP (EDIR,ETP1,SMC (1),ZSOIL (1),SHDFAC,SMCMAX,      &
+                         BEXP,DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP)
+#endif
          END IF
 ! ----------------------------------------------------------------------
 ! INITIALIZE PLANT TOTAL TRANSPIRATION, RETRIEVE PLANT TRANSPIRATION,
@@ -1336,7 +1420,7 @@ END SUBROUTINE EVAPO
   SUBROUTINE FAC2MIT(SMCMAX,FLIMIT)
     IMPLICIT NONE		
     REAL, INTENT(IN)  :: SMCMAX
-    REAL, INTENT(INOUT) :: FLIMIT
+    REAL, INTENT(OUT) :: FLIMIT
 
     FLIMIT = 0.90
 
@@ -1389,7 +1473,7 @@ SUBROUTINE FRH2O (FREE,TKELV,SMC,SH2O,SMCMAX,BEXP,PSIS)
 ! ----------------------------------------------------------------------
       IMPLICIT NONE
       REAL, INTENT(IN)     :: BEXP,PSIS,SH2O,SMC,SMCMAX,TKELV
-      REAL, INTENT(INOUT)    :: FREE
+      REAL, INTENT(OUT)    :: FREE
       REAL                 :: BX,DENOM,DF,DSWL,FK,SWL,SWLK
       INTEGER              :: NLOG,KCOUNT
 !      PARAMETER(CK = 0.0)
@@ -1498,8 +1582,9 @@ END SUBROUTINE FRH2O
 ! ----------------------------------------------------------------------
 
       SUBROUTINE HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,          &
-                       TBOT,ZBOT,PSISAT,SH2O,DT,BEXP,                   &
-                       F1,DF1,QUARTZ,CSOIL,AI,BI,CI,VEGTYP,ISURBAN)
+                       TBOT,ZBOT,PSISAT,SH2O,DT,BEXP,SOILTYP,OPT_THCND, &
+                       F1,DF1,QUARTZ,CSOIL,AI,BI,CI,VEGTYP,ISURBAN      &
+                      ,HCPCT_FASDAS                                     ) !fasdas
 
 ! ----------------------------------------------------------------------
 ! SUBROUTINE HRT
@@ -1510,7 +1595,8 @@ SUBROUTINE HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,          &
 ! ----------------------------------------------------------------------
       IMPLICIT NONE
       LOGICAL              :: ITAVG
-      INTEGER, INTENT(IN)  :: NSOIL, VEGTYP
+      INTEGER, INTENT(IN)  :: OPT_THCND
+      INTEGER, INTENT(IN)  :: NSOIL, VEGTYP, SOILTYP
       INTEGER, INTENT(IN)  :: ISURBAN
       INTEGER              :: I, K
 
@@ -1518,14 +1604,21 @@ SUBROUTINE HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,          &
                               SMCMAX ,TBOT,YY,ZZ1, ZBOT
       REAL, DIMENSION(1:NSOIL), INTENT(IN)   :: SMC,STC,ZSOIL
       REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: SH2O
-      REAL, DIMENSION(1:NSOIL), INTENT(INOUT)  :: RHSTS
-      REAL, DIMENSION(1:NSOIL), INTENT(INOUT)  :: AI, BI,CI
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT)  :: RHSTS
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT)  :: AI, BI,CI
       REAL                 :: DDZ, DDZ2, DENOM, DF1N, DF1K, DTSDZ,       &
                               DTSDZ2,HCPCT,QTOT,SSOIL,SICE,TAVG,TBK,     &
                               TBK1,TSNSR,TSURF,CSOIL_LOC
       REAL, PARAMETER      :: T0 = 273.15, CAIR = 1004.0, CICE = 2.106E6,&
                               CH2O = 4.2E6
 
+!
+! FASDAS
+!
+      REAL, INTENT(  OUT)       :: HCPCT_FASDAS
+!
+! END FASDAS
+!
 
 !urban
         IF( VEGTYP == ISURBAN ) then
@@ -1546,7 +1639,13 @@ SUBROUTINE HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,          &
       HCPCT = SH2O (1)* CH2O + (1.0- SMCMAX)* CSOIL_LOC + (SMCMAX - SMC (1))&
        * CAIR                                                           &
               + ( SMC (1) - SH2O (1) )* CICE
-
+!
+! FASDAS
+!
+      HCPCT_FASDAS = HCPCT
+!
+! END FASDAS
+!
 ! ----------------------------------------------------------------------
 ! CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER
 ! ----------------------------------------------------------------------
@@ -1647,7 +1746,7 @@ SUBROUTINE HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,          &
 ! ----------------------------------------------------------------------
 ! CALC THE VERTICAL SOIL TEMP GRADIENT THRU THIS LAYER
 ! ----------------------------------------------------------------------
-            CALL TDFCND (DF1N,SMC (K),QUARTZ,SMCMAX,SH2O (K))
+            CALL TDFCND (DF1N,SMC (K),QUARTZ,SMCMAX,SH2O (K),BEXP, PSISAT, SOILTYP, OPT_THCND)
 
 !urban
        IF ( VEGTYP == ISURBAN ) DF1N = 3.24
@@ -1679,7 +1778,7 @@ SUBROUTINE HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,          &
 ! ----------------------------------------------------------------------
 ! CALC THE VERTICAL SOIL TEMP GRADIENT THRU BOTTOM LAYER.
 ! ----------------------------------------------------------------------
-            CALL TDFCND (DF1N,SMC (K),QUARTZ,SMCMAX,SH2O (K))
+            CALL TDFCND (DF1N,SMC (K),QUARTZ,SMCMAX,SH2O (K),BEXP, PSISAT, SOILTYP, OPT_THCND)
 
 
 !urban
@@ -1747,172 +1846,6 @@ SUBROUTINE HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,          &
   END SUBROUTINE HRT
 ! ----------------------------------------------------------------------
 
-      SUBROUTINE HRTICE (RHSTS,STC,TBOT,ICE,NSOIL,ZSOIL,YY,ZZ1,DF1,AI,BI,CI)
-
-! ----------------------------------------------------------------------
-! SUBROUTINE HRTICE
-! ----------------------------------------------------------------------
-! CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY TERM OF THE SOIL
-! THERMAL DIFFUSION EQUATION IN THE CASE OF SEA-ICE (ICE=1) OR GLACIAL
-! ICE (ICE=-1). COMPUTE (PREPARE) THE MATRIX COEFFICIENTS FOR THE
-! TRI-DIAGONAL MATRIX OF THE IMPLICIT TIME SCHEME.
-!
-! (NOTE:  THIS SUBROUTINE ONLY CALLED FOR SEA-ICE OR GLACIAL ICE, BUT
-! NOT FOR NON-GLACIAL LAND (ICE = 0).
-! ----------------------------------------------------------------------
-      IMPLICIT NONE
-
-
-      INTEGER, INTENT(IN)    :: NSOIL
-      INTEGER                :: K
-
-      REAL,    INTENT(IN)    :: DF1,YY,ZZ1
-      REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: AI, BI,CI
-      REAL, DIMENSION(1:NSOIL), INTENT(IN) :: STC, ZSOIL
-      REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: RHSTS
-      REAL,                     INTENT(IN) :: TBOT
-      INTEGER,                  INTENT(IN) :: ICE
-      REAL                   :: DDZ,DDZ2,DENOM,DTSDZ,DTSDZ2,SSOIL,       &
-                                ZBOT
-      REAL                   :: HCPCT
-      REAL :: DF1K
-      REAL :: DF1N
-      REAL :: ZMD
-
-! ----------------------------------------------------------------------
-! SET A NOMINAL UNIVERSAL VALUE OF THE SEA-ICE SPECIFIC HEAT CAPACITY,
-! HCPCT = 1880.0*917.0.
-! ----------------------------------------------------------------------
-      IF ( ICE == 1 ) THEN
-         ! Sea-ice values
-         HCPCT = 1.72396E+6
-      ELSEIF (ICE == -1) THEN
-! SET A NOMINAL UNIVERSAL VALUE OF GLACIAL-ICE SPECIFIC HEAT CAPACITY,
-!   HCPCT = 2100.0*900.0 = 1.89000E+6 (SOURCE:  BOB GRUMBINE, 2005)
-!   TBOT PASSED IN AS ARGUMENT, VALUE FROM GLOBAL DATA SET
-         !
-         ! A least-squares fit for the four points provided by
-         ! Keith Hines for the Yen (1981) values for Antarctic
-         ! snow firn.
-         !
-         HCPCT = 1.E6 * (0.8194 - 0.1309*0.5*ZSOIL(1))
-         DF1K = DF1
-      ENDIF
-
-! ----------------------------------------------------------------------
-! THE INPUT ARGUMENT DF1 IS A UNIVERSALLY CONSTANT VALUE OF SEA-ICE
-! THERMAL DIFFUSIVITY, SET IN ROUTINE SNOPAC AS DF1 = 2.2.
-! ----------------------------------------------------------------------
-! SET ICE PACK DEPTH.  USE TBOT AS ICE PACK LOWER BOUNDARY TEMPERATURE
-! (THAT OF UNFROZEN SEA WATER AT BOTTOM OF SEA ICE PACK).  ASSUME ICE
-! PACK IS OF N=NSOIL LAYERS SPANNING A UNIFORM CONSTANT ICE PACK
-! THICKNESS AS DEFINED BY ZSOIL(NSOIL) IN ROUTINE SFLX.
-! ----------------------------------------------------------------------
-! ----------------------------------------------------------------------
-! CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER
-! ----------------------------------------------------------------------
-      IF (ICE == 1) THEN
-         ZBOT = ZSOIL (NSOIL)
-      ELSE IF (ICE == -1) THEN
-         ZBOT = -25.0
-      ENDIF
-      DDZ = 1.0 / ( -0.5 * ZSOIL (2) )
-      AI (1) = 0.0
-      CI (1) = (DF1 * DDZ) / (ZSOIL (1) * HCPCT)
-
-! ----------------------------------------------------------------------
-! CALC THE VERTICAL SOIL TEMP GRADIENT BTWN THE TOP AND 2ND SOIL LAYERS.
-! RECALC/ADJUST THE SOIL HEAT FLUX.  USE THE GRADIENT AND FLUX TO CALC
-! RHSTS FOR THE TOP SOIL LAYER.
-! ----------------------------------------------------------------------
-      BI (1) = - CI (1) + DF1/ (0.5 * ZSOIL (1) * ZSOIL (1) * HCPCT *    &
-       ZZ1)
-      DTSDZ = ( STC (1) - STC (2) ) / ( -0.5 * ZSOIL (2) )
-      SSOIL = DF1 * ( STC (1) - YY ) / ( 0.5 * ZSOIL (1) * ZZ1 )
-
-! ----------------------------------------------------------------------
-! INITIALIZE DDZ2
-! ----------------------------------------------------------------------
-      RHSTS (1) = ( DF1 * DTSDZ - SSOIL ) / ( ZSOIL (1) * HCPCT )
-
-! ----------------------------------------------------------------------
-! LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABOVE PROCESS
-! ----------------------------------------------------------------------
-      DDZ2 = 0.0
-      DF1K = DF1
-      DF1N = DF1
-      DO K = 2,NSOIL
-
-       IF ( ICE == -1 ) THEN
-          ZMD = 0.5 * (ZSOIL(K)+ZSOIL(K-1))
-          ! For the land-ice case
-! kmh 09/03/2006 use Yen (1981)'s values for Antarctic snow firn
-!         IF ( K .eq. 2 ) HCPCT = 0.855108E6
-!         IF ( K .eq. 3 ) HCPCT = 0.922906E6
-!         IF ( K .eq. 4 ) HCPCT = 1.009986E6
-
-          ! Least squares fit to the four points supplied by Keith Hines
-          ! from Yen (1981) for Antarctic snow firn.  Not optimal, but
-          ! probably better than just a constant.
-          HCPCT = 1.E6 * ( 0.8194 - 0.1309*ZMD )
-
-!         IF ( K .eq. 2 ) DF1N = 0.345356
-!         IF ( K .eq. 3 ) DF1N = 0.398777
-!         IF ( K .eq. 4 ) DF1N = 0.472653
-
-          ! Least squares fit to the three points supplied by Keith Hines
-          ! from Yen (1981) for Antarctic snow firn.  Not optimal, but
-          ! probably better than just a constant.
-          DF1N = 0.32333 - ( 0.10073 * ZMD )
-       ENDIF
-! ----------------------------------------------------------------------
-! CALC THE VERTICAL SOIL TEMP GRADIENT THRU THIS LAYER.
-! ----------------------------------------------------------------------
-         IF (K /= NSOIL) THEN
-            DENOM = 0.5 * ( ZSOIL (K -1) - ZSOIL (K +1) )
-
-! ----------------------------------------------------------------------
-! CALC THE MATRIX COEF, CI, AFTER CALC'NG ITS PARTIAL PRODUCT.
-! ----------------------------------------------------------------------
-            DTSDZ2 = ( STC (K) - STC (K +1) ) / DENOM
-            DDZ2 = 2. / (ZSOIL (K -1) - ZSOIL (K +1))
-            CI (K) = - DF1N * DDZ2 / ( (ZSOIL (K -1) - ZSOIL (K))*HCPCT)
-
-! ----------------------------------------------------------------------
-! CALC THE VERTICAL SOIL TEMP GRADIENT THRU THE LOWEST LAYER.
-! ----------------------------------------------------------------------
-         ELSE
-
-! ----------------------------------------------------------------------
-! SET MATRIX COEF, CI TO ZERO.
-! ----------------------------------------------------------------------
-            DTSDZ2 = (STC (K) - TBOT)/ (.5 * (ZSOIL (K -1) + ZSOIL (K)) &
-                     - ZBOT)
-            CI (K) = 0.
-! ----------------------------------------------------------------------
-! CALC RHSTS FOR THIS LAYER AFTER CALC'NG A PARTIAL PRODUCT.
-! ----------------------------------------------------------------------
-         END IF
-         DENOM = ( ZSOIL (K) - ZSOIL (K -1) ) * HCPCT
-
-! ----------------------------------------------------------------------
-! CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER.
-! ----------------------------------------------------------------------
-         RHSTS (K) = ( DF1N * DTSDZ2- DF1K * DTSDZ ) / DENOM
-         AI (K) = - DF1K * DDZ / ( (ZSOIL (K -1) - ZSOIL (K)) * HCPCT)
-
-! ----------------------------------------------------------------------
-! RESET VALUES OF DTSDZ AND DDZ FOR LOOP TO NEXT SOIL LYR.
-! ----------------------------------------------------------------------
-         BI (K) = - (AI (K) + CI (K))
-         DF1K = DF1N
-         DTSDZ = DTSDZ2
-         DDZ = DDZ2
-      END DO
-! ----------------------------------------------------------------------
-  END SUBROUTINE HRTICE
-! ----------------------------------------------------------------------
-
       SUBROUTINE HSTEP (STCOUT,STCIN,RHSTS,DT,NSOIL,AI,BI,CI)
 
 ! ----------------------------------------------------------------------
@@ -1925,7 +1858,7 @@ SUBROUTINE HSTEP (STCOUT,STCIN,RHSTS,DT,NSOIL,AI,BI,CI)
       INTEGER              :: K
 
       REAL, DIMENSION(1:NSOIL), INTENT(IN):: STCIN
-      REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: STCOUT
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT):: STCOUT
       REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: RHSTS
       REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: AI,BI,CI
       REAL, DIMENSION(1:NSOIL) :: RHSTSin
@@ -1971,9 +1904,11 @@ SUBROUTINE NOPAC (ETP,ETA,PRCP,SMC,SMCMAX,SMCWLT,                 &
                          STC,EPSCA,BEXP,PC,RCH,RR,CFACTR,               &
                          SH2O,SLOPE,KDT,FRZFACT,PSISAT,ZSOIL,           &
                          DKSAT,DWSAT,TBOT,ZBOT,RUNOFF1,RUNOFF2,         &
-                         RUNOFF3,EDIR,EC,ET,ETT,NROOT,ICE,RTDIS,        &
+                         RUNOFF3,EDIR,EC,ET,ETT,NROOT,RTDIS,            &
                          QUARTZ,FXEXP,CSOIL,                            &
-                         BETA,DRIP,DEW,FLX1,FLX3,VEGTYP,ISURBAN)
+                         BETA,DRIP,DEW,FLX1,FLX3,VEGTYP,ISURBAN,        &
+                         SFHEAD1RT,INFXS1RT,ETPND1,SOILTYP,OPT_THCND    &
+                        ,XSDA_QFX,QFX_PHY,XQNORM,fasdas,HCPCT_FASDAS    ) !fasdas
 
 ! ----------------------------------------------------------------------
 ! SUBROUTINE NOPAC
@@ -1984,7 +1919,8 @@ SUBROUTINE NOPAC (ETP,ETA,PRCP,SMC,SMCMAX,SMCWLT,                 &
 ! ----------------------------------------------------------------------
       IMPLICIT NONE
 
-      INTEGER, INTENT(IN)  :: ICE, NROOT,NSOIL,VEGTYP
+      INTEGER, INTENT(IN)  :: OPT_THCND
+      INTEGER, INTENT(IN)  :: NROOT,NSOIL,VEGTYP,SOILTYP
       INTEGER, INTENT(IN)  :: ISURBAN
       INTEGER              :: K
 
@@ -1994,15 +1930,28 @@ SUBROUTINE NOPAC (ETP,ETA,PRCP,SMC,SMCMAX,SMCWLT,                 &
                               SHDFAC,SLOPE,SMCDRY,SMCMAX,SMCREF,SMCWLT, &
                               T24,TBOT,TH2,ZBOT,EMISSI
       REAL, INTENT(INOUT)  :: CMC,BETA,T1
-      REAL, INTENT(INOUT)    :: DEW,DRIP,EC,EDIR,ETA,ETT,FLX1,FLX3,       &
+      REAL, INTENT(OUT)    :: DEW,DRIP,EC,EDIR,ETA,ETT,FLX1,FLX3,       &
                               RUNOFF1,RUNOFF2,RUNOFF3,SSOIL
+!DJG NDHMS/WRF-Hydro edit...
+      REAL, INTENT(INOUT)  :: SFHEAD1RT,INFXS1RT,ETPND1
+
       REAL, DIMENSION(1:NSOIL),INTENT(IN)     :: RTDIS,ZSOIL
-      REAL, DIMENSION(1:NSOIL),INTENT(INOUT)    :: ET
+      REAL, DIMENSION(1:NSOIL),INTENT(OUT)    :: ET
       REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SMC,SH2O,STC
       REAL, DIMENSION(1:NSOIL) :: ET1
       REAL                 :: EC1,EDIR1,ETT1,DF1,ETA1,ETP1,PRCP1,YY,    &
                               YYNUM,ZZ1
-
+!
+! FASDAS
+!
+      REAL                       ::  XSDA_QFX, QFX_PHY, XQNORM
+      INTEGER                    ::  fasdas
+      REAL , DIMENSION(1:NSOIL)  ::  EFT(NSOIL), wetty(1:NSOIL)
+      REAL                       ::  EFDIR, EFC, EALL_now
+      REAL, INTENT(  OUT)        ::  HCPCT_FASDAS
+!
+! END FASDAS
+!
 ! ----------------------------------------------------------------------
 ! EXECUTABLE CODE BEGINS HERE:
 ! CONVERT ETP Fnd PRCP FROM KG M-2 S-1 TO M S-1 AND INITIALIZE DEW.
@@ -2013,6 +1962,13 @@ SUBROUTINE NOPAC (ETP,ETA,PRCP,SMC,SMCMAX,SMCWLT,                 &
 ! ----------------------------------------------------------------------
 ! INITIALIZE EVAP TERMS.
 ! ----------------------------------------------------------------------
+!
+! FASDAS
+!
+      QFX_PHY = 0.0
+!
+! END FASDAS
+!
       EDIR = 0.
       EDIR1 = 0.
       EC1 = 0.
@@ -2020,24 +1976,75 @@ SUBROUTINE NOPAC (ETP,ETA,PRCP,SMC,SMCMAX,SMCWLT,                 &
       DO K = 1,NSOIL
         ET(K) = 0.
         ET1(K) = 0.
+!
+! FASDAS
+!
+        wetty(K) = 1.0
+!
+! END FASDAS
+!
       END DO
       ETT = 0.
       ETT1 = 0.
 
+!DJG NDHMS/WRF-Hydro edit...
+      ETPND1 = 0.
+
+
       IF (ETP > 0.0) THEN
          CALL EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL,                  &
                       SH2O,                                             &
                       SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT,                &
                       SMCREF,SHDFAC,CMCMAX,                             &
                       SMCDRY,CFACTR,                                    &
-                       EDIR1,EC1,ET1,ETT1,SFCTMP,Q2,NROOT,RTDIS,FXEXP)
+                       EDIR1,EC1,ET1,ETT1,SFCTMP,Q2,NROOT,RTDIS,FXEXP,  &
+                      SFHEAD1RT,ETPND1 )
+!
+! FASDAS
+!
+      IF( fasdas == 1 ) THEN
+        DO K=1,NSOIL
+        QFX_PHY = QFX_PHY + ET1(K)   ! m/s
+! dont add moisture fluxes if soil moisture is = or > smcref
+        IF(SMC(K).GE.SMCREF.and.XSDA_QFX.gt.0.0) wetty(K)=0.0
+        END DO
+       QFX_PHY = EDIR1+EC1+QFX_PHY    ! m/s
+       EALL_now = QFX_PHY           ! m/s
+       QFX_PHY = QFX_PHY*1000.0     ! Kg/m2/s
+
+       if(EALL_now.ne.0.0) then
+       EFDIR = (EDIR1/EALL_now)*XSDA_QFX*1.0E-03*XQNORM
+       EFDIR = EFDIR * wetty(1)
+          !TWG2015 Bugfix Flip Sign to conform to Net upward Flux
+           EDIR1 = EDIR1 + EFDIR    ! new value
+       
+       EFC = (EC1/EALL_now)*XSDA_QFX*1.0E-03*XQNORM
+       !TWG2015 Bugfix Flip Sign to conform to Net upward Flux
+       EC1 = EC1 + EFC         ! new value
+
+
+       DO K=1,NSOIL
+        EFT(K) = (ET1(K)/EALL_now)*XSDA_QFX*1.0E-03*XQNORM
+        EFT(K) =  EFT(K) * wetty(K)
+        !TWG2015 Bugfix Flip Sign to conform to Net upward Flux
+        ET1(K) = ET1(K) + EFT(K) ! new value
+       END DO
+
+
+       END IF ! for non-zero eall_now
+      ELSE
+        QFX_PHY = 0.0
+      ENDIF
+!
+! END FASDAS
+!
          CALL SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL,                      &
                       SH2O,SLOPE,KDT,FRZFACT,                           &
                       SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT,                   &
                       SHDFAC,CMCMAX,                                    &
                       RUNOFF1,RUNOFF2,RUNOFF3,                          &
                       EDIR1,EC1,ET1,                                    &
-                      DRIP)
+                      DRIP, SFHEAD1RT,INFXS1RT)
 
 ! ----------------------------------------------------------------------
 ! CONVERT MODELED EVAPOTRANSPIRATION FROM  M S-1  TO  KG M-2 S-1.
@@ -2057,13 +2064,50 @@ SUBROUTINE NOPAC (ETP,ETA,PRCP,SMC,SMCMAX,SMCWLT,                 &
 ! ----------------------------------------------------------------------
 
          PRCP1 = PRCP1+ DEW
+!
+! FASDAS
+!
+     IF( fasdas == 1 ) THEN
+       DO K=1,NSOIL
+        QFX_PHY = QFX_PHY + ET1(K)   ! m/s
+! dont add moisture fluxes if soil moisture is = or > smcref
+        IF(SMC(K).GE.SMCREF.and.XSDA_QFX.gt.0.0) wetty(K)=0.0
+       END DO
+       QFX_PHY = EDIR1+EC1+QFX_PHY    ! m/s
+        EALL_now = QFX_PHY     ! m/s
+       QFX_PHY = QFX_PHY*1000.0    ! Kg/m2/s
+
+       IF(EALL_now.ne.0.0) then
+       EFDIR = (EDIR1/EALL_now)*XSDA_QFX*1.0E-03*XQNORM
+        EFDIR =  EFDIR * wetty(1)
+          !TWG2015 Bugfix Flip Sign to conform to Net Upward Flux
+           EDIR1 = EDIR1 + EFDIR    ! new value
+
+        EFC = (EC1/EALL_now)*XSDA_QFX*1.0E-03*XQNORM
+        !TWG2015 Bugfix Flip Sign to conform to Net Upward Flux
+        EC1 = EC1+ EFC         ! new value
+
+       DO K=1,NSOIL
+        EFT(K) = (ET1(K)/EALL_now)*XSDA_QFX*1.0E-03*XQNORM
+        EFT(K) = EFT(K) * wetty(K)
+        !TWG2015 Bugfix Flip Sign to conform to Net Upward Flux
+        ET1(K) = ET1(K) + EFT(K)   ! new value
+       END DO
+
+        END IF ! for non-zero eall_now
+      ELSE
+        QFX_PHY = 0.0
+      ENDIF
+!
+! END FASDAS
+!
          CALL SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL,                      &
                       SH2O,SLOPE,KDT,FRZFACT,                           &
                       SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT,                   &
                       SHDFAC,CMCMAX,                                    &
                       RUNOFF1,RUNOFF2,RUNOFF3,                          &
                       EDIR1,EC1,ET1,                                    &
-                      DRIP)
+                      DRIP, SFHEAD1RT,INFXS1RT)
 
 ! ----------------------------------------------------------------------
 ! CONVERT MODELED EVAPOTRANSPIRATION FROM 'M S-1' TO 'KG M-2 S-1'.
@@ -2101,7 +2145,7 @@ SUBROUTINE NOPAC (ETP,ETA,PRCP,SMC,SMCMAX,SMCWLT,                 &
 ! CALL SHFLX TO COMPUTE/UPDATE SOIL HEAT FLUX AND SOIL TEMPS.
 ! ----------------------------------------------------------------------
 
-      CALL TDFCND (DF1,SMC (1),QUARTZ,SMCMAX,SH2O (1))
+      CALL TDFCND (DF1,SMC (1),QUARTZ,SMCMAX,SH2O (1),BEXP, PSISAT, SOILTYP, OPT_THCND)
 
 !urban
       IF ( VEGTYP == ISURBAN ) DF1=3.24
@@ -2125,9 +2169,10 @@ SUBROUTINE NOPAC (ETP,ETA,PRCP,SMC,SMCMAX,SMCWLT,                 &
       ZZ1 = DF1 / ( -0.5 * ZSOIL (1) * RCH * RR ) + 1.0
 
 !urban
-      CALL SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL,        &
-                  TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1,ICE,         &
-                  QUARTZ,CSOIL,VEGTYP,ISURBAN)
+      CALL SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL,       &
+                  TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1,            &
+                  QUARTZ,CSOIL,VEGTYP,ISURBAN,SOILTYP,OPT_THCND        &
+                 ,HCPCT_FASDAS                                         ) !fasdas
 
 ! ----------------------------------------------------------------------
 ! SET FLX1 AND FLX3 (SNOPACK PHASE CHANGE HEAT FLUXES) TO ZERO SINCE
@@ -2143,7 +2188,8 @@ END SUBROUTINE NOPAC
 
       SUBROUTINE PENMAN (SFCTMP,SFCPRS,CH,T2V,TH2,PRCP,FDOWN,T24,SSOIL, &
      &                   Q2,Q2SAT,ETP,RCH,EPSCA,RR,SNOWNG,FRZGRA,       &
-     &              DQSDT2,FLX2,EMISSI_IN,SNEQV,T1,ICE,SNCOVR)
+     &                   DQSDT2,FLX2,EMISSI_IN,SNEQV,T1,SNCOVR,AOASIS,  &
+		         ALBEDO,SOLDN,FVB,GAMA,STC1,ETPN,FLX4,UA_PHYS)
 
 ! ----------------------------------------------------------------------
 ! SUBROUTINE PENMAN
@@ -2156,18 +2202,19 @@ SUBROUTINE PENMAN (SFCTMP,SFCPRS,CH,T2V,TH2,PRCP,FDOWN,T24,SSOIL, &
       LOGICAL, INTENT(IN)     :: SNOWNG, FRZGRA
       REAL, INTENT(IN)        :: CH, DQSDT2,FDOWN,PRCP,                 &
                                  Q2, Q2SAT,SSOIL, SFCPRS, SFCTMP,       &
-                                 T2V, TH2,EMISSI_IN,SNEQV
+                                 T2V, TH2,EMISSI_IN,SNEQV,AOASIS
       REAL, INTENT(IN)        :: T1 , SNCOVR
+      REAL, INTENT(IN)        :: ALBEDO,SOLDN,FVB,GAMA,STC1
+      LOGICAL, INTENT(IN)     :: UA_PHYS
 !
-! kmh 09/13/2006
-      INTEGER, INTENT(IN)     :: ICE
-! kmh 09/03/2006
-!
-      REAL, INTENT(INOUT)       :: EPSCA,ETP,FLX2,RCH,RR,T24
+      REAL, INTENT(OUT)       :: EPSCA,ETP,FLX2,RCH,RR,T24
+      REAL, INTENT(OUT)       :: FLX4,ETPN
       REAL                    :: A, DELTA, FNET,RAD,RHO,EMISSI,ELCP1,LVS
+      REAL                    :: TOTABS,UCABS,SIGNCK,FNETN,RADN,EPSCAN
 
       REAL, PARAMETER      :: ELCP = 2.4888E+3, LSUBC = 2.501000E+6,CP = 1004.6
       REAL, PARAMETER      :: LSUBS = 2.83E+6
+      REAL, PARAMETER      :: ALGDSN = 0.5, ALVGSN = 0.13
 
 ! ----------------------------------------------------------------------
 ! EXECUTABLE CODE BEGINS HERE:
@@ -2176,18 +2223,8 @@ SUBROUTINE PENMAN (SFCTMP,SFCPRS,CH,T2V,TH2,PRCP,FDOWN,T24,SSOIL, &
 ! PREPARE PARTIAL QUANTITIES FOR PENMAN EQUATION.
 ! ----------------------------------------------------------------------
         EMISSI=EMISSI_IN
-        IF (ICE==0) THEN
-           ELCP1  = (1.0-SNCOVR)*ELCP  + SNCOVR*ELCP*LSUBS/LSUBC
-           LVS    = (1.0-SNCOVR)*LSUBC + SNCOVR*LSUBS
-        ELSE
-           IF ( T1 > 273.15 ) THEN
-              ELCP1=ELCP
-              LVS=LSUBC
-           ELSE
-              ELCP1  = ELCP*LSUBS/LSUBC
-              LVS    = LSUBS
-           ENDIF
-        ENDIF
+        ELCP1  = (1.0-SNCOVR)*ELCP  + SNCOVR*ELCP*LSUBS/LSUBC
+        LVS    = (1.0-SNCOVR)*LSUBC + SNCOVR*LSUBS
 
       FLX2 = 0.0
 !      DELTA = ELCP * DQSDT2
@@ -2214,9 +2251,39 @@ SUBROUTINE PENMAN (SFCTMP,SFCPRS,CH,T2V,TH2,PRCP,FDOWN,T24,SSOIL, &
 ! ----------------------------------------------------------------------
 !      FNET = FDOWN - SIGMA * T24- SSOIL
       FNET = FDOWN -  EMISSI*SIGMA * T24- SSOIL
+
+      FLX4 = 0.0
+      IF(UA_PHYS) THEN
+        IF(SNEQV > 0. .AND. FNET > 0. .AND. SOLDN > 0. ) THEN
+         TOTABS = (1.-ALBEDO)*SOLDN*FVB           ! solar radiation absorbed 
+                                                  ! by vegetated fraction
+         UCABS = MIN(TOTABS,((1.0-ALGDSN)*(1.0-ALVGSN)*SOLDN*GAMA)*FVB)
+!         print*,'penman',UCABS,TOTABS,SOLDN,GAMA,FVB
+!         UCABS = MIN(TOTABS,(0.44*SOLDN*GAMA)*FVB)  
+                                                  ! UCABS -> solar radiation
+						  ! absorbed under canopy
+         FLX4 = MIN(TOTABS - UCABS, MIN(250., 0.5*(1.-ALBEDO)*SOLDN))
+        ENDIF
+
+        SIGNCK = (STC1-273.15)*(SFCTMP-273.15)
+
+        IF(FLX4 > 0. .AND. (SIGNCK <= 0. .OR. STC1 < 273.15)) THEN
+          IF(FNET >= FLX4) THEN
+           FNETN = FNET - FLX4
+          ELSE
+           FLX4 = FNET
+           FNETN = 0.
+          ENDIF
+        ELSE
+          FLX4 = 0.0
+          FNETN = 0.
+        ENDIF
+      ENDIF
+
       IF (FRZGRA) THEN
          FLX2 = - LSUBF * PRCP
          FNET = FNET - FLX2
+         IF(UA_PHYS) FNETN = FNETN - FLX2
 ! ----------------------------------------------------------------------
 ! FINISH PENMAN EQUATION CALCULATIONS.
 ! ----------------------------------------------------------------------
@@ -2225,9 +2292,16 @@ SUBROUTINE PENMAN (SFCTMP,SFCPRS,CH,T2V,TH2,PRCP,FDOWN,T24,SSOIL, &
 !      A = ELCP * (Q2SAT - Q2)
       A = ELCP1 * (Q2SAT - Q2)
       EPSCA = (A * RR + RAD * DELTA) / (DELTA + RR)
+! Fei-Mike
+      IF (EPSCA>0.) EPSCA = EPSCA * AOASIS
 !      ETP = EPSCA * RCH / LSUBC
       ETP = EPSCA * RCH / LVS
 
+      IF(UA_PHYS) THEN
+        RADN = FNETN / RCH + TH2- SFCTMP
+        EPSCAN = (A * RR + RADN * DELTA) / (DELTA + RR)
+        ETPN = EPSCAN * RCH / LVS
+      END IF
 ! ----------------------------------------------------------------------
   END SUBROUTINE PENMAN
 ! ----------------------------------------------------------------------
@@ -2240,7 +2314,7 @@ SUBROUTINE REDPRM (VEGTYP,SOILTYP,SLOPETYP,CFACTR,CMCMAX,RSMAX,      &
                          RTDIS,SLDPTH,ZSOIL, NROOT,NSOIL,CZIL,             &
                          LAIMIN, LAIMAX, EMISSMIN, EMISSMAX, ALBEDOMIN,    &
                          ALBEDOMAX, Z0MIN, Z0MAX, CSOIL, PTU, LLANDUSE,    &
-                         LSOIL, LOCAL,LVCOEF)
+                         LSOIL, LOCAL,LVCOEF,ZTOPV,ZBOTV)
 
       IMPLICIT NONE
 ! ----------------------------------------------------------------------
@@ -2323,40 +2397,41 @@ SUBROUTINE REDPRM (VEGTYP,SOILTYP,SLOPETYP,CFACTR,CMCMAX,RSMAX,      &
 
 ! Veg parameters
       INTEGER, INTENT(IN)    :: VEGTYP
-      INTEGER, INTENT(INOUT)   :: NROOT
-      REAL, INTENT(INOUT)      :: HS,RSMIN,RGL,SHDFAC,SNUP,                   &
+      INTEGER, INTENT(OUT)   :: NROOT
+      REAL, INTENT(INOUT)    :: SHDFAC
+      REAL, INTENT(OUT)      :: HS,RSMIN,RGL,SNUP,                          &
                                 CMCMAX,RSMAX,TOPT,                          &
                                 EMISSMIN,  EMISSMAX,                        &
                                 LAIMIN,    LAIMAX,                          &
                                 Z0MIN,     Z0MAX,                           &
-                                ALBEDOMIN, ALBEDOMAX
+                                ALBEDOMIN, ALBEDOMAX, ZTOPV, ZBOTV
 ! Soil parameters
       INTEGER, INTENT(IN)    :: SOILTYP
-      REAL, INTENT(INOUT)      :: BEXP,DKSAT,DWSAT,F1,QUARTZ,SMCDRY,          &
+      REAL, INTENT(OUT)      :: BEXP,DKSAT,DWSAT,F1,QUARTZ,SMCDRY,          &
                                 SMCMAX,SMCREF,SMCWLT,PSISAT
 ! General parameters
       INTEGER, INTENT(IN)    :: SLOPETYP,NSOIL
       INTEGER                :: I
 
-      REAL,    INTENT(INOUT)   :: SLOPE,CZIL,SBETA,FXEXP,                     &
+      REAL,    INTENT(OUT)   :: SLOPE,CZIL,SBETA,FXEXP,                     &
                                 CSOIL,SALP,FRZX,KDT,CFACTR,      &
                                 ZBOT,REFKDT,PTU
-      REAL,    INTENT(INOUT)   :: LVCOEF
+      REAL,    INTENT(OUT)   :: LVCOEF
       REAL,DIMENSION(1:NSOIL),INTENT(IN) :: SLDPTH,ZSOIL
-      REAL,DIMENSION(1:NSOIL),INTENT(INOUT):: RTDIS
+      REAL,DIMENSION(1:NSOIL),INTENT(OUT):: RTDIS
       REAL                   :: FRZFACT,FRZK,REFDK
 
 !      SAVE
 ! ----------------------------------------------------------------------
 !
                IF (SOILTYP .gt. SLCATS) THEN
-                        CALL physics_error_fatal ( 'Warning: too many input soil types' )
+                        FATAL_ERROR( 'Warning: too many input soil types' )
                END IF
                IF (VEGTYP .gt. LUCATS) THEN
-                     CALL physics_error_fatal ( 'Warning: too many input landuse types' )
+                     FATAL_ERROR( 'Warning: too many input landuse types' )
                END IF
                IF (SLOPETYP .gt. SLPCATS) THEN
-                     CALL physics_error_fatal ( 'Warning: too many input slope types' )
+                     FATAL_ERROR( 'Warning: too many input slope types' )
                END IF
 
 ! ----------------------------------------------------------------------
@@ -2416,6 +2491,8 @@ SUBROUTINE REDPRM (VEGTYP,SOILTYP,SLOPETYP,CFACTR,CMCMAX,RSMAX,      &
       Z0MAX     = Z0MAXTBL     (VEGTYP)
       ALBEDOMIN = ALBEDOMINTBL (VEGTYP)
       ALBEDOMAX = ALBEDOMAXTBL (VEGTYP)
+      ZTOPV     = ZTOPVTBL     (VEGTYP)
+      ZBOTV     = ZBOTVTBL     (VEGTYP)
 
                IF (VEGTYP .eq. BARE) SHDFAC = 0.0
                IF (NROOT .gt. NSOIL) THEN
@@ -2479,7 +2556,6 @@ SUBROUTINE ROSR12 (P,A,B,C,D,DELTA,NSOIL)
       REAL, DIMENSION(1:NSOIL), INTENT(IN):: A, B, D
       REAL, DIMENSION(1:NSOIL),INTENT(INOUT):: C,P,DELTA
 
-
 ! ----------------------------------------------------------------------
 ! INITIALIZE EQN COEF C FOR THE LOWEST SOIL LAYER
 ! ----------------------------------------------------------------------
@@ -2515,9 +2591,10 @@ END SUBROUTINE ROSR12
 ! ----------------------------------------------------------------------
 
 
-      SUBROUTINE SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL,  &
-                         TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1,ICE,  &
-                         QUARTZ,CSOIL,VEGTYP,ISURBAN)
+      SUBROUTINE SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL, &
+                         TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1,     &
+                         QUARTZ,CSOIL,VEGTYP,ISURBAN,SOILTYP,OPT_THCND &
+                        ,HCPCT_FASDAS                                  ) ! fasdas
 
 ! ----------------------------------------------------------------------
 ! SUBROUTINE SHFLX
@@ -2528,45 +2605,43 @@ SUBROUTINE SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL,  &
 ! ----------------------------------------------------------------------
       IMPLICIT NONE
 
-      INTEGER, INTENT(IN)   :: ICE, NSOIL, VEGTYP, ISURBAN
+      INTEGER, INTENT(IN)   :: OPT_THCND
+      INTEGER, INTENT(IN)   :: NSOIL, VEGTYP, ISURBAN, SOILTYP
       INTEGER               :: I
 
       REAL, INTENT(IN)      :: BEXP,CSOIL,DF1,DT,F1,PSISAT,QUARTZ,     &
                                SMCMAX, SMCWLT, TBOT,YY, ZBOT,ZZ1
       REAL, INTENT(INOUT)   :: T1
-      REAL, INTENT(INOUT)     :: SSOIL
+      REAL, INTENT(OUT)     :: SSOIL
       REAL, DIMENSION(1:NSOIL), INTENT(IN)    :: SMC,ZSOIL
       REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SH2O
       REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: STC
       REAL, DIMENSION(1:NSOIL)             :: AI, BI, CI, STCF,RHSTS
       REAL, PARAMETER       :: T0 = 273.15
 
+!
+! FASDAS
+!
+      REAL, INTENT(  OUT)     :: HCPCT_FASDAS
+!
+! END FASDAS
+!
 ! ----------------------------------------------------------------------
 ! HRT ROUTINE CALCS THE RIGHT HAND SIDE OF THE SOIL TEMP DIF EQN
 ! ----------------------------------------------------------------------
 
-! ----------------------------------------------------------------------
-! SEA-ICE CASE, GLACIAL ICE CASE
-! ----------------------------------------------------------------------
-      IF ( ICE /= 0 ) THEN
+      ! Land case
 
-         CALL HRTICE (RHSTS,STC,TBOT,ICE,NSOIL,ZSOIL,YY,ZZ1,DF1,AI,BI,CI)
+      CALL HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,TBOT,     &
+                ZBOT,PSISAT,SH2O,DT,BEXP,SOILTYP,OPT_THCND,       &
+                F1,DF1,QUARTZ,CSOIL,AI,BI,CI,VEGTYP,ISURBAN       &
+               ,HCPCT_FASDAS                                      ) !fasdas
 
-         CALL HSTEP (STCF,STC,RHSTS,DT,NSOIL,AI,BI,CI)
+      CALL HSTEP (STCF,STC,RHSTS,DT,NSOIL,AI,BI,CI)
 
-! ----------------------------------------------------------------------
-! LAND-MASS CASE
-! ----------------------------------------------------------------------
-      ELSE
-         CALL HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,TBOT,        &
-                    ZBOT,PSISAT,SH2O,DT,                                &
-                    BEXP,F1,DF1,QUARTZ,CSOIL,AI,BI,CI,VEGTYP,ISURBAN)
-
-         CALL HSTEP (STCF,STC,RHSTS,DT,NSOIL,AI,BI,CI)
-      END IF
       DO I = 1,NSOIL
          STC (I) = STCF (I)
-      END DO
+      ENDDO
 
 ! ----------------------------------------------------------------------
 ! IN THE NO SNOWPACK CASE (VIA ROUTINE NOPAC BRANCH,) UPDATE THE GRND
@@ -2591,7 +2666,7 @@ SUBROUTINE SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL,                   &
      &                   SHDFAC,CMCMAX,                                 &
      &                   RUNOFF1,RUNOFF2,RUNOFF3,                       &
      &                   EDIR,EC,ET,                                    &
-     &                   DRIP)
+     &                   DRIP, SFHEAD1RT,INFXS1RT)
 
 ! ----------------------------------------------------------------------
 ! SUBROUTINE SMFLX
@@ -2609,7 +2684,7 @@ SUBROUTINE SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL,                   &
 
       REAL, INTENT(IN)      :: BEXP, CMCMAX, DKSAT,DWSAT, DT, EC, EDIR,  &
                                KDT, PRCP1, SHDFAC, SLOPE, SMCMAX, SMCWLT
-      REAL, INTENT(INOUT)                      :: DRIP, RUNOFF1, RUNOFF2, RUNOFF3
+      REAL, INTENT(OUT)                      :: DRIP, RUNOFF1, RUNOFF2, RUNOFF3
       REAL, INTENT(INOUT)   :: CMC
       REAL, DIMENSION(1:NSOIL), INTENT(IN)   :: ET,ZSOIL
       REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: SMC, SH2O
@@ -2619,6 +2694,8 @@ SUBROUTINE SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL,                   &
       REAL :: FAC2
       REAL :: FLIMIT
 
+      REAL,    INTENT(INOUT)                 :: SFHEAD1RT,INFXS1RT
+
 ! ----------------------------------------------------------------------
 ! EXECUTABLE CODE BEGINS HERE.
 ! ----------------------------------------------------------------------
@@ -2685,28 +2762,38 @@ SUBROUTINE SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL,                   &
 ! INC&UDED IN SSTEP SUBR.  FROZEN GROUND CORRECTION FACTOR, FRZFACT
 ! ADDED.  ALL WATER BALANCE CALCULATIONS USING UNFROZEN WATER
 ! ----------------------------------------------------------------------
+
+#ifdef WRF_HYDRO
+!DJG NDHMS/WRF-Hydro edit... Add previous ponded water to new precip drip...
+    PCPDRP = PCPDRP + SFHEAD1RT/1000./DT   ! convert SFHEAD1RT to (m/s)
+#endif
+
+
       IF ( ( (PCPDRP * DT) > (0.0001*1000.0* (- ZSOIL (1))* SMCMAX) )   &
            .OR. (FAC2 > FLIMIT) ) THEN
          CALL SRT (RHSTT,EDIR,ET,SH2O,SH2O,NSOIL,PCPDRP,ZSOIL,          &
                     DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1,                    &
-                    RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI)
+                    RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI,  &
+                    SFHEAD1RT,INFXS1RT)
          CALL SSTEP (SH2OFG,SH2O,DUMMY,RHSTT,RHSCT,DT,NSOIL,SMCMAX,     &
-                        CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI)
+                        CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI,INFXS1RT)
          DO K = 1,NSOIL
             SH2OA (K) = (SH2O (K) + SH2OFG (K)) * 0.5
          END DO
          CALL SRT (RHSTT,EDIR,ET,SH2O,SH2OA,NSOIL,PCPDRP,ZSOIL,         &
                     DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1,                    &
-                    RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI)
+                    RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI,  &
+                    SFHEAD1RT,INFXS1RT)
          CALL SSTEP (SH2O,SH2O,CMC,RHSTT,RHSCT,DT,NSOIL,SMCMAX,         &
-                        CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI)
+                        CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI,INFXS1RT)
 
       ELSE
          CALL SRT (RHSTT,EDIR,ET,SH2O,SH2O,NSOIL,PCPDRP,ZSOIL,          &
                     DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1,                    &
-                      RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI)
+                    RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI,  &
+                   SFHEAD1RT,INFXS1RT)
          CALL SSTEP (SH2O,SH2O,CMC,RHSTT,RHSCT,DT,NSOIL,SMCMAX,         &
-                        CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI)
+                     CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI,INFXS1RT)
 !      RUNOF = RUNOFF
 
       END IF
@@ -2716,7 +2803,9 @@ END SUBROUTINE SMFLX
 ! ----------------------------------------------------------------------
 
 
-      SUBROUTINE SNFRAC (SNEQV,SNUP,SALP,SNOWH,SNCOVR)
+      SUBROUTINE SNFRAC (SNEQV,SNUP,SALP,SNOWH,SNCOVR, &
+                         XLAI,SHDFAC,FVB,GAMA,FBUR,    &
+                         FGSN,ZTOPV,ZBOTV,UA_PHYS)
 
 ! ----------------------------------------------------------------------
 ! SUBROUTINE SNFRAC
@@ -2730,8 +2819,19 @@ SUBROUTINE SNFRAC (SNEQV,SNUP,SALP,SNOWH,SNCOVR)
       IMPLICIT NONE
 
       REAL, INTENT(IN)     :: SNEQV,SNUP,SALP,SNOWH
-      REAL, INTENT(INOUT)    :: SNCOVR
+      REAL, INTENT(OUT)    :: SNCOVR
       REAL                 :: RSNOW, Z0N
+      LOGICAL, INTENT(IN)  :: UA_PHYS  ! UA: flag for UA option
+      REAL, INTENT(IN)     :: ZTOPV    ! UA: height of canopy top
+      REAL, INTENT(IN)     :: ZBOTV    ! UA: height of canopy bottom
+      REAL, INTENT(IN)     :: SHDFAC   ! UA: vegetation fraction
+      REAL, INTENT(INOUT)  :: XLAI     ! UA: LAI modified by snow
+      REAL, INTENT(OUT)    :: FVB      ! UA: frac. veg. w/snow beneath
+      REAL, INTENT(OUT)    :: GAMA     ! UA: = EXP(-1.* XLAI)
+      REAL, INTENT(OUT)    :: FBUR     ! UA: fraction of canopy buried
+      REAL, INTENT(OUT)    :: FGSN     ! UA: ground snow cover fraction
+
+      REAL ::  SNUPGRD = 0.02          ! UA: SWE limit for ground cover
 
 ! ----------------------------------------------------------------------
 ! SNUP IS VEG-CLASS DEPENDENT SNOWDEPTH THRESHHOLD (SET IN ROUTINE
@@ -2752,6 +2852,58 @@ SUBROUTINE SNFRAC (SNEQV,SNUP,SALP,SNOWH,SNCOVR)
 !     FORMULATION OF MARSHALL ET AL. 1994
 !        SNCOVR=SNEQV/(SNEQV + 2*Z0N)
 
+      IF(UA_PHYS) THEN
+
+!---------------------------------------------------------------------
+! FGSN: FRACTION OF SOIL COVERED WITH SNOW
+!---------------------------------------------------------------------
+        IF (SNEQV < SNUPGRD) THEN
+         FGSN = SNEQV / SNUPGRD
+        ELSE
+         FGSN = 1.0
+        END IF
+!------------------------------------------------------------------
+! FBUR: VERTICAL FRACTION OF VEGETATION COVERED BY SNOW
+! GRASS, CROP, AND SHRUB: MULTIPLY 0.4 BY ZTOPV AND ZBOTV BECAUSE 
+! THEY WILL BE PRESSED DOWN BY THE SNOW.
+! FOREST: DON'T NEED TO CHANGE ZTOPV AND ZBOTV.
+
+        IF(ZBOTV > 0. .AND. SNOWH > ZBOTV) THEN
+          IF(ZBOTV <= 0.5) THEN
+            FBUR = (SNOWH - 0.4*ZBOTV) / (0.4*(ZTOPV-ZBOTV)) ! short veg.
+          ELSE
+            FBUR = (SNOWH - ZBOTV) / (ZTOPV-ZBOTV)           !  tall veg.
+          ENDIF
+        ELSE
+          FBUR = 0.
+        ENDIF
+
+        FBUR = MIN(MAX(FBUR,0.0),1.0)
+
+! XLAI IS ADJUSTED FOR VERTICAL BURYING BY SNOW
+        XLAI = XLAI * (1.0 - FBUR)
+! ----------------------------------------------------------------------
+! SNOW-COVERED SOIL: (1-SHDFAC)*FGSN
+! VEGETATION WITH SNOW ABOVE DUE TO BURIAL FVEG_SN_AB = SHDFAC*FBUR
+! SNOW ON THE GROUND THAT CAN BE "SEEN" BY SATELLITE
+! (IF XLAI GOES TO ZERO): GAMA*FVB
+! Where GAMA = exp(-XLAI)
+! ----------------------------------------------------------------------
+
+! VEGETATION WITH SNOW BELOW
+        FVB = SHDFAC * FGSN * (1.0 - FBUR)
+
+! GAMA IS USED TO DIVIDE FVB INTO TWO PARTS:
+! GAMA=1 FOR XLAI=0 AND GAMA=0 FOR XLAI=6
+        GAMA = EXP(-1.* XLAI)
+      ELSE
+        ! Define intent(out) terms for .NOT. UA_PHYS case
+        FVB  = 0.0
+        GAMA = 0.0
+        FBUR = 0.0
+        FGSN = 0.0
+      END IF    ! UA_PHYS
+
 ! ----------------------------------------------------------------------
   END SUBROUTINE SNFRAC
 ! ----------------------------------------------------------------------
@@ -2852,13 +3004,14 @@ SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT,   &
                           SNOWH,SH2O,SLOPE,KDT,FRZFACT,PSISAT,          &
                           ZSOIL,DWSAT,DKSAT,TBOT,ZBOT,SHDFAC,RUNOFF1,   &
                           RUNOFF2,RUNOFF3,EDIR,EC,ET,ETT,NROOT,SNOMLT,  &
-                          ICE,RTDIS,QUARTZ,FXEXP,CSOIL,                 &
+                          RTDIS,QUARTZ,FXEXP,CSOIL,                     &
                           BETA,DRIP,DEW,FLX1,FLX2,FLX3,ESNOW,ETNS,EMISSI,&
                           RIBB,SOLDN,                                   &
                           ISURBAN,                                      &
-
-                          VEGTYP)
-
+                          VEGTYP,                                       &
+                          ETPN,FLX4,UA_PHYS,                            &
+                          SFHEAD1RT,INFXS1RT,ETPND1,SOILTYP,OPT_THCND   &
+                         ,QFX_PHY,fasdas,HCPCT_FASDAS                   ) !fasdas
 ! ----------------------------------------------------------------------
 ! SUBROUTINE SNOPAC
 ! ----------------------------------------------------------------------
@@ -2868,7 +3021,8 @@ SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT,   &
 ! ----------------------------------------------------------------------
       IMPLICIT NONE
 
-      INTEGER, INTENT(IN)   :: ICE, NROOT, NSOIL,VEGTYP
+      INTEGER, INTENT(IN)   :: OPT_THCND
+      INTEGER, INTENT(IN)   :: NROOT, NSOIL,VEGTYP,SOILTYP
       INTEGER, INTENT(IN)   :: ISURBAN
       INTEGER               :: K
 !
@@ -2876,6 +3030,10 @@ SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT,   &
 !
       INTEGER               :: IT16
       LOGICAL, INTENT(IN)   :: SNOWNG
+
+!DJG NDHMS/WRF-Hydro edit...
+       REAL, INTENT(INOUT)    ::  SFHEAD1RT,INFXS1RT,ETPND1
+
       REAL, INTENT(IN)      :: BEXP,CFACTR, CMCMAX,CSOIL,DF1,DKSAT,     &
                                DT,DWSAT, EPSCA,FDOWN,F1,FXEXP,          &
                                FRZFACT,KDT,PC, PRCP,PSISAT,Q2,QUARTZ,   &
@@ -2884,11 +3042,11 @@ SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT,   &
                                TBOT,TH2,ZBOT,EMISSI,SOLDN
       REAL, INTENT(INOUT)   :: CMC, BETA, ESD,FLX2,PRCPF,SNOWH,SNCOVR,  &
                                SNDENS, T1, RIBB, ETP
-      REAL, INTENT(INOUT)     :: DEW,DRIP,EC,EDIR, ETNS, ESNOW,ETT,       &
+      REAL, INTENT(OUT)     :: DEW,DRIP,EC,EDIR, ETNS, ESNOW,ETT,       &
                                FLX1,FLX3, RUNOFF1,RUNOFF2,RUNOFF3,      &
                                SSOIL,SNOMLT
       REAL, DIMENSION(1:NSOIL),INTENT(IN)     :: RTDIS,ZSOIL
-      REAL, DIMENSION(1:NSOIL),INTENT(INOUT)    :: ET
+      REAL, DIMENSION(1:NSOIL),INTENT(OUT)    :: ET
       REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SMC,SH2O,STC
       REAL, DIMENSION(1:NSOIL) :: ET1
       REAL                  :: DENOM,DSOIL,DTOT,EC1,EDIR1,ESDFLX,ETA,   &
@@ -2905,15 +3063,23 @@ SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT,   &
       REAL, PARAMETER       :: ESDMIN = 1.E-6, LSUBC = 2.501000E+6,     &
                                LSUBS = 2.83E+6, TFREEZ = 273.15,        &
                                SNOEXP = 2.0
+      LOGICAL, INTENT(IN)   :: UA_PHYS  ! UA: flag for UA option
+      REAL, INTENT(INOUT)   :: FLX4     ! UA: energy removed by canopy
+      REAL, INTENT(IN)      :: ETPN     ! UA: adjusted pot. evap. [mm/s]
+      REAL                  :: ETP1N    ! UA: adjusted pot. evap. [m/s]
 
+!
+!  FASDAS
+!
+      REAL                  :: QFX_PHY
+      INTEGER               :: fasdas
+      REAL, INTENT(  OUT)   :: HCPCT_FASDAS
+!
+!  END FASDAS
+!
 ! ----------------------------------------------------------------------
 ! EXECUTABLE CODE BEGINS HERE:
 ! ----------------------------------------------------------------------
-! IF SEA-ICE (ICE=1) OR GLACIAL-ICE (ICE=-1), SNOWCOVER FRACTION = 1.0,
-! AND SUBLIMATION IS AT THE POTENTIAL RATE.
-! FOR NON-GLACIAL LAND (ICE=0), IF SNOWCOVER FRACTION < 1.0, TOTAL
-! EVAPORATION < POTENTIAL DUE TO NON-POTENTIAL CONTRIBUTION FROM
-! NON-SNOW COVERED FRACTION.
 ! ----------------------------------------------------------------------
 ! INITIALIZE EVAP TERMS.
 ! ----------------------------------------------------------------------
@@ -2939,6 +3105,11 @@ SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT,   &
       END DO
       ETT = 0.
       ETT1 = 0.
+
+!DJG NDHMS/WRF-Hydro edit...
+      ETPND1 = 0.
+
+
       ETNS = 0.
       ETNS1 = 0.
       ESNOW = 0.
@@ -2957,58 +3128,68 @@ SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT,   &
          IF ( ( RIBB >= 0.1 ) .AND. ( FDOWN > 150.0 ) ) THEN
             ETP=(MIN(ETP*(1.0-RIBB),0.)*SNCOVR/0.980 + ETP*(0.980-SNCOVR))/0.980
          ENDIF
-        IF(ETP == 0.) BETA = 0.0
-        ETP1 = ETP * 0.001
+         IF(ETP == 0.) BETA = 0.0
+         ETP1 = ETP * 0.001
+         IF(UA_PHYS) ETP1N = ETPN * 0.001
          DEW = -ETP1
          ESNOW2 = ETP1*DT
          ETANRG = ETP*((1.-SNCOVR)*LSUBC + SNCOVR*LSUBS)
       ELSE
          ETP1 = ETP * 0.001
-         IF ( ICE /= 0 ) THEN
-            ! SEA-ICE AND GLACIAL-ICE CASE
-            ESNOW = ETP
-            ESNOW1 = ESNOW*0.001
-            ESNOW2 = ESNOW1*DT
-            ETANRG = ESNOW*LSUBS
-         ELSE IF ( ICE ==  0) THEN
-            ! NON-GLACIAL LAND CASE
-             IF (SNCOVR <  1.) THEN
-               CALL EVAPO (ETNS1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL,           &
-                            SH2O,                                       &
-                            SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT,          &
-                            SMCREF,SHDFAC,CMCMAX,                       &
-                            SMCDRY,CFACTR,                              &
-                            EDIR1,EC1,ET1,ETT1,SFCTMP,Q2,NROOT,RTDIS,   &
-                            FXEXP)
+         IF(UA_PHYS) ETP1N = ETPN * 0.001
+         !  LAND CASE
+         IF (SNCOVR <  1.) THEN
+            CALL EVAPO (ETNS1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL,           &
+                         SH2O,                                       &
+                         SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT,          &
+                         SMCREF,SHDFAC,CMCMAX,                       &
+                         SMCDRY,CFACTR,                              &
+                         EDIR1,EC1,ET1,ETT1,SFCTMP,Q2,NROOT,RTDIS,   &
+                         FXEXP, SFHEAD1RT,ETPND1)
 ! ----------------------------------------------------------------------------
-               EDIR1 = EDIR1* (1. - SNCOVR)
-               EC1 = EC1* (1. - SNCOVR)
-               DO K = 1,NSOIL
-                  ET1 (K) = ET1 (K)* (1. - SNCOVR)
-               END DO
-               ETT1 = ETT1*(1.-SNCOVR)
-!               ETNS1 = EDIR1+ EC1+ ETT1
-               ETNS1 = ETNS1*(1.-SNCOVR)
+            EDIR1 = EDIR1* (1. - SNCOVR)
+            EC1 = EC1* (1. - SNCOVR)
+            DO K = 1,NSOIL
+               ET1 (K) = ET1 (K)* (1. - SNCOVR)
+            END DO
+            ETT1 = ETT1*(1.-SNCOVR)
+!            ETNS1 = EDIR1+ EC1+ ETT1
+            ETNS1 = ETNS1*(1.-SNCOVR)
 ! ----------------------------------------------------------------------------
-               EDIR = EDIR1*1000.
-               EC = EC1*1000.
-               DO K = 1,NSOIL
-                  ET (K) = ET1 (K)*1000.
-               END DO
-               ETT = ETT1*1000.
-               ETNS = ETNS1*1000.
+            EDIR = EDIR1*1000.
+            EC = EC1*1000.
+            DO K = 1,NSOIL
+               ET (K) = ET1 (K)*1000.
+            END DO
+!
+! FASDAS
+!
+            if( fasdas ==  1 ) then
+              QFX_PHY = EDIR + EC
+              DO K=1,NSOIL
+                 QFX_PHY = QFX_PHY + ET(K)
+              END DO
+            endif
+!
+! END FASDAS
+!
+            ETT = ETT1*1000.
+            ETNS = ETNS1*1000.
+
+
+!DJG NDHMS/WRF-Hydro edit...
+               ETPND1 = ETPND1*1000.
+
+
 ! ----------------------------------------------------------------------
 
-!   end IF (SNCOVR .lt. 1.)
-            END IF
-!   end IF (ICE .ne. 1)
-         END IF
+         ENDIF
          ESNOW = ETP*SNCOVR
+         IF(UA_PHYS) ESNOW = ETPN*SNCOVR   ! USE ADJUSTED ETP
          ESNOW1 = ESNOW*0.001
          ESNOW2 = ESNOW1*DT
          ETANRG = ESNOW*LSUBS + ETNS*LSUBC
-!   end IF (ETP .le. 0.0)
-      END IF
+      ENDIF
 
 ! ----------------------------------------------------------------------
 ! IF PRECIP IS FALLING, CALCULATE HEAT FLUX FROM SNOW SFC TO NEWLY
@@ -3064,6 +3245,7 @@ SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT,   &
          EX = 0.0
 
          SNOMLT = 0.0
+         IF(UA_PHYS) FLX4 = 0.0
 ! ----------------------------------------------------------------------
 ! IF THE 'EFFECTIVE SNOW-GRND SFC TEMP' IS ABOVE FREEZING, SNOW MELT
 ! WILL OCCUR.  CALL THE SNOW MELT RATE,EX AND AMT, SNOMLT.  REVISE THE
@@ -3080,7 +3262,9 @@ SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT,   &
 ! ABOVE FREEZING BLOCK
 ! ----------------------------------------------------------------------
       ELSE
-         T1 = TFREEZ * SNCOVR ** SNOEXP + T12 * (1.0- SNCOVR ** SNOEXP)
+!     From V3.9 original code (commented) replaced to allow complete melting of small snow amounts
+!        T1 = TFREEZ * SNCOVR ** SNOEXP + T12 * (1.0- SNCOVR ** SNOEXP)
+         T1 = TFREEZ * max(0.01,SNCOVR ** SNOEXP) + T12 * (1.0- max(0.01,SNCOVR ** SNOEXP))
          BETA = 1.0
 
 ! ----------------------------------------------------------------------
@@ -3088,19 +3272,13 @@ SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT,   &
 ! BETA<1
 ! SNOWPACK HAS SUBLIMATED AWAY, SET DEPTH TO ZERO.
 ! ----------------------------------------------------------------------
-         IF ( ICE /= 0 ) then
-            ! kmh  12/15/2005 modify SSOIL
-            ! kmh  09/03/2006 modify DTOT
-            IF ( DTOT .GT. 2.0*DSOIL ) THEN
-               DTOT = 2.0*DSOIL
-            ENDIF
-         ENDIF
          SSOIL = DF1 * (T1- STC (1)) / DTOT
          IF (ESD-ESNOW2 <= ESDMIN) THEN
             ESD = 0.0
             EX = 0.0
             SNOMLT = 0.0
             FLX3 = 0.0
+            IF(UA_PHYS) FLX4 = 0.0
 ! ----------------------------------------------------------------------
 ! SUBLIMATION LESS THAN DEPTH OF SNOWPACK
 ! SNOWPACK (ESD) REDUCED BY ESNOW2 (DEPTH OF SUBLIMATED SNOW)
@@ -3116,6 +3294,18 @@ SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT,   &
 !                    SSOIL - SEH - ETANRG
             FLX3 = FDOWN - FLX1- FLX2- EMISSI*SIGMA * T14- SSOIL - SEH - ETANRG
             IF (FLX3 <= 0.0) FLX3 = 0.0
+
+            IF(UA_PHYS .AND. FLX4 > 0. .AND. FLX3 > 0.) THEN
+              IF(FLX3 >= FLX4) THEN
+                FLX3 = FLX3 - FLX4
+              ELSE
+                FLX4 = FLX3
+                FLX3 = 0.
+              ENDIF
+            ELSE
+              FLX4 = 0.0
+            ENDIF
+
 ! ----------------------------------------------------------------------
 ! SNOWMELT REDUCTION DEPENDING ON SNOW COVER
 ! ----------------------------------------------------------------------
@@ -3150,30 +3340,25 @@ SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT,   &
 ! IF NON-GLACIAL LAND, ADD SNOWMELT RATE (EX) TO PRECIP RATE TO BE USED
 ! IN SUBROUTINE SMFLX (SOIL MOISTURE EVOLUTION) VIA INFILTRATION.
 !
-! FOR SEA-ICE AND GLACIAL-ICE, THE SNOWMELT WILL BE ADDED TO SUBSURFACE
 ! RUNOFF/BASEFLOW LATER NEAR THE END OF SFLX (AFTER RETURN FROM CALL TO
 ! SUBROUTINE SNOPAC)
 ! ----------------------------------------------------------------------
-         IF (ICE == 0) PRCP1 = PRCP1+ EX
+         PRCP1 = PRCP1+ EX
 
 ! ----------------------------------------------------------------------
 ! SET THE EFFECTIVE POTNL EVAPOTRANSP (ETP1) TO ZERO SINCE THIS IS SNOW
 ! CASE, SO SURFACE EVAP NOT CALCULATED FROM EDIR, EC, OR ETT IN SMFLX
 ! (BELOW).
-! IF SEAICE (ICE==1) SKIP CALL TO SMFLX.
 ! SMFLX RETURNS UPDATED SOIL MOISTURE VALUES FOR NON-GLACIAL LAND.
-! IF SEA-ICE (ICE==1) OR GLACIAL-ICE (ICE==-1), SKIP CALL TO SMFLX,
-! SINCE NO SOIL MEDIUM FOR SEA-ICE OR GLACIAL-ICE.
 ! ----------------------------------------------------------------------
       END IF
-      IF (ICE == 0) THEN
-         CALL SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL,                      &
-                      SH2O,SLOPE,KDT,FRZFACT,                           &
-                      SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT,                   &
-                      SHDFAC,CMCMAX,                                    &
-                      RUNOFF1,RUNOFF2,RUNOFF3,                          &
-                      EDIR1,EC1,ET1,                                    &
-                      DRIP)
+      CALL SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL,                      &
+                   SH2O,SLOPE,KDT,FRZFACT,                           &
+                   SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT,                   &
+                   SHDFAC,CMCMAX,                                    &
+                   RUNOFF1,RUNOFF2,RUNOFF3,                          &
+                   EDIR1,EC1,ET1,                                    &
+                   DRIP, SFHEAD1RT,INFXS1RT)
 ! ----------------------------------------------------------------------
 ! BEFORE CALL SHFLX IN THIS SNOWPACK CASE, SET ZZ1 AND YY ARGUMENTS TO
 ! SPECIAL VALUES THAT ENSURE THAT GROUND HEAT FLUX CALCULATED IN SHFLX
@@ -3182,7 +3367,6 @@ SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT,   &
 ! SNOW TOP SURFACE.  T11 IS A DUMMY ARGUEMENT SO WE WILL NOT USE THE
 ! SKIN TEMP VALUE AS REVISED BY SHFLX.
 ! ----------------------------------------------------------------------
-      END IF
       ZZ1 = 1.0
       YY = STC (1) -0.5* SSOIL * ZSOIL (1)* ZZ1/ DF1
 
@@ -3194,54 +3378,32 @@ SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT,   &
 ! UPDATED INSTEAD NEAR THE BEGINNING OF THE CALL TO SNOPAC.
 ! ----------------------------------------------------------------------
       T11 = T1
-      CALL SHFLX (SSOIL1,STC,SMC,SMCMAX,NSOIL,T11,DT,YY,ZZ1,ZSOIL,      &
-                   TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1,ICE,        &
-                   QUARTZ,CSOIL,VEGTYP,ISURBAN)
+      CALL SHFLX (SSOIL1,STC,SMC,SMCMAX,NSOIL,T11,DT,YY,ZZ1,ZSOIL,     &
+                   TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1,           &
+                   QUARTZ,CSOIL,VEGTYP,ISURBAN,SOILTYP,OPT_THCND       &
+                  ,HCPCT_FASDAS                                        ) !fasdas
 
 ! ----------------------------------------------------------------------
 ! SNOW DEPTH AND DENSITY ADJUSTMENT BASED ON SNOW COMPACTION.  YY IS
 ! ASSUMED TO BE THE SOIL TEMPERTURE AT THE TOP OF THE SOIL COLUMN.
 ! ----------------------------------------------------------------------
-      IF (ICE == 0) THEN
-         ! NON-GLACIAL LAND
-         IF (ESD >  0.) THEN
-            CALL SNOWPACK (ESD,DT,SNOWH,SNDENS,T1,YY)
-         ELSE
-            ESD = 0.
-            SNOWH = 0.
-            SNDENS = 0.
-            SNCOND = 1.
-            SNCOVR = 0.
-         END IF
-      ELSEIF (ICE == 1) THEN
-         ! SEA-ICE
-         IF (ESD .GE. 0.01) THEN
-            CALL SNOWPACK (ESD,DT,SNOWH,SNDENS,T1,YY)
-        ELSE
-           ESD = 0.01
-           SNOWH = 0.05
-           !KWM???? SNDENS =
-           !KWM???? SNCOND =
-           SNCOVR = 1.0
-        ENDIF
-      ELSEIF (ICE == -1) THEN
-         ! GLACIAL-ICE
-         IF (ESD .GE. 0.10) THEN
-            CALL SNOWPACK (ESD,DT,SNOWH,SNDENS,T1,YY)
-         ELSE
-            ESD = 0.10
-            SNOWH = 0.50
-            !KWM???? SNDENS =
-            !KWM???? SNCOND =
-            SNCOVR = 1.0
-        ENDIF
-      ENDIF
+      ! LAND
+      IF (ESD >  0.) THEN
+         CALL SNOWPACK (ESD,DT,SNOWH,SNDENS,T1,YY,SNOMLT,UA_PHYS)
+      ELSE
+         ESD = 0.
+         SNOWH = 0.
+         SNDENS = 0.
+         SNCOND = 1.
+         SNCOVR = 0.
+      END IF
+
 ! ----------------------------------------------------------------------
   END SUBROUTINE SNOPAC
 ! ----------------------------------------------------------------------
 
 
-      SUBROUTINE SNOWPACK (ESD,DTSEC,SNOWH,SNDENS,TSNOW,TSOIL)
+      SUBROUTINE SNOWPACK (ESD,DTSEC,SNOWH,SNDENS,TSNOW,TSOIL,SNOMLT,UA_PHYS)
 
 ! ----------------------------------------------------------------------
 ! SUBROUTINE SNOWPACK
@@ -3269,11 +3431,15 @@ SUBROUTINE SNOWPACK (ESD,DTSEC,SNOWH,SNDENS,TSNOW,TSOIL)
                                 TAVGC,TSNOWC,TSOILC,ESDC,ESDCX
       REAL, PARAMETER        :: C1 = 0.01, C2 = 21.0, G = 9.81,         &
                                 KN = 4000.0
+      LOGICAL, INTENT(IN)    :: UA_PHYS  ! UA: flag for UA option
+      REAL, INTENT(IN)       :: SNOMLT   ! UA: snow melt [m]
+      REAL                   :: SNOMLTC  ! UA: snow melt [cm]
 ! ----------------------------------------------------------------------
 ! CONVERSION INTO SIMULATION UNITS
 ! ----------------------------------------------------------------------
       SNOWHC = SNOWH *100.
       ESDC = ESD *100.
+      IF(UA_PHYS) SNOMLTC = SNOMLT *100.
       DTHR = DTSEC /3600.
       TSNOWC = TSNOW -273.15
       TSOILC = TSOIL -273.15
@@ -3299,7 +3465,7 @@ SUBROUTINE SNOWPACK (ESD,DTSEC,SNOWH,SNDENS,TSNOW,TSOIL)
 
 !      DSX = SNDENS*((DEXP(BFAC*ESDC)-1.)/(BFAC*ESDC))
 ! ----------------------------------------------------------------------
-! THE FUNCTION OF THE FORM (e**x-1)/x IMBEDDED IN ABOVE EXPRESSION
+! THE FUNCTION OF THE FORM (e**x-1)/x EMBEDDED IN ABOVE EXPRESSION
 ! FOR DSX WAS CAUSING NUMERICAL DIFFICULTIES WHEN THE DENOMINATOR "x"
 ! (I.E. BFAC*ESDC) BECAME ZERO OR APPROACHED ZERO (DESPITE THE FACT THAT
 ! THE ANALYTICAL FUNCTION (e**x-1)/x HAS A WELL DEFINED LIMIT AS
@@ -3355,6 +3521,9 @@ SUBROUTINE SNOWPACK (ESD,DTSEC,SNOWH,SNDENS,TSNOW,TSOIL)
       SNDENS = DSX
       IF (TSNOWC >=  0.) THEN
          DW = 0.13* DTHR /24.
+         IF ( UA_PHYS .AND. TSOILC >= 0.) THEN
+             DW = MIN (DW, 0.13*SNOMLTC/(ESDCX+0.13*SNOMLTC))
+         ENDIF
          SNDENS = SNDENS * (1. - DW) + DW
          IF (SNDENS >=  0.40) SNDENS = 0.40
 ! ----------------------------------------------------------------------
@@ -3369,7 +3538,7 @@ SUBROUTINE SNOWPACK (ESD,DTSEC,SNOWH,SNDENS,TSNOW,TSOIL)
   END SUBROUTINE SNOWPACK
 ! ----------------------------------------------------------------------
 
-      SUBROUTINE SNOWZ0 (SNCOVR,Z0, Z0BRD, SNOWH)
+      SUBROUTINE SNOWZ0 (SNCOVR,Z0, Z0BRD, SNOWH,FBUR,FGSN,SHDMAX,UA_PHYS)
 
 ! ----------------------------------------------------------------------
 ! SUBROUTINE SNOWZ0
@@ -3381,22 +3550,38 @@ SUBROUTINE SNOWZ0 (SNCOVR,Z0, Z0BRD, SNOWH)
 ! ----------------------------------------------------------------------
       IMPLICIT NONE
       REAL, INTENT(IN)        :: SNCOVR, Z0BRD
-      REAL, INTENT(INOUT)       :: Z0
+      REAL, INTENT(OUT)       :: Z0
       REAL, PARAMETER         :: Z0S=0.001
       REAL, INTENT(IN)        :: SNOWH
       REAL                    :: BURIAL
       REAL                    :: Z0EFF
+      LOGICAL, INTENT(IN)     :: UA_PHYS   ! UA: flag for UA option
+      REAL, INTENT(IN)        :: FBUR      ! UA: fraction of canopy buried
+      REAL, INTENT(IN)        :: FGSN      ! UA: ground snow cover fraction
+      REAL, INTENT(IN)        :: SHDMAX    ! UA: maximum vegetation fraction
+      REAL, PARAMETER         :: Z0G=0.01  ! UA: soil roughness
+      REAL                    :: FV,A1,A2
 
-!m      Z0 = (1.- SNCOVR)* Z0BRD + SNCOVR * Z0S
-      BURIAL = 7.0*Z0BRD - SNOWH
-      IF(BURIAL.LE.0.0007) THEN
-        Z0EFF = Z0S
-      ELSE      
-        Z0EFF = BURIAL/7.0
-      ENDIF
+      IF(UA_PHYS) THEN
+
+          FV = SHDMAX * (1.-FBUR)
+          A1 = (1.-FV)**2*((1.-FGSN**2)*LOG(Z0G) + (FGSN**2)*LOG(Z0S))
+          A2 = (1.-(1.-FV)**2)*LOG(Z0BRD)
+          Z0 = EXP(A1+A2)
+
+      ELSE
+
+!m        Z0 = (1.- SNCOVR)* Z0BRD + SNCOVR * Z0S
+          BURIAL = 7.0*Z0BRD - SNOWH
+          IF(BURIAL.LE.0.0007) THEN
+              Z0EFF = Z0S
+          ELSE      
+              Z0EFF = BURIAL/7.0
+          ENDIF
       
-      Z0 = (1.- SNCOVR)* Z0BRD + SNCOVR * Z0EFF
+          Z0 = (1.- SNCOVR)* Z0BRD + SNCOVR * Z0EFF
 
+      ENDIF
 ! ----------------------------------------------------------------------
   END SUBROUTINE SNOWZ0
 ! ----------------------------------------------------------------------
@@ -3407,7 +3592,7 @@ SUBROUTINE SNOW_NEW (TEMP,NEWSN,SNOWH,SNDENS)
 ! ----------------------------------------------------------------------
 ! SUBROUTINE SNOW_NEW
 ! ----------------------------------------------------------------------
-! CALCULATE SNOW DEPTH AND DENSITITY TO ACCOUNT FOR THE NEW SNOWFALL.
+! CALCULATE SNOW DEPTH AND DENSITY TO ACCOUNT FOR THE NEW SNOWFALL.
 ! NEW VALUES OF SNOW DEPTH & DENSITY RETURNED.
 
 ! TEMP    AIR TEMPERATURE (K)
@@ -3456,7 +3641,8 @@ END SUBROUTINE SNOW_NEW
 
       SUBROUTINE SRT (RHSTT,EDIR,ET,SH2O,SH2OA,NSOIL,PCPDRP,            &
                        ZSOIL,DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1,           &
-                       RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZX,SICE,AI,BI,CI)
+                     RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZX,SICE,AI,BI,CI,  &
+                     SFHEAD1RT,INFXS1RT )
 
 ! ----------------------------------------------------------------------
 ! SUBROUTINE SRT
@@ -3468,13 +3654,20 @@ SUBROUTINE SRT (RHSTT,EDIR,ET,SH2O,SH2OA,NSOIL,PCPDRP,            &
       IMPLICIT NONE
       INTEGER, INTENT(IN)       :: NSOIL
       INTEGER                   :: IALP1, IOHINF, J, JJ,  K, KS
+
+!DJG NDHMS/WRF-Hydro edit... Variables used in OV routing infiltration calcs
+       REAL, INTENT(INOUT)     :: SFHEAD1RT, INFXS1RT
+       REAL                    :: SFCWATR,chcksm
+
+
+
       REAL, INTENT(IN)          :: BEXP, DKSAT, DT, DWSAT, EDIR, FRZX,  &
                                    KDT, PCPDRP, SLOPE, SMCMAX, SMCWLT
-      REAL, INTENT(INOUT)         :: RUNOFF1, RUNOFF2
+      REAL, INTENT(OUT)         :: RUNOFF1, RUNOFF2
       REAL, DIMENSION(1:NSOIL), INTENT(IN)   :: ET, SH2O, SH2OA, SICE,  &
                                                 ZSOIL
-      REAL, DIMENSION(1:NSOIL), INTENT(INOUT)  :: RHSTT
-      REAL, DIMENSION(1:NSOIL), INTENT(INOUT)  :: AI, BI, CI
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT)  :: RHSTT
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT)  :: AI, BI, CI
       REAL, DIMENSION(1:NSOIL)  :: DMAX
       REAL                      :: ACRT, DD, DDT, DDZ, DDZ2, DENOM,     &
                                    DENOM2,DICE, DSMDZ, DSMDZ2, DT1,     &
@@ -3511,15 +3704,34 @@ SUBROUTINE SRT (RHSTT,EDIR,ET,SH2O,SH2OA,NSOIL,PCPDRP,            &
 ! DETERMINE RAINFALL INFILTRATION RATE AND RUNOFF
 ! ----------------------------------------------------------------------
       END DO
+
+#ifdef WRF_HYDRO
+!DJG NDHMS/WRF-Hydro edit...
+!DJG Use previously merged Precip and Sfchead for infil. cap. calc.
+      SFCWATR = PCPDRP
+      PDDUM = SFCWATR
+!DJG original   PDDUM = PCPDRP
+      RUNOFF1 = 0.0
+      INFXS1RT = 0.0
+#else
       PDDUM = PCPDRP
       RUNOFF1 = 0.0
+#endif
+
+
 
 ! ----------------------------------------------------------------------
 ! MODIFIED BY Q. DUAN, 5/16/94
 ! ----------------------------------------------------------------------
 !        IF (IOHINF == 1) THEN
 
-      IF (PCPDRP /=  0.0) THEN
+#ifdef WRF_HYDRO
+!DJG NDHMS/WRF-Hydro edit...
+!DJG IF (PCPDRP /=  0.0) THEN
+      IF (SFCWATR /=  0.0) THEN
+#else
+     IF (PCPDRP /=  0.0) THEN
+#endif
          DT1 = DT /86400.
          SMCAV = SMCMAX - SMCWLT
 
@@ -3551,9 +3763,17 @@ SUBROUTINE SRT (RHSTT,EDIR,ET,SH2O,SH2OA,NSOIL,PCPDRP,            &
          END DO
          VAL = (1. - EXP ( - KDT * DT1))
          DDT = DD * VAL
+#ifdef WRF_HYDRO
+!DJG NDHMS/WRF-Hydro edit...
+!DJG        PX = PCPDRP * DT
+         PX = SFCWATR * DT
+#else
          PX = PCPDRP * DT
+#endif
          IF (PX <  0.0) PX = 0.0
 
+
+
 ! ----------------------------------------------------------------------
 ! FROZEN GROUND VERSION:
 ! REDUCTION OF INFILTRATION BASED ON FROZEN GROUND PARAMETERS
@@ -3588,10 +3808,20 @@ SUBROUTINE SRT (RHSTT,EDIR,ET,SH2O,SH2OA,NSOIL,PCPDRP,            &
          INFMAX = MAX (INFMAX,WCND)
 
          INFMAX = MIN (INFMAX,PX/DT)
+#ifdef WRF_HYDRO 
+!DJG NDHMS/WRF-Hydro edit...
+!DJG       IF (PCPDRP >  INFMAX) THEN
+         IF (SFCWATR > INFMAX) THEN
+!DJG          RUNOFF1 = PCPDRP - INFMAX
+          RUNOFF1 = SFCWATR - INFMAX
+#else
          IF (PCPDRP >  INFMAX) THEN
             RUNOFF1 = PCPDRP - INFMAX
-            PDDUM = INFMAX
+#endif
+          INFXS1RT = RUNOFF1*DT*1000.
+          PDDUM = INFMAX
          END IF
+
 ! ----------------------------------------------------------------------
 ! TO AVOID SPURIOUS DRAINAGE BEHAVIOR, 'UPSTREAM DIFFERENCING' IN LINE
 ! BELOW REPLACED WITH NEW APPROACH IN 2ND LINE:
@@ -3708,7 +3938,7 @@ END SUBROUTINE SRT
 
       SUBROUTINE SSTEP (SH2OOUT,SH2OIN,CMC,RHSTT,RHSCT,DT,              &
                         NSOIL,SMCMAX,CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,     &
-                        AI,BI,CI)
+                        AI,BI,CI, INFXS1RT)
 
 ! ----------------------------------------------------------------------
 ! SUBROUTINE SSTEP
@@ -3720,11 +3950,15 @@ SUBROUTINE SSTEP (SH2OOUT,SH2OIN,CMC,RHSTT,RHSCT,DT,              &
       INTEGER, INTENT(IN)       :: NSOIL
       INTEGER                   :: I, K, KK11
 
+!!DJG NDHMS/WRF-Hydro edit...
+      REAL, INTENT(INOUT)       :: INFXS1RT
+      REAL                      :: AVAIL
+
       REAL, INTENT(IN)          :: CMCMAX, DT, SMCMAX
-      REAL, INTENT(INOUT)         :: RUNOFF3
+      REAL, INTENT(OUT)         :: RUNOFF3
       REAL, INTENT(INOUT)       :: CMC
       REAL, DIMENSION(1:NSOIL), INTENT(IN)     :: SH2OIN, SICE, ZSOIL
-      REAL, DIMENSION(1:NSOIL), INTENT(INOUT)    :: SH2OOUT
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT)    :: SH2OOUT
       REAL, DIMENSION(1:NSOIL), INTENT(INOUT)  :: RHSTT, SMC
       REAL, DIMENSION(1:NSOIL), INTENT(INOUT)  :: AI, BI, CI
       REAL, DIMENSION(1:NSOIL)  :: RHSTTin
@@ -3781,6 +4015,43 @@ SUBROUTINE SSTEP (SH2OOUT,SH2OIN,CMC,RHSTT,RHSCT,DT,              &
          SMC (K) = MAX ( MIN (STOT,SMCMAX),0.02 )
          SH2OOUT (K) = MAX ( (SMC (K) - SICE (K)),0.0)
       END DO
+#ifdef WRF_HYDRO
+!DJG NDHMS/WRF-Hydro edit...
+!DJG Modifications to redstribute WPLUS/RUNOFF3 (soil moisture closure error) to soil profile
+!DJG beginning at bottom layer (NSOIL)
+         IF (WPLUS > 0.) THEN
+           DO K=NSOIL,2,-1
+
+               IF (K .eq. 2) THEN     !Assign soil depths
+                 DDZ = -ZSOIL(1)
+               ELSE
+                 DDZ = ZSOIL(K-2)-ZSOIL(K-1)
+               END IF
+
+               AVAIL = (SMCMAX - SMC(K-1)) * DDZ    !Det. Avail. Stor.
+
+!               print *, "ZZZZZ", K,DDZ,AVAIL,WPLUS,SMC(K),SMC(K-1),SMCMAX
+
+               IF (WPLUS <= AVAIL) THEN
+                 SMC(K-1) = SMC(K-1) + WPLUS/DDZ
+                 WPLUS = 0.
+               ELSE
+                 SMC(K-1) = SMCMAX
+                 WPLUS = WPLUS - AVAIL
+                 IF (K-1 .eq. 1) THEN
+                   INFXS1RT = INFXS1RT + WPLUS*1000
+                   WPLUS = 0.
+                 END IF
+               END IF
+
+!             SMC (K) = MAX ( MIN (STOT,SMCMAX),0.02 )
+             SH2OOUT (K) = MAX ( (SMC (K) - SICE (K)),0.0)
+
+           END DO
+         END IF
+!DJG NDHMS/WRF-Hydro edit...End of modification
+#endif
+
 
 ! ----------------------------------------------------------------------
 ! UPDATE CANOPY WATER CONTENT/INTERCEPTION (CMC).  CONVERT RHSCT TO
@@ -3807,7 +4078,7 @@ SUBROUTINE TBND (TU,TB,ZSOIL,ZBOT,K,NSOIL,TBND1)
       INTEGER, INTENT(IN)       :: NSOIL
       INTEGER                   :: K
       REAL, INTENT(IN)          :: TB, TU, ZBOT
-      REAL, INTENT(INOUT)         :: TBND1
+      REAL, INTENT(OUT)         :: TBND1
       REAL, DIMENSION(1:NSOIL), INTENT(IN)   :: ZSOIL
       REAL                      :: ZB, ZUP
       REAL, PARAMETER           :: T0 = 273.15
@@ -3839,7 +4110,7 @@ END SUBROUTINE TBND
 ! ----------------------------------------------------------------------
 
 
-      SUBROUTINE TDFCND ( DF, SMC, QZ, SMCMAX, SH2O)
+      SUBROUTINE TDFCND ( DF, SMC, QZ, SMCMAX, SH2O, BEXP, PSISAT, SOILTYP, OPT_THCND)
 
 ! ----------------------------------------------------------------------
 ! SUBROUTINE TDFCND
@@ -3851,11 +4122,12 @@ SUBROUTINE TDFCND ( DF, SMC, QZ, SMCMAX, SH2O)
 ! June 2001 CHANGES: FROZEN SOIL CONDITION.
 ! ----------------------------------------------------------------------
       IMPLICIT NONE
-      REAL, INTENT(IN)          :: QZ,  SMC, SMCMAX, SH2O
-      REAL, INTENT(INOUT)         :: DF
+      INTEGER, INTENT(IN)       :: SOILTYP, OPT_THCND  
+      REAL, INTENT(IN)          :: QZ,  SMC, SMCMAX, SH2O, BEXP, PSISAT
+      REAL, INTENT(OUT)         :: DF
       REAL                      :: AKE, GAMMD, THKDRY, THKICE, THKO,    &
                                    THKQTZ,THKSAT,THKS,THKW,SATRATIO,XU, &
-                                   XUNFROZ
+                                   XUNFROZ,AKEI,AKEL,PSIF,PF  
 
 ! ----------------------------------------------------------------------
 ! WE NOW GET QUARTZ AS AN INPUT ARGUMENT (SET IN ROUTINE REDPRM):
@@ -3886,6 +4158,9 @@ SUBROUTINE TDFCND ( DF, SMC, QZ, SMCMAX, SH2O)
 !              AND TEMPERATURES. JOURNAL OF THE ATMOSPHERIC SCIENCES,
 !              VOL. 55, PP. 1209-1224.
 ! ----------------------------------------------------------------------
+
+IF ( OPT_THCND == 1 .OR. ( OPT_THCND == 2 .AND. (SOILTYP /= 4 .AND. SOILTYP /= 3)) )THEN
+
 ! NEEDS PARAMETERS
 ! POROSITY(SOIL TYPE):
 !      POROS = SMCMAX
@@ -3919,11 +4194,9 @@ SUBROUTINE TDFCND ( DF, SMC, QZ, SMCMAX, SH2O)
 ! DRY THERMAL CONDUCTIVITY IN W.M-1.K-1
       THKDRY = (0.135* GAMMD+ 64.7)/ (2700. - 0.947* GAMMD)
 ! FROZEN
-      IF ( (SH2O + 0.0005) <  SMC ) THEN
-         AKE = SATRATIO
+         AKEI = SATRATIO
 ! UNFROZEN
 ! RANGE OF VALIDITY FOR THE KERSTEN NUMBER (AKE)
-      ELSE
 
 ! KERSTEN NUMBER (USING "FINE" FORMULA, VALID FOR SOILS CONTAINING AT
 ! LEAST 5% OF PARTICLES WITH DIAMETER LESS THAN 2.E-6 METERS.)
@@ -3931,18 +4204,34 @@ SUBROUTINE TDFCND ( DF, SMC, QZ, SMCMAX, SH2O)
 
          IF ( SATRATIO >  0.1 ) THEN
 
-            AKE = LOG10 (SATRATIO) + 1.0
+            AKEL = LOG10 (SATRATIO) + 1.0
 
 ! USE K = KDRY
          ELSE
 
-            AKE = 0.0
+            AKEL = 0.0
          END IF
+      AKE = ((SMC-SH2O)*AKEI + SH2O*AKEL)/SMC
 !  THERMAL CONDUCTIVITY
 
-      END IF
 
       DF = AKE * (THKSAT - THKDRY) + THKDRY
+
+    ELSE
+ 
+! use the Mccumber and Pielke approach for silt loam (4), sandy loam (3)
+
+         PSIF = PSISAT*100.*(SMCMAX/(SMC))**BEXP
+!--- PSIF should be in [CM] to compute PF
+           PF=log10(abs(PSIF))
+!--- HK is for McCumber thermal conductivity
+         IF(PF.LE.5.1) THEN
+           DF=420.*EXP(-(PF+2.7))
+         ELSE
+           DF=.1744
+         END IF
+
+    ENDIF  ! for OPT_THCND OPTIONS             
 ! ----------------------------------------------------------------------
   END SUBROUTINE TDFCND
 ! ----------------------------------------------------------------------
diff --git a/src/core_atmosphere/physics/physics_wrf/module_sf_noahlsm_glacial_only.F b/src/core_atmosphere/physics/physics_wrf/module_sf_noahlsm_glacial_only.F
new file mode 100644
index 0000000000..194968854d
--- /dev/null
+++ b/src/core_atmosphere/physics/physics_wrf/module_sf_noahlsm_glacial_only.F
@@ -0,0 +1,1280 @@
+MODULE module_sf_noahlsm_glacial_only
+#if defined(mpas)
+use mpas_atmphys_constants
+use mpas_atmphys_utilities, only: physics_error_fatal
+#define FATAL_ERROR(M) call physics_error_fatal( M )
+#else
+use module_model_constants
+use module_wrf_error
+#define FATAL_ERROR(M) call wrf_error_fatal( M )
+#endif
+
+  USE module_sf_noahlsm, ONLY : RD, SIGMA, CPH2O, CPICE, LSUBF, EMISSI_S, ROSR12
+  USE module_sf_noahlsm, ONLY : LVCOEF_DATA
+
+  PRIVATE :: ALCALC
+  PRIVATE :: CSNOW
+  PRIVATE :: HRTICE
+  PRIVATE :: HSTEP
+  PRIVATE :: PENMAN
+  PRIVATE :: SHFLX
+  PRIVATE :: SNOPAC
+  PRIVATE :: SNOWPACK
+  PRIVATE :: SNOWZ0
+  PRIVATE :: SNOW_NEW
+
+  integer, private :: iloc, jloc
+!$omp threadprivate(iloc, jloc)
+
+CONTAINS
+
+  SUBROUTINE SFLX_GLACIAL (IILOC,JJLOC,ISICE,FFROZP,DT,ZLVL,NSOIL,SLDPTH,     &    !C
+       &                   LWDN,SOLNET,SFCPRS,PRCP,SFCTMP,Q2,           &    !F
+       &                   TH2,Q2SAT,DQSDT2,                            &    !I
+       &                   ALB, SNOALB,TBOT, Z0BRD, Z0, EMISSI, EMBRD,  &    !S
+       &                   T1,STC,SNOWH,SNEQV,ALBEDO,CH,                &    !H
+! ----------------------------------------------------------------------
+! OUTPUTS, DIAGNOSTICS, PARAMETERS BELOW GENERALLY NOT NECESSARY WHEN
+! COUPLED WITH E.G. A NWP MODEL (SUCH AS THE NOAA/NWS/NCEP MESOSCALE ETA
+! MODEL).  OTHER APPLICATIONS MAY REQUIRE DIFFERENT OUTPUT VARIABLES.
+! ----------------------------------------------------------------------
+       &                   ETA,SHEAT, ETA_KINEMATIC,FDOWN,              &    !O
+       &                   ESNOW,DEW,                                   &    !O
+       &                   ETP,SSOIL,                                   &    !O
+       &                   FLX1,FLX2,FLX3,                              &    !O
+       &                   SNOMLT,SNCOVR,                               &    !O
+       &                   RUNOFF1,                                     &    !O
+       &                   Q1,                                          &    !D
+       &                   SNOTIME1,                                    &
+       &                   RIBB)
+! ----------------------------------------------------------------------
+! SUB-DRIVER FOR "Noah LSM" FAMILY OF PHYSICS SUBROUTINES FOR A
+! SOIL/VEG/SNOWPACK LAND-SURFACE MODEL TO UPDATE ICE TEMPERATURE, SKIN 
+! TEMPERATURE, SNOWPACK WATER CONTENT, SNOWDEPTH, AND ALL TERMS OF THE 
+! SURFACE ENERGY BALANCE (EXCLUDING INPUT ATMOSPHERIC FORCINGS OF 
+! DOWNWARD RADIATION AND PRECIP)
+! ----------------------------------------------------------------------
+! SFLX ARGUMENT LIST KEY:
+! ----------------------------------------------------------------------
+!  C  CONFIGURATION INFORMATION
+!  F  FORCING DATA
+!  I  OTHER (INPUT) FORCING DATA
+!  S  SURFACE CHARACTERISTICS
+!  H  HISTORY (STATE) VARIABLES
+!  O  OUTPUT VARIABLES
+!  D  DIAGNOSTIC OUTPUT
+! ----------------------------------------------------------------------
+! 1. CONFIGURATION INFORMATION (C):
+! ----------------------------------------------------------------------
+!   DT         TIMESTEP (SEC) (DT SHOULD NOT EXCEED 3600 SECS, RECOMMEND
+!                1800 SECS OR LESS)
+!   ZLVL       HEIGHT (M) ABOVE GROUND OF ATMOSPHERIC FORCING VARIABLES
+!   NSOIL      NUMBER OF SOIL LAYERS (AT LEAST 2, AND NOT GREATER THAN
+!                PARAMETER NSOLD SET BELOW)
+!   SLDPTH     THE THICKNESS OF EACH SOIL LAYER (M)
+! ----------------------------------------------------------------------
+! 3. FORCING DATA (F):
+! ----------------------------------------------------------------------
+!   LWDN       LW DOWNWARD RADIATION (W M-2; POSITIVE, NOT NET LONGWAVE)
+!   SOLNET     NET DOWNWARD SOLAR RADIATION ((W M-2; POSITIVE)
+!   SFCPRS     PRESSURE AT HEIGHT ZLVL ABOVE GROUND (PASCALS)
+!   PRCP       PRECIP RATE (KG M-2 S-1) (NOTE, THIS IS A RATE)
+!   SFCTMP     AIR TEMPERATURE (K) AT HEIGHT ZLVL ABOVE GROUND
+!   TH2        AIR POTENTIAL TEMPERATURE (K) AT HEIGHT ZLVL ABOVE GROUND
+!   Q2         MIXING RATIO AT HEIGHT ZLVL ABOVE GROUND (KG KG-1)
+!   FFROZP     FRACTION OF FROZEN PRECIPITATION
+! ----------------------------------------------------------------------
+! 4. OTHER FORCING (INPUT) DATA (I):
+! ----------------------------------------------------------------------
+!   Q2SAT      SAT SPECIFIC HUMIDITY AT HEIGHT ZLVL ABOVE GROUND (KG KG-1)
+!   DQSDT2     SLOPE OF SAT SPECIFIC HUMIDITY CURVE AT T=SFCTMP
+!                (KG KG-1 K-1)
+! ----------------------------------------------------------------------
+! 5. CANOPY/SOIL CHARACTERISTICS (S):
+! ----------------------------------------------------------------------
+!   ALB        BACKROUND SNOW-FREE SURFACE ALBEDO (FRACTION), FOR JULIAN
+!                DAY OF YEAR (USUALLY FROM TEMPORAL INTERPOLATION OF
+!                MONTHLY MEAN VALUES' CALLING PROG MAY OR MAY NOT
+!                INCLUDE DIURNAL SUN ANGLE EFFECT)
+!   SNOALB     UPPER BOUND ON MAXIMUM ALBEDO OVER DEEP SNOW (E.G. FROM
+!                ROBINSON AND KUKLA, 1985, J. CLIM. & APPL. METEOR.)
+!   TBOT       BOTTOM SOIL TEMPERATURE (LOCAL YEARLY-MEAN SFC AIR
+!                TEMPERATURE)
+!   Z0BRD      Background fixed roughness length (M)
+!   Z0         Time varying roughness length (M) as function of snow depth
+!   EMBRD      Background surface emissivity (between 0 and 1)
+!   EMISSI     Surface emissivity (between 0 and 1)
+! ----------------------------------------------------------------------
+! 6. HISTORY (STATE) VARIABLES (H):
+! ----------------------------------------------------------------------
+!  T1          GROUND/CANOPY/SNOWPACK) EFFECTIVE SKIN TEMPERATURE (K)
+!  STC(NSOIL)  SOIL TEMP (K)
+!  SNOWH       ACTUAL SNOW DEPTH (M)
+!  SNEQV       LIQUID WATER-EQUIVALENT SNOW DEPTH (M)
+!                NOTE: SNOW DENSITY = SNEQV/SNOWH
+!  ALBEDO      SURFACE ALBEDO INCLUDING SNOW EFFECT (UNITLESS FRACTION)
+!                =SNOW-FREE ALBEDO (ALB) WHEN SNEQV=0, OR
+!                =FCT(MSNOALB,ALB,SHDFAC,SHDMIN) WHEN SNEQV>0
+!  CH          SURFACE EXCHANGE COEFFICIENT FOR HEAT AND MOISTURE
+!                (M S-1); NOTE: CH IS TECHNICALLY A CONDUCTANCE SINCE
+!                IT HAS BEEN MULTIPLIED BY WIND SPEED.
+! ----------------------------------------------------------------------
+! 7. OUTPUT (O):
+! ----------------------------------------------------------------------
+! OUTPUT VARIABLES NECESSARY FOR A COUPLED NUMERICAL WEATHER PREDICTION
+! MODEL, E.G. NOAA/NWS/NCEP MESOSCALE ETA MODEL.  FOR THIS APPLICATION,
+! THE REMAINING OUTPUT/DIAGNOSTIC/PARAMETER BLOCKS BELOW ARE NOT
+! NECESSARY.  OTHER APPLICATIONS MAY REQUIRE DIFFERENT OUTPUT VARIABLES.
+!   ETA        ACTUAL LATENT HEAT FLUX (W m-2: NEGATIVE, IF UP FROM
+!              SURFACE)
+!  ETA_KINEMATIC atctual latent heat flux in Kg m-2 s-1
+!   SHEAT      SENSIBLE HEAT FLUX (W M-2: NEGATIVE, IF UPWARD FROM
+!              SURFACE)
+!   FDOWN      Radiation forcing at the surface (W m-2) = SOLDN*(1-alb)+LWDN
+! ----------------------------------------------------------------------
+!   ESNOW      SUBLIMATION FROM (OR DEPOSITION TO IF <0) SNOWPACK
+!                (W m-2)
+!   DEW        DEWFALL (OR FROSTFALL FOR T<273.15) (M)
+! ----------------------------------------------------------------------
+!   ETP        POTENTIAL EVAPORATION (W m-2)
+!   SSOIL      SOIL HEAT FLUX (W M-2: NEGATIVE IF DOWNWARD FROM SURFACE)
+! ----------------------------------------------------------------------
+!   FLX1       PRECIP-SNOW SFC (W M-2)
+!   FLX2       FREEZING RAIN LATENT HEAT FLUX (W M-2)
+!   FLX3       PHASE-CHANGE HEAT FLUX FROM SNOWMELT (W M-2)
+! ----------------------------------------------------------------------
+!   SNOMLT     SNOW MELT (M) (WATER EQUIVALENT)
+!   SNCOVR     FRACTIONAL SNOW COVER (UNITLESS FRACTION, 0-1)
+! ----------------------------------------------------------------------
+!   RUNOFF1    SURFACE RUNOFF (M S-1), NOT INFILTRATING THE SURFACE
+! ----------------------------------------------------------------------
+! 8. DIAGNOSTIC OUTPUT (D):
+! ----------------------------------------------------------------------
+!   Q1         Effective mixing ratio at surface (kg kg-1), used for
+!              diagnosing the mixing ratio at 2 meter for coupled model
+!  Documentation for SNOTIME1 and SNOABL2 ?????
+!  What categories of arguments do these variables fall into ????
+!  Documentation for RIBB ?????
+!  What category of argument does RIBB fall into ?????
+! ----------------------------------------------------------------------
+
+    IMPLICIT NONE
+! ----------------------------------------------------------------------
+    integer, intent(in) ::  iiloc, jjloc
+    INTEGER, INTENT(IN) ::  ISICE
+! ----------------------------------------------------------------------
+    LOGICAL             ::  FRZGRA, SNOWNG
+
+! ----------------------------------------------------------------------
+! 1. CONFIGURATION INFORMATION (C):
+! ----------------------------------------------------------------------
+    INTEGER, INTENT(IN) ::  NSOIL
+    INTEGER             ::  KZ
+
+! ----------------------------------------------------------------------
+! 2. LOGICAL:
+! ----------------------------------------------------------------------
+
+    REAL, INTENT(IN)   :: DT,DQSDT2,LWDN,PRCP,     &
+         &                Q2,Q2SAT,SFCPRS,SFCTMP, SNOALB,          &
+         &                SOLNET,TBOT,TH2,ZLVL,FFROZP
+    REAL, INTENT(OUT)  :: EMBRD, ALBEDO
+    REAL, INTENT(INOUT):: CH,SNEQV,SNCOVR,SNOWH,T1,Z0BRD,EMISSI,ALB
+    REAL, INTENT(INOUT):: SNOTIME1
+    REAL, INTENT(INOUT):: RIBB
+    REAL, DIMENSION(1:NSOIL), INTENT(IN)    :: SLDPTH
+    REAL, DIMENSION(1:NSOIL), INTENT(INOUT) ::  STC
+    REAL, DIMENSION(1:NSOIL) ::   ZSOIL
+
+    REAL,INTENT(OUT)   :: ETA_KINEMATIC,DEW,ESNOW,ETA,  &
+         &                ETP,FLX1,FLX2,FLX3,SHEAT,RUNOFF1,    &
+         &                SSOIL,SNOMLT,FDOWN,Q1
+    REAL               :: DF1,DSOIL,DTOT,FRCSNO,FRCSOI,          &
+         &                PRCP1,RCH,RR,RSNOW,SNDENS,SNCOND,SN_NEW,     &
+         &                T1V,T24,T2V,TH2V,TSNOW,Z0,PRCPF,RHO
+
+! ----------------------------------------------------------------------
+! DECLARATIONS - PARAMETERS
+! ----------------------------------------------------------------------
+    REAL, PARAMETER :: TFREEZ = 273.15
+    REAL, PARAMETER :: LVH2O = 2.501E+6
+    REAL, PARAMETER :: LSUBS = 2.83E+6
+    REAL, PARAMETER :: R = 287.04
+
+! ----------------------------------------------------------------------
+    iloc = iiloc
+    jloc = jjloc
+! ----------------------------------------------------------------------
+    ZSOIL (1) = - SLDPTH (1)
+    DO KZ = 2,NSOIL
+       ZSOIL (KZ) = - SLDPTH (KZ) + ZSOIL (KZ -1)
+    END DO
+
+! ----------------------------------------------------------------------
+! IF S.W.E. (SNEQV) BELOW THRESHOLD LOWER BOUND (0.10 M FOR GLACIAL 
+! ICE), THEN SET AT LOWER BOUND
+! ----------------------------------------------------------------------
+    IF ( SNEQV < 0.10 ) THEN
+       SNEQV = 0.10
+       SNOWH = 0.50
+    ENDIF
+! ----------------------------------------------------------------------
+! IF INPUT SNOWPACK IS NONZERO, THEN COMPUTE SNOW DENSITY "SNDENS" AND
+! SNOW THERMAL CONDUCTIVITY "SNCOND"
+! ----------------------------------------------------------------------
+    SNDENS = SNEQV / SNOWH
+    IF(SNDENS > 1.0) THEN
+       FATAL_ERROR( 'Physical snow depth is less than snow water equiv.' )
+    ENDIF
+
+    CALL CSNOW (SNCOND,SNDENS)
+! ----------------------------------------------------------------------
+! DETERMINE IF IT'S PRECIPITATING AND WHAT KIND OF PRECIP IT IS.
+! IF IT'S PRCPING AND THE AIR TEMP IS COLDER THAN 0 C, IT'S SNOWING!
+! IF IT'S PRCPING AND THE AIR TEMP IS WARMER THAN 0 C, BUT THE GRND
+! TEMP IS COLDER THAN 0 C, FREEZING RAIN IS PRESUMED TO BE FALLING.
+! ----------------------------------------------------------------------
+
+    SNOWNG = .FALSE.
+    FRZGRA = .FALSE.
+    IF (PRCP > 0.0) THEN
+! ----------------------------------------------------------------------
+! Snow defined when fraction of frozen precip (FFROZP) > 0.5,
+! passed in from model microphysics.
+! ----------------------------------------------------------------------
+       IF (FFROZP .GT. 0.5) THEN
+          SNOWNG = .TRUE.
+       ELSE
+          IF (T1 <= TFREEZ) FRZGRA = .TRUE.
+       END IF
+    END IF
+! ----------------------------------------------------------------------
+! IF EITHER PRCP FLAG IS SET, DETERMINE NEW SNOWFALL (CONVERTING PRCP
+! RATE FROM KG M-2 S-1 TO A LIQUID EQUIV SNOW DEPTH IN METERS) AND ADD
+! IT TO THE EXISTING SNOWPACK.
+! NOTE THAT SINCE ALL PRECIP IS ADDED TO SNOWPACK, NO PRECIP INFILTRATES
+! INTO THE SOIL SO THAT PRCP1 IS SET TO ZERO.
+! ----------------------------------------------------------------------
+    IF ( (SNOWNG) .OR. (FRZGRA) ) THEN
+       SN_NEW = PRCP * DT * 0.001
+       SNEQV = SNEQV + SN_NEW
+       PRCPF = 0.0
+
+! ----------------------------------------------------------------------
+! UPDATE SNOW DENSITY BASED ON NEW SNOWFALL, USING OLD AND NEW SNOW.
+! UPDATE SNOW THERMAL CONDUCTIVITY
+! ----------------------------------------------------------------------
+       CALL SNOW_NEW (SFCTMP,SN_NEW,SNOWH,SNDENS)
+
+! ----------------------------------------------------------------------
+! kmh 09/04/2006 set Snow Density at 0.2 g/cm**3
+! for "cold permanent ice" or new "dry" snow
+! if soil temperature less than 268.15 K, treat as typical 
+! Antarctic/Greenland snow firn
+! ----------------------------------------------------------------------
+       IF ( SNCOVR .GT. 0.99 ) THEN
+          IF ( STC(1) .LT. (TFREEZ - 5.) ) SNDENS = 0.2
+          IF ( SNOWNG .AND. (T1.LT.273.) .AND. (SFCTMP.LT.273.) ) SNDENS=0.2
+       ENDIF
+
+       CALL CSNOW (SNCOND,SNDENS)
+
+! ----------------------------------------------------------------------
+! PRECIP IS LIQUID (RAIN), HENCE SAVE IN THE PRECIP VARIABLE THAT
+! LATER CAN WHOLELY OR PARTIALLY INFILTRATE THE SOIL
+! ----------------------------------------------------------------------
+    ELSE
+       PRCPF = PRCP
+    ENDIF
+
+! ----------------------------------------------------------------------
+! DETERMINE SNOW FRACTIONAL COVERAGE.
+!      KWM:  Set SNCOVR to 1.0 because SNUP is set small in VEGPARM.TBL,
+!      and SNEQV is at least 0.1 (as set above)
+! ----------------------------------------------------------------------
+    SNCOVR = 1.0 
+
+! ----------------------------------------------------------------------
+! DETERMINE SURFACE ALBEDO MODIFICATION DUE TO SNOWDEPTH STATE.
+! ----------------------------------------------------------------------
+
+    CALL ALCALC (ALB,SNOALB,EMBRD,T1,ALBEDO,EMISSI,   &
+         &       DT,SNOWNG,SNOTIME1) 
+
+! ----------------------------------------------------------------------
+! THERMAL CONDUCTIVITY 
+! ----------------------------------------------------------------------
+    DF1 = SNCOND
+
+    DSOIL = - (0.5 * ZSOIL (1))
+    DTOT = SNOWH + DSOIL
+    FRCSNO = SNOWH / DTOT
+
+! 1. HARMONIC MEAN (SERIES FLOW)
+!        DF1 = (SNCOND*DF1)/(FRCSOI*SNCOND+FRCSNO*DF1)
+    FRCSOI = DSOIL / DTOT
+
+! 3. GEOMETRIC MEAN (INTERMEDIATE BETWEEN HARMONIC AND ARITHMETIC MEAN)
+!        DF1 = (SNCOND**FRCSNO)*(DF1**FRCSOI)
+    DF1 = FRCSNO * SNCOND + FRCSOI * DF1
+
+! ----------------------------------------------------------------------
+! CALCULATE SUBSURFACE HEAT FLUX, SSOIL, FROM FINAL THERMAL DIFFUSIVITY
+! OF SURFACE MEDIUMS, DF1 ABOVE, AND SKIN TEMPERATURE AND TOP
+! MID-LAYER SOIL TEMPERATURE
+! ----------------------------------------------------------------------
+    IF ( DTOT .GT. 2.*DSOIL ) then
+       DTOT = 2.*DSOIL
+    ENDIF
+    SSOIL = DF1 * ( T1 - STC(1) ) / DTOT
+
+! ----------------------------------------------------------------------
+! DETERMINE SURFACE ROUGHNESS OVER SNOWPACK USING SNOW CONDITION FROM
+! THE PREVIOUS TIMESTEP.
+! ----------------------------------------------------------------------
+
+    CALL SNOWZ0 (Z0,Z0BRD,SNOWH)
+
+! ----------------------------------------------------------------------
+! CALCULATE TOTAL DOWNWARD RADIATION (SOLAR PLUS LONGWAVE) NEEDED IN
+! PENMAN EP SUBROUTINE THAT FOLLOWS
+! ----------------------------------------------------------------------
+
+    FDOWN = SOLNET + LWDN
+
+! ----------------------------------------------------------------------
+! CALC VIRTUAL TEMPS AND VIRTUAL POTENTIAL TEMPS NEEDED BY SUBROUTINES
+! PENMAN.
+! ----------------------------------------------------------------------
+
+    T2V = SFCTMP * (1.0+ 0.61 * Q2 )
+    RHO = SFCPRS / (RD * T2V)
+    RCH = RHO * 1004.6 * CH
+    T24 = SFCTMP * SFCTMP * SFCTMP * SFCTMP
+
+! ----------------------------------------------------------------------
+! CALL PENMAN SUBROUTINE TO CALCULATE POTENTIAL EVAPORATION (ETP), AND
+! OTHER PARTIAL PRODUCTS AND SUMS SAVE IN COMMON/RITE FOR LATER
+! CALCULATIONS.
+! ----------------------------------------------------------------------
+
+    ! PENMAN returns ETP, FLX2, and RR
+    CALL PENMAN (SFCTMP,SFCPRS,CH,TH2,PRCP,FDOWN,T24,SSOIL,     &
+         &       Q2,Q2SAT,ETP,RCH,RR,SNOWNG,FRZGRA,             &
+         &       DQSDT2,FLX2,EMISSI,T1)
+
+    CALL SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,NSOIL,DT,DF1,        &
+         &       Q2,T1,SFCTMP,T24,TH2,FDOWN,SSOIL,STC,          &
+         &       SFCPRS,RCH,RR,SNEQV,SNDENS,SNOWH,ZSOIL,TBOT,   &
+         &       SNOMLT,DEW,FLX1,FLX2,FLX3,ESNOW,EMISSI,RIBB)
+
+!   ETA_KINEMATIC =  ESNOW
+    ETA_KINEMATIC =  ETP
+
+! ----------------------------------------------------------------------
+! Effective mixing ratio at grnd level (skin)
+! ----------------------------------------------------------------------
+    Q1=Q2+ETA_KINEMATIC*CP/RCH
+
+! ----------------------------------------------------------------------
+! DETERMINE SENSIBLE HEAT (H) IN ENERGY UNITS (W M-2)
+! ----------------------------------------------------------------------
+    SHEAT = - (CH * CP * SFCPRS)/ (R * T2V) * ( TH2- T1 )
+
+! ----------------------------------------------------------------------
+! CONVERT EVAP TERMS FROM KINEMATIC (KG M-2 S-1) TO ENERGY UNITS (W M-2)
+! ----------------------------------------------------------------------
+    ESNOW = ESNOW * LSUBS
+    ETP   = ETP   * LSUBS
+    IF (ETP .GT. 0.) THEN
+       ETA = ESNOW
+    ELSE
+       ETA = ETP
+    ENDIF
+
+! ----------------------------------------------------------------------
+! CONVERT THE SIGN OF SOIL HEAT FLUX SO THAT:
+!   SSOIL>0: WARM THE SURFACE  (NIGHT TIME)
+!   SSOIL<0: COOL THE SURFACE  (DAY TIME)
+! ----------------------------------------------------------------------
+    SSOIL = -1.0* SSOIL
+
+! ----------------------------------------------------------------------
+! FOR THE CASE OF GLACIAL-ICE, ADD ANY SNOWMELT DIRECTLY TO SURFACE 
+! RUNOFF (RUNOFF1) SINCE THERE IS NO SOIL MEDIUM
+! ----------------------------------------------------------------------
+    RUNOFF1 = SNOMLT / DT
+
+! ----------------------------------------------------------------------
+  END SUBROUTINE SFLX_GLACIAL
+! ----------------------------------------------------------------------
+
+  SUBROUTINE ALCALC (ALB,SNOALB,EMBRD,TSNOW,ALBEDO,EMISSI,   &
+       &             DT,SNOWNG,SNOTIME1)
+
+! ----------------------------------------------------------------------
+! CALCULATE ALBEDO INCLUDING SNOW EFFECT (0 -> 1)
+!   ALB     SNOWFREE ALBEDO
+!   SNOALB  MAXIMUM (DEEP) SNOW ALBEDO
+!   ALBEDO  SURFACE ALBEDO INCLUDING SNOW EFFECT
+!   TSNOW   SNOW SURFACE TEMPERATURE (K)
+! ----------------------------------------------------------------------
+    IMPLICIT NONE
+
+! ----------------------------------------------------------------------
+! SNOALB IS ARGUMENT REPRESENTING MAXIMUM ALBEDO OVER DEEP SNOW,
+! AS PASSED INTO SFLX, AND ADAPTED FROM THE SATELLITE-BASED MAXIMUM
+! SNOW ALBEDO FIELDS PROVIDED BY D. ROBINSON AND G. KUKLA
+! (1985, JCAM, VOL 24, 402-411)
+! ----------------------------------------------------------------------
+    REAL,    INTENT(IN)    :: ALB, SNOALB, EMBRD, TSNOW
+    REAL,    INTENT(IN)    :: DT
+    LOGICAL, INTENT(IN)    :: SNOWNG
+    REAL,    INTENT(INOUT) :: SNOTIME1
+    REAL,    INTENT(OUT)   :: ALBEDO, EMISSI
+    REAL                   :: SNOALB2
+    REAL                   :: TM,SNOALB1
+    REAL,    PARAMETER     :: SNACCA=0.94,SNACCB=0.58,SNTHWA=0.82,SNTHWB=0.46
+! turn off vegetation effect
+!      ALBEDO = ALB + (1.0- (SHDFAC - SHDMIN))* SNCOVR * (SNOALB - ALB)
+!      ALBEDO = (1.0-SNCOVR)*ALB + SNCOVR*SNOALB !this is equivalent to below
+    ALBEDO = ALB + (SNOALB-ALB)
+    EMISSI = EMBRD + (EMISSI_S - EMBRD)
+
+!     BASE FORMULATION (DICKINSON ET AL., 1986, COGLEY ET AL., 1990)
+!          IF (TSNOW.LE.263.16) THEN
+!            ALBEDO=SNOALB
+!          ELSE
+!            IF (TSNOW.LT.273.16) THEN
+!              TM=0.1*(TSNOW-263.16)
+!              SNOALB1=0.5*((0.9-0.2*(TM**3))+(0.8-0.16*(TM**3)))
+!            ELSE
+!              SNOALB1=0.67
+!             IF(SNCOVR.GT.0.95) SNOALB1= 0.6
+!             SNOALB1 = ALB + SNCOVR*(SNOALB-ALB)
+!            ENDIF
+!          ENDIF
+!            ALBEDO = ALB + SNCOVR*(SNOALB1-ALB)
+
+!     ISBA FORMULATION (VERSEGHY, 1991; BAKER ET AL., 1990)
+!          SNOALB1 = SNOALB+COEF*(0.85-SNOALB)
+!          SNOALB2=SNOALB1
+!!m          LSTSNW=LSTSNW+1
+!          SNOTIME1 = SNOTIME1 + DT
+!          IF (SNOWNG) THEN
+!             SNOALB2=SNOALB
+!!m             LSTSNW=0
+!             SNOTIME1 = 0.0
+!          ELSE
+!            IF (TSNOW.LT.273.16) THEN
+!!              SNOALB2=SNOALB-0.008*LSTSNW*DT/86400
+!!m              SNOALB2=SNOALB-0.008*SNOTIME1/86400
+!              SNOALB2=(SNOALB2-0.65)*EXP(-0.05*DT/3600)+0.65
+!!              SNOALB2=(ALBEDO-0.65)*EXP(-0.01*DT/3600)+0.65
+!            ELSE
+!              SNOALB2=(SNOALB2-0.5)*EXP(-0.0005*DT/3600)+0.5
+!!              SNOALB2=(SNOALB-0.5)*EXP(-0.24*LSTSNW*DT/86400)+0.5
+!!m              SNOALB2=(SNOALB-0.5)*EXP(-0.24*SNOTIME1/86400)+0.5
+!            ENDIF
+!          ENDIF
+!
+!!               print*,'SNOALB2',SNOALB2,'ALBEDO',ALBEDO,'DT',DT
+!          ALBEDO = ALB + SNCOVR*(SNOALB2-ALB)
+!          IF (ALBEDO .GT. SNOALB2) ALBEDO=SNOALB2
+!!m          LSTSNW1=LSTSNW
+!!          SNOTIME = SNOTIME1
+
+! formulation by Livneh
+! ----------------------------------------------------------------------
+! SNOALB IS CONSIDERED AS THE MAXIMUM SNOW ALBEDO FOR NEW SNOW, AT
+! A VALUE OF 85%. SNOW ALBEDO CURVE DEFAULTS ARE FROM BRAS P.263. SHOULD
+! NOT BE CHANGED EXCEPT FOR SERIOUS PROBLEMS WITH SNOW MELT.
+! TO IMPLEMENT ACCUMULATIN PARAMETERS, SNACCA AND SNACCB, ASSERT THAT IT
+! IS INDEED ACCUMULATION SEASON. I.E. THAT SNOW SURFACE TEMP IS BELOW
+! ZERO AND THE DATE FALLS BETWEEN OCTOBER AND FEBRUARY
+! ----------------------------------------------------------------------
+    SNOALB1 = SNOALB+LVCOEF_DATA*(0.85-SNOALB)
+    SNOALB2=SNOALB1
+! ---------------- Initial LSTSNW --------------------------------------
+    IF (SNOWNG) THEN
+       SNOTIME1 = 0.
+    ELSE
+       SNOTIME1=SNOTIME1+DT
+!               IF (TSNOW.LT.273.16) THEN
+       SNOALB2=SNOALB1*(SNACCA**((SNOTIME1/86400.0)**SNACCB))
+!               ELSE
+!                  SNOALB2 =SNOALB1*(SNTHWA**((SNOTIME1/86400.0)**SNTHWB))
+!               ENDIF
+    ENDIF
+
+    SNOALB2 = MAX ( SNOALB2, ALB )
+    ALBEDO = ALB + (SNOALB2-ALB)
+    IF (ALBEDO .GT. SNOALB2) ALBEDO=SNOALB2
+
+!          IF (TSNOW.LT.273.16) THEN
+!            ALBEDO=SNOALB-0.008*DT/86400
+!          ELSE
+!            ALBEDO=(SNOALB-0.5)*EXP(-0.24*DT/86400)+0.5
+!          ENDIF
+
+!      IF (ALBEDO > SNOALB) ALBEDO = SNOALB
+
+! ----------------------------------------------------------------------
+  END SUBROUTINE ALCALC
+! ----------------------------------------------------------------------
+
+  SUBROUTINE CSNOW (SNCOND,DSNOW)
+
+! ----------------------------------------------------------------------
+! CALCULATE SNOW TERMAL CONDUCTIVITY
+! ----------------------------------------------------------------------
+    IMPLICIT NONE
+    REAL, INTENT(IN)  :: DSNOW
+    REAL, INTENT(OUT) :: SNCOND
+    REAL              :: C
+    REAL, PARAMETER   :: UNIT = 0.11631
+
+! ----------------------------------------------------------------------
+! SNCOND IN UNITS OF CAL/(CM*HR*C), RETURNED IN W/(M*C)
+! CSNOW IN UNITS OF CAL/(CM*HR*C), RETURNED IN W/(M*C)
+! BASIC VERSION IS DYACHKOVA EQUATION (1960), FOR RANGE 0.1-0.4
+! ----------------------------------------------------------------------
+    C = 0.328*10** (2.25* DSNOW)
+!      CSNOW=UNIT*C
+
+! ----------------------------------------------------------------------
+! DE VAUX EQUATION (1933), IN RANGE 0.1-0.6
+! ----------------------------------------------------------------------
+!      SNCOND=0.0293*(1.+100.*DSNOW**2)
+!      CSNOW=0.0293*(1.+100.*DSNOW**2)
+
+! ----------------------------------------------------------------------
+! E. ANDERSEN FROM FLERCHINGER
+! ----------------------------------------------------------------------
+!      SNCOND=0.021+2.51*DSNOW**2
+!      CSNOW=0.021+2.51*DSNOW**2
+
+!      SNCOND = UNIT * C
+! double snow thermal conductivity
+    SNCOND = 2.0 * UNIT * C
+
+! ----------------------------------------------------------------------
+  END SUBROUTINE CSNOW
+! ----------------------------------------------------------------------
+
+  SUBROUTINE HRTICE (RHSTS,STC,TBOT,NSOIL,ZSOIL,YY,ZZ1,DF1,AI,BI,CI)
+
+! ----------------------------------------------------------------------
+! CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY TERM OF THE SOIL
+! THERMAL DIFFUSION EQUATION IN THE CASE OF SEA-ICE (ICE=1) OR GLACIAL
+! ICE (ICE=-1). COMPUTE (PREPARE) THE MATRIX COEFFICIENTS FOR THE
+! TRI-DIAGONAL MATRIX OF THE IMPLICIT TIME SCHEME.
+!
+! (NOTE:  THIS SUBROUTINE ONLY CALLED FOR SEA-ICE OR GLACIAL ICE, BUT
+! NOT FOR NON-GLACIAL LAND (ICE = 0).
+! ----------------------------------------------------------------------
+    IMPLICIT NONE
+
+
+    INTEGER,                  INTENT(IN)  :: NSOIL
+    REAL,                     INTENT(IN)  :: DF1,YY,ZZ1
+    REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: AI, BI,CI
+    REAL, DIMENSION(1:NSOIL), INTENT(IN)  :: STC, ZSOIL
+    REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: RHSTS
+    REAL,                     INTENT(IN)  :: TBOT
+    INTEGER                :: K
+    REAL                   :: DDZ,DDZ2,DENOM,DTSDZ,DTSDZ2,SSOIL,HCPCT
+    REAL                   :: DF1K,DF1N
+    REAL                   :: ZMD
+    REAL, PARAMETER        :: ZBOT = -25.0
+
+! ----------------------------------------------------------------------
+! SET A NOMINAL UNIVERSAL VALUE OF GLACIAL-ICE SPECIFIC HEAT CAPACITY,
+!   HCPCT = 2100.0*900.0 = 1.89000E+6 (SOURCE:  BOB GRUMBINE, 2005)
+!   TBOT PASSED IN AS ARGUMENT, VALUE FROM GLOBAL DATA SET
+    !
+    ! A least-squares fit for the four points provided by
+    ! Keith Hines for the Yen (1981) values for Antarctic
+    ! snow firn.
+    !
+    HCPCT = 1.E6 * (0.8194 - 0.1309*0.5*ZSOIL(1))
+    DF1K = DF1
+
+! ----------------------------------------------------------------------
+! THE INPUT ARGUMENT DF1 IS A UNIVERSALLY CONSTANT VALUE OF SEA-ICE
+! THERMAL DIFFUSIVITY, SET IN ROUTINE SNOPAC AS DF1 = 2.2.
+! ----------------------------------------------------------------------
+! SET ICE PACK DEPTH.  USE TBOT AS ICE PACK LOWER BOUNDARY TEMPERATURE
+! (THAT OF UNFROZEN SEA WATER AT BOTTOM OF SEA ICE PACK).  ASSUME ICE
+! PACK IS OF N=NSOIL LAYERS SPANNING A UNIFORM CONSTANT ICE PACK
+! THICKNESS AS DEFINED BY ZSOIL(NSOIL) IN ROUTINE SFLX.
+! ----------------------------------------------------------------------
+! ----------------------------------------------------------------------
+! CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER
+! ----------------------------------------------------------------------
+    DDZ = 1.0 / ( -0.5 * ZSOIL (2) )
+    AI (1) = 0.0
+    CI (1) = (DF1 * DDZ) / (ZSOIL (1) * HCPCT)
+
+! ----------------------------------------------------------------------
+! CALC THE VERTICAL SOIL TEMP GRADIENT BTWN THE TOP AND 2ND SOIL LAYERS.
+! RECALC/ADJUST THE SOIL HEAT FLUX.  USE THE GRADIENT AND FLUX TO CALC
+! RHSTS FOR THE TOP SOIL LAYER.
+! ----------------------------------------------------------------------
+    BI (1) = - CI (1) + DF1/ (0.5 * ZSOIL (1) * ZSOIL (1) * HCPCT *    &
+         &   ZZ1)
+    DTSDZ = ( STC (1) - STC (2) ) / ( -0.5 * ZSOIL (2) )
+    SSOIL = DF1 * ( STC (1) - YY ) / ( 0.5 * ZSOIL (1) * ZZ1 )
+
+! ----------------------------------------------------------------------
+! INITIALIZE DDZ2
+! ----------------------------------------------------------------------
+    RHSTS (1) = ( DF1 * DTSDZ - SSOIL ) / ( ZSOIL (1) * HCPCT )
+
+! ----------------------------------------------------------------------
+! LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABOVE PROCESS
+! ----------------------------------------------------------------------
+    DDZ2 = 0.0
+    DF1K = DF1
+    DF1N = DF1
+    DO K = 2,NSOIL
+
+       ZMD = 0.5 * (ZSOIL(K)+ZSOIL(K-1))
+       ! For the land-ice case
+! kmh 09/03/2006 use Yen (1981)'s values for Antarctic snow firn
+!         IF ( K .eq. 2 ) HCPCT = 0.855108E6
+!         IF ( K .eq. 3 ) HCPCT = 0.922906E6
+!         IF ( K .eq. 4 ) HCPCT = 1.009986E6
+
+       ! Least squares fit to the four points supplied by Keith Hines
+       ! from Yen (1981) for Antarctic snow firn.  Not optimal, but
+       ! probably better than just a constant.
+       HCPCT = 1.E6 * ( 0.8194 - 0.1309*ZMD )
+
+!         IF ( K .eq. 2 ) DF1N = 0.345356
+!         IF ( K .eq. 3 ) DF1N = 0.398777
+!         IF ( K .eq. 4 ) DF1N = 0.472653
+
+       ! Least squares fit to the three points supplied by Keith Hines
+       ! from Yen (1981) for Antarctic snow firn.  Not optimal, but
+       ! probably better than just a constant.
+       DF1N = 0.32333 - ( 0.10073 * ZMD )
+! ----------------------------------------------------------------------
+! CALC THE VERTICAL SOIL TEMP GRADIENT THRU THIS LAYER.
+! ----------------------------------------------------------------------
+       IF (K /= NSOIL) THEN
+          DENOM = 0.5 * ( ZSOIL (K -1) - ZSOIL (K +1) )
+
+! ----------------------------------------------------------------------
+! CALC THE MATRIX COEF, CI, AFTER CALC'NG ITS PARTIAL PRODUCT.
+! ----------------------------------------------------------------------
+          DTSDZ2 = ( STC (K) - STC (K +1) ) / DENOM
+          DDZ2 = 2. / (ZSOIL (K -1) - ZSOIL (K +1))
+          CI (K) = - DF1N * DDZ2 / ( (ZSOIL (K -1) - ZSOIL (K))*HCPCT)
+
+! ----------------------------------------------------------------------
+! CALC THE VERTICAL SOIL TEMP GRADIENT THRU THE LOWEST LAYER.
+! ----------------------------------------------------------------------
+       ELSE
+
+! ----------------------------------------------------------------------
+! SET MATRIX COEF, CI TO ZERO.
+! ----------------------------------------------------------------------
+          DTSDZ2 = (STC (K) - TBOT)/ (.5 * (ZSOIL (K -1) + ZSOIL (K)) &
+               &   - ZBOT)
+          CI (K) = 0.
+! ----------------------------------------------------------------------
+! CALC RHSTS FOR THIS LAYER AFTER CALC'NG A PARTIAL PRODUCT.
+! ----------------------------------------------------------------------
+       END IF
+       DENOM = ( ZSOIL (K) - ZSOIL (K -1) ) * HCPCT
+
+! ----------------------------------------------------------------------
+! CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER.
+! ----------------------------------------------------------------------
+       RHSTS (K) = ( DF1N * DTSDZ2- DF1K * DTSDZ ) / DENOM
+       AI (K) = - DF1K * DDZ / ( (ZSOIL (K -1) - ZSOIL (K)) * HCPCT)
+
+! ----------------------------------------------------------------------
+! RESET VALUES OF DTSDZ AND DDZ FOR LOOP TO NEXT SOIL LYR.
+! ----------------------------------------------------------------------
+       BI (K) = - (AI (K) + CI (K))
+       DF1K = DF1N
+       DTSDZ = DTSDZ2
+       DDZ = DDZ2
+    END DO
+! ----------------------------------------------------------------------
+  END SUBROUTINE HRTICE
+! ----------------------------------------------------------------------
+
+  SUBROUTINE HSTEP (STCOUT,STCIN,RHSTS,DT,NSOIL,AI,BI,CI)
+
+! ----------------------------------------------------------------------
+! CALCULATE/UPDATE THE SOIL TEMPERATURE FIELD.
+! ----------------------------------------------------------------------
+    IMPLICIT NONE
+    INTEGER,                  INTENT(IN)    :: NSOIL
+    REAL, DIMENSION(1:NSOIL), INTENT(IN)    :: STCIN
+    REAL, DIMENSION(1:NSOIL), INTENT(OUT)   :: STCOUT
+    REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: RHSTS
+    REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: AI,BI,CI
+    REAL, DIMENSION(1:NSOIL) :: RHSTSin
+    REAL, DIMENSION(1:NSOIL) :: CIin
+    REAL                     :: DT
+    INTEGER                  :: K
+
+! ----------------------------------------------------------------------
+! CREATE FINITE DIFFERENCE VALUES FOR USE IN ROSR12 ROUTINE
+! ----------------------------------------------------------------------
+    DO K = 1,NSOIL
+       RHSTS (K) = RHSTS (K) * DT
+       AI (K) = AI (K) * DT
+       BI (K) = 1. + BI (K) * DT
+       CI (K) = CI (K) * DT
+    END DO
+! ----------------------------------------------------------------------
+! COPY VALUES FOR INPUT VARIABLES BEFORE CALL TO ROSR12
+! ----------------------------------------------------------------------
+    DO K = 1,NSOIL
+       RHSTSin (K) = RHSTS (K)
+    END DO
+    DO K = 1,NSOIL
+       CIin (K) = CI (K)
+    END DO
+! ----------------------------------------------------------------------
+! SOLVE THE TRI-DIAGONAL MATRIX EQUATION
+! ----------------------------------------------------------------------
+    CALL ROSR12 (CI,AI,BI,CIin,RHSTSin,RHSTS,NSOIL)
+! ----------------------------------------------------------------------
+! CALC/UPDATE THE SOIL TEMPS USING MATRIX SOLUTION
+! ----------------------------------------------------------------------
+    DO K = 1,NSOIL
+       STCOUT (K) = STCIN (K) + CI (K)
+    END DO
+! ----------------------------------------------------------------------
+  END SUBROUTINE HSTEP
+! ----------------------------------------------------------------------
+
+  SUBROUTINE PENMAN (SFCTMP,SFCPRS,CH,TH2,PRCP,FDOWN,T24,SSOIL, &
+       &             Q2,Q2SAT,ETP,RCH,RR,SNOWNG,FRZGRA,       &
+       &             DQSDT2,FLX2,EMISSI,T1)
+
+! ----------------------------------------------------------------------
+! CALCULATE POTENTIAL EVAPORATION FOR THE CURRENT POINT.  VARIOUS
+! PARTIAL SUMS/PRODUCTS ARE ALSO CALCULATED AND PASSED BACK TO THE
+! CALLING ROUTINE FOR LATER USE.
+! ----------------------------------------------------------------------
+    IMPLICIT NONE
+    LOGICAL, INTENT(IN)  :: SNOWNG, FRZGRA
+    REAL,    INTENT(IN)  :: CH, DQSDT2,FDOWN,PRCP,Q2,Q2SAT,SSOIL,SFCPRS, &
+         &                  SFCTMP,TH2,EMISSI,T1,RCH,T24
+    REAL,    INTENT(OUT) :: ETP,FLX2,RR
+
+    REAL                 :: A, DELTA, FNET,RAD,ELCP1,LVS,EPSCA
+
+    REAL, PARAMETER      :: ELCP = 2.4888E+3, LSUBC = 2.501000E+6
+    REAL, PARAMETER      :: LSUBS = 2.83E+6
+
+! ----------------------------------------------------------------------
+! PREPARE PARTIAL QUANTITIES FOR PENMAN EQUATION.
+! ----------------------------------------------------------------------
+    IF ( T1 > 273.15 ) THEN
+       ELCP1 = ELCP
+       LVS   = LSUBC
+    ELSE
+       ELCP1 = ELCP*LSUBS/LSUBC
+       LVS   = LSUBS
+    ENDIF
+    DELTA = ELCP1 * DQSDT2
+    A = ELCP1 * (Q2SAT - Q2)
+    RR = EMISSI*T24 * 6.48E-8 / (SFCPRS * CH) + 1.0
+
+! ----------------------------------------------------------------------
+! ADJUST THE PARTIAL SUMS / PRODUCTS WITH THE LATENT HEAT
+! EFFECTS CAUSED BY FALLING PRECIPITATION.
+! ----------------------------------------------------------------------
+    IF (.NOT. SNOWNG) THEN
+       IF (PRCP >  0.0) RR = RR + CPH2O * PRCP / RCH
+    ELSE
+       RR = RR + CPICE * PRCP / RCH
+    END IF
+
+! ----------------------------------------------------------------------
+! INCLUDE THE LATENT HEAT EFFECTS OF FREEZING RAIN CONVERTING TO ICE ON
+! IMPACT IN THE CALCULATION OF FLX2 AND FNET.
+! ----------------------------------------------------------------------
+    IF (FRZGRA) THEN
+       FLX2 = - LSUBF * PRCP
+    ELSE
+       FLX2 = 0.0
+    ENDIF
+    FNET = FDOWN -  ( EMISSI * SIGMA * T24 ) - SSOIL - FLX2
+
+! ----------------------------------------------------------------------
+! FINISH PENMAN EQUATION CALCULATIONS.
+! ----------------------------------------------------------------------
+    RAD = FNET / RCH + TH2 - SFCTMP
+    EPSCA = (A * RR + RAD * DELTA) / (DELTA + RR)
+    ETP = EPSCA * RCH / LVS
+
+! ----------------------------------------------------------------------
+  END SUBROUTINE PENMAN
+! ----------------------------------------------------------------------
+
+  SUBROUTINE SHFLX (STC,NSOIL,DT,YY,ZZ1,ZSOIL,TBOT,DF1)
+! ----------------------------------------------------------------------
+! UPDATE THE TEMPERATURE STATE OF THE SOIL COLUMN BASED ON THE THERMAL
+! DIFFUSION EQUATION AND UPDATE THE FROZEN SOIL MOISTURE CONTENT BASED
+! ON THE TEMPERATURE.
+! ----------------------------------------------------------------------
+    IMPLICIT NONE
+
+    INTEGER,                  INTENT(IN)    :: NSOIL
+    REAL,                     INTENT(IN)    :: DF1,DT,TBOT,YY, ZZ1
+    REAL, DIMENSION(1:NSOIL), INTENT(IN)    :: ZSOIL
+    REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: STC
+
+    REAL, DIMENSION(1:NSOIL) :: AI, BI, CI, STCF,RHSTS
+    INTEGER                  :: I
+    REAL, PARAMETER          :: T0 = 273.15
+
+! ----------------------------------------------------------------------
+! HRT ROUTINE CALCS THE RIGHT HAND SIDE OF THE SOIL TEMP DIF EQN
+! ----------------------------------------------------------------------
+
+    CALL HRTICE (RHSTS,STC,TBOT, NSOIL,ZSOIL,YY,ZZ1,DF1,AI,BI,CI)
+
+    CALL HSTEP (STCF,STC,RHSTS,DT,NSOIL,AI,BI,CI)
+
+    DO I = 1,NSOIL
+       STC (I) = STCF (I)
+    END DO
+! ----------------------------------------------------------------------
+  END SUBROUTINE SHFLX
+! ----------------------------------------------------------------------
+
+  SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,NSOIL,DT,DF1,           &
+       &             Q2,T1,SFCTMP,T24,TH2,FDOWN,SSOIL,STC,             &
+       &             SFCPRS,RCH,RR,SNEQV,SNDENS,SNOWH,ZSOIL,TBOT,      &
+       &             SNOMLT,DEW,FLX1,FLX2,FLX3,ESNOW,EMISSI,RIBB)
+
+! ----------------------------------------------------------------------
+! CALCULATE SOIL MOISTURE AND HEAT FLUX VALUES & UPDATE SOIL MOISTURE
+! CONTENT AND SOIL HEAT CONTENT VALUES FOR THE CASE WHEN A SNOW PACK IS
+! PRESENT.
+! ----------------------------------------------------------------------
+    IMPLICIT NONE
+
+    INTEGER, INTENT(IN)   :: NSOIL
+    LOGICAL, INTENT(IN)   :: SNOWNG
+    REAL,    INTENT(IN)   :: DF1,DT,FDOWN,PRCP,Q2,RCH,RR,SFCPRS,SFCTMP, &
+         &                   T24,TBOT,TH2,EMISSI
+    REAL, INTENT(INOUT)   :: SNEQV,FLX2,PRCPF,SNOWH,SNDENS,T1,RIBB,ETP
+    REAL, INTENT(OUT)     :: DEW,ESNOW,FLX1,FLX3,SSOIL,SNOMLT
+    REAL, DIMENSION(1:NSOIL),INTENT(IN)     :: ZSOIL
+    REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: STC
+    REAL, DIMENSION(1:NSOIL) :: ET1
+    INTEGER               :: K
+    REAL                  :: DENOM,DSOIL,DTOT,ESDFLX,ETA,        &
+         &                   ESNOW1,ESNOW2,ETA1,ETP1,ETP2,       &
+         &                   ETP3,ETANRG,EX,                     &
+         &                   FRCSNO,FRCSOI,PRCP1,QSAT,RSNOW,SEH, &
+         &                   SNCOND,T12,T12A,T12B,T14,YY,ZZ1
+
+    REAL, PARAMETER       :: ESDMIN = 1.E-6, LSUBC = 2.501000E+6,     &
+         &                   LSUBS = 2.83E+6, TFREEZ = 273.15,        &
+         &                   SNOEXP = 2.0
+
+! ----------------------------------------------------------------------
+! FOR GLACIAL-ICE, SNOWCOVER FRACTION = 1.0, AND SUBLIMATION IS AT THE 
+! POTENTIAL RATE.
+! ----------------------------------------------------------------------
+! INITIALIZE EVAP TERMS.
+! ----------------------------------------------------------------------
+! conversions:
+! ESNOW [KG M-2 S-1]
+! ESDFLX [KG M-2 S-1] .le. ESNOW
+! ESNOW1 [M S-1]
+! ESNOW2 [M]
+! ETP [KG M-2 S-1]
+! ETP1 [M S-1]
+! ETP2 [M]
+! ----------------------------------------------------------------------
+    SNOMLT = 0.0
+    DEW = 0.
+    ESNOW = 0.
+    ESNOW1 = 0.
+    ESNOW2 = 0.
+
+! ----------------------------------------------------------------------
+! CONVERT POTENTIAL EVAP (ETP) FROM KG M-2 S-1 TO ETP1 IN M S-1
+! ----------------------------------------------------------------------
+    PRCP1 = PRCPF *0.001
+! ----------------------------------------------------------------------
+! IF ETP<0 (DOWNWARD) THEN DEWFALL (=FROSTFALL IN THIS CASE).
+! ----------------------------------------------------------------------
+    IF (ETP <= 0.0) THEN
+       IF ( ( RIBB >= 0.1 ) .AND. ( FDOWN > 150.0 ) ) THEN
+          ETP=(MIN(ETP*(1.0-RIBB),0.)/0.980 + ETP*(0.980-1.0))/0.980
+       ENDIF
+       ETP1 = ETP * 0.001
+       DEW = -ETP1
+       ESNOW2 = ETP1*DT
+       ETANRG = ETP*LSUBS
+    ELSE
+       ETP1 = ETP * 0.001
+       ESNOW = ETP
+       ESNOW1 = ESNOW*0.001
+       ESNOW2 = ESNOW1*DT
+       ETANRG = ESNOW*LSUBS
+    END IF
+
+! ----------------------------------------------------------------------
+! IF PRECIP IS FALLING, CALCULATE HEAT FLUX FROM SNOW SFC TO NEWLY
+! ACCUMULATING PRECIP.  NOTE THAT THIS REFLECTS THE FLUX APPROPRIATE FOR
+! THE NOT-YET-UPDATED SKIN TEMPERATURE (T1).  ASSUMES TEMPERATURE OF THE
+! SNOWFALL STRIKING THE GROUND IS =SFCTMP (LOWEST MODEL LEVEL AIR TEMP).
+! ----------------------------------------------------------------------
+    FLX1 = 0.0
+    IF (SNOWNG) THEN
+       FLX1 = CPICE * PRCP * (T1- SFCTMP)
+    ELSE
+       IF (PRCP >  0.0) FLX1 = CPH2O * PRCP * (T1- SFCTMP)
+    END IF
+! ----------------------------------------------------------------------
+! CALCULATE AN 'EFFECTIVE SNOW-GRND SFC TEMP' (T12) BASED ON HEAT FLUXES
+! BETWEEN THE SNOW PACK AND THE SOIL AND ON NET RADIATION.
+! INCLUDE FLX1 (PRECIP-SNOW SFC) AND FLX2 (FREEZING RAIN LATENT HEAT)
+! FLUXES.  FLX1 FROM ABOVE, FLX2 BROUGHT IN VIA COMMOM BLOCK RITE.
+! FLX2 REFLECTS FREEZING RAIN LATENT HEAT FLUX USING T1 CALCULATED IN
+! PENMAN.
+! ----------------------------------------------------------------------
+    DSOIL = - (0.5 * ZSOIL (1))
+    DTOT = SNOWH + DSOIL
+    DENOM = 1.0+ DF1 / (DTOT * RR * RCH)
+    T12A = ( (FDOWN - FLX1- FLX2- EMISSI * SIGMA * T24)/ RCH                    &
+         + TH2- SFCTMP - ETANRG / RCH ) / RR
+    T12B = DF1 * STC (1) / (DTOT * RR * RCH)
+
+    T12 = (SFCTMP + T12A + T12B) / DENOM
+    IF (T12 <=  TFREEZ) THEN
+! ----------------------------------------------------------------------
+! SUB-FREEZING BLOCK
+! ----------------------------------------------------------------------
+! ----------------------------------------------------------------------
+! IF THE 'EFFECTIVE SNOW-GRND SFC TEMP' IS AT OR BELOW FREEZING, NO SNOW
+! MELT WILL OCCUR.  SET THE SKIN TEMP TO THIS EFFECTIVE TEMP.  REDUCE
+! (BY SUBLIMINATION ) OR INCREASE (BY FROST) THE DEPTH OF THE SNOWPACK,
+! DEPENDING ON SIGN OF ETP.
+! UPDATE SOIL HEAT FLUX (SSOIL) USING NEW SKIN TEMPERATURE (T1)
+! SINCE NO SNOWMELT, SET ACCUMULATED SNOWMELT TO ZERO, SET 'EFFECTIVE'
+! PRECIP FROM SNOWMELT TO ZERO, SET PHASE-CHANGE HEAT FLUX FROM SNOWMELT
+! TO ZERO.
+! ----------------------------------------------------------------------
+       T1 = T12
+       SSOIL = DF1 * (T1- STC (1)) / DTOT
+       SNEQV = MAX(0.0, SNEQV-ESNOW2)
+       FLX3 = 0.0
+       EX = 0.0
+       SNOMLT = 0.0
+    ELSE
+! ----------------------------------------------------------------------
+! ABOVE FREEZING BLOCK
+! ----------------------------------------------------------------------
+! IF THE 'EFFECTIVE SNOW-GRND SFC TEMP' IS ABOVE FREEZING, SNOW MELT
+! WILL OCCUR.  CALL THE SNOW MELT RATE,EX AND AMT, SNOMLT.  REVISE THE
+! EFFECTIVE SNOW DEPTH.  REVISE THE SKIN TEMP BECAUSE IT WOULD HAVE CHGD
+! DUE TO THE LATENT HEAT RELEASED BY THE MELTING. CALC THE LATENT HEAT
+! RELEASED, FLX3. SET THE EFFECTIVE PRECIP, PRCP1 TO THE SNOW MELT RATE,
+! EX FOR USE IN SMFLX.  ADJUSTMENT TO T1 TO ACCOUNT FOR SNOW PATCHES.
+! CALCULATE QSAT VALID AT FREEZING POINT.  NOTE THAT ESAT (SATURATION
+! VAPOR PRESSURE) VALUE OF 6.11E+2 USED HERE IS THAT VALID AT FRZZING
+! POINT.  NOTE THAT ETP FROM CALL PENMAN IN SFLX IS IGNORED HERE IN
+! FAVOR OF BULK ETP OVER 'OPEN WATER' AT FREEZING TEMP.
+! UPDATE SOIL HEAT FLUX (S) USING NEW SKIN TEMPERATURE (T1)
+! ----------------------------------------------------------------------
+       T1 = TFREEZ
+       IF ( DTOT .GT. 2.0*DSOIL ) THEN
+          DTOT = 2.0*DSOIL
+       ENDIF
+       SSOIL = DF1 * (T1- STC (1)) / DTOT
+       IF (SNEQV-ESNOW2 <= ESDMIN) THEN
+          SNEQV = 0.0
+          EX = 0.0
+          SNOMLT = 0.0
+          FLX3 = 0.0
+! ----------------------------------------------------------------------
+! SUBLIMATION LESS THAN DEPTH OF SNOWPACK
+! SNOWPACK (SNEQV) REDUCED BY ESNOW2 (DEPTH OF SUBLIMATED SNOW)
+! ----------------------------------------------------------------------
+       ELSE
+          SNEQV = SNEQV-ESNOW2
+          ETP3 = ETP * LSUBC
+          SEH = RCH * (T1- TH2)
+          T14 = ( T1 * T1 ) * ( T1 * T1 )
+          FLX3 = FDOWN - FLX1- FLX2- EMISSI*SIGMA * T14- SSOIL - SEH - ETANRG
+          IF (FLX3 <= 0.0) FLX3 = 0.0
+          EX = FLX3*0.001/ LSUBF
+          SNOMLT = EX * DT
+! ----------------------------------------------------------------------
+! ESDMIN REPRESENTS A SNOWPACK DEPTH THRESHOLD VALUE BELOW WHICH WE
+! CHOOSE NOT TO RETAIN ANY SNOWPACK, AND INSTEAD INCLUDE IT IN SNOWMELT.
+! ----------------------------------------------------------------------
+          IF (SNEQV- SNOMLT >=  ESDMIN) THEN
+             SNEQV = SNEQV- SNOMLT
+          ELSE
+! ----------------------------------------------------------------------
+! SNOWMELT EXCEEDS SNOW DEPTH
+! ----------------------------------------------------------------------
+             EX = SNEQV / DT
+             FLX3 = EX *1000.0* LSUBF
+             SNOMLT = SNEQV
+
+             SNEQV = 0.0
+          ENDIF
+       ENDIF
+
+! ----------------------------------------------------------------------
+! FOR GLACIAL ICE, THE SNOWMELT WILL BE ADDED TO SUBSURFACE
+! RUNOFF/BASEFLOW LATER NEAR THE END OF SFLX (AFTER RETURN FROM CALL TO
+! SUBROUTINE SNOPAC)
+! ----------------------------------------------------------------------
+
+    ENDIF
+
+! ----------------------------------------------------------------------
+! BEFORE CALL SHFLX IN THIS SNOWPACK CASE, SET ZZ1 AND YY ARGUMENTS TO
+! SPECIAL VALUES THAT ENSURE THAT GROUND HEAT FLUX CALCULATED IN SHFLX
+! MATCHES THAT ALREADY COMPUTED FOR BELOW THE SNOWPACK, THUS THE SFC
+! HEAT FLUX TO BE COMPUTED IN SHFLX WILL EFFECTIVELY BE THE FLUX AT THE
+! SNOW TOP SURFACE.  
+! ----------------------------------------------------------------------
+    ZZ1 = 1.0
+    YY = STC (1) -0.5* SSOIL * ZSOIL (1)* ZZ1/ DF1
+
+! ----------------------------------------------------------------------
+! SHFLX WILL CALC/UPDATE THE SOIL TEMPS.
+! ----------------------------------------------------------------------
+    CALL SHFLX (STC,NSOIL,DT,YY,ZZ1,ZSOIL,TBOT,DF1)
+
+! ----------------------------------------------------------------------
+! SNOW DEPTH AND DENSITY ADJUSTMENT BASED ON SNOW COMPACTION.  YY IS
+! ASSUMED TO BE THE SOIL TEMPERTURE AT THE TOP OF THE SOIL COLUMN.
+! ----------------------------------------------------------------------
+    IF (SNEQV .GE. 0.10) THEN
+       CALL SNOWPACK (SNEQV,DT,SNOWH,SNDENS,T1,YY)
+    ELSE
+       SNEQV = 0.10
+       SNOWH = 0.50
+!KWM???? SNDENS =
+!KWM???? SNCOND =
+    ENDIF
+! ----------------------------------------------------------------------
+  END SUBROUTINE SNOPAC
+! ----------------------------------------------------------------------
+
+  SUBROUTINE SNOWPACK (SNEQV,DTSEC,SNOWH,SNDENS,TSNOW,TSOIL)
+
+! ----------------------------------------------------------------------
+! CALCULATE COMPACTION OF SNOWPACK UNDER CONDITIONS OF INCREASING SNOW
+! DENSITY, AS OBTAINED FROM AN APPROXIMATE SOLUTION OF E. ANDERSON'S
+! DIFFERENTIAL EQUATION (3.29), NOAA TECHNICAL REPORT NWS 19, BY VICTOR
+! KOREN, 03/25/95.
+! ----------------------------------------------------------------------
+! SNEQV     WATER EQUIVALENT OF SNOW (M)
+! DTSEC   TIME STEP (SEC)
+! SNOWH   SNOW DEPTH (M)
+! SNDENS  SNOW DENSITY (G/CM3=DIMENSIONLESS FRACTION OF H2O DENSITY)
+! TSNOW   SNOW SURFACE TEMPERATURE (K)
+! TSOIL   SOIL SURFACE TEMPERATURE (K)
+
+! SUBROUTINE WILL RETURN NEW VALUES OF SNOWH AND SNDENS
+! ----------------------------------------------------------------------
+      IMPLICIT NONE
+
+      INTEGER                :: IPOL, J
+      REAL, INTENT(IN)       :: SNEQV, DTSEC,TSNOW,TSOIL
+      REAL, INTENT(INOUT)    :: SNOWH, SNDENS
+      REAL                   :: BFAC,DSX,DTHR,DW,SNOWHC,PEXP,           &
+                                TAVGC,TSNOWC,TSOILC,ESDC,ESDCX
+      REAL, PARAMETER        :: C1 = 0.01, C2 = 21.0, G = 9.81,         &
+                                KN = 4000.0
+! ----------------------------------------------------------------------
+! CONVERSION INTO SIMULATION UNITS
+! ----------------------------------------------------------------------
+      SNOWHC = SNOWH *100.
+      ESDC   = SNEQV *100.
+      DTHR   = DTSEC /3600.
+      TSNOWC = TSNOW -273.15
+      TSOILC = TSOIL -273.15
+
+! ----------------------------------------------------------------------
+! CALCULATING OF AVERAGE TEMPERATURE OF SNOW PACK
+! ----------------------------------------------------------------------
+! ----------------------------------------------------------------------
+! CALCULATING OF SNOW DEPTH AND DENSITY AS A RESULT OF COMPACTION
+!  SNDENS=DS0*(EXP(BFAC*SNEQV)-1.)/(BFAC*SNEQV)
+!  BFAC=DTHR*C1*EXP(0.08*TAVGC-C2*DS0)
+! NOTE: BFAC*SNEQV IN SNDENS EQN ABOVE HAS TO BE CAREFULLY TREATED
+! NUMERICALLY BELOW:
+!   C1 IS THE FRACTIONAL INCREASE IN DENSITY (1/(CM*HR))
+!   C2 IS A CONSTANT (CM3/G) KOJIMA ESTIMATED AS 21 CMS/G
+! ----------------------------------------------------------------------
+      TAVGC = 0.5* (TSNOWC + TSOILC)
+      IF (ESDC >  1.E-2) THEN
+         ESDCX = ESDC
+      ELSE
+         ESDCX = 1.E-2
+      END IF
+
+!      DSX = SNDENS*((DEXP(BFAC*ESDC)-1.)/(BFAC*ESDC))
+! ----------------------------------------------------------------------
+! THE FUNCTION OF THE FORM (e**x-1)/x IMBEDDED IN ABOVE EXPRESSION
+! FOR DSX WAS CAUSING NUMERICAL DIFFICULTIES WHEN THE DENOMINATOR "x"
+! (I.E. BFAC*ESDC) BECAME ZERO OR APPROACHED ZERO (DESPITE THE FACT THAT
+! THE ANALYTICAL FUNCTION (e**x-1)/x HAS A WELL DEFINED LIMIT AS
+! "x" APPROACHES ZERO), HENCE BELOW WE REPLACE THE (e**x-1)/x
+! EXPRESSION WITH AN EQUIVALENT, NUMERICALLY WELL-BEHAVED
+! POLYNOMIAL EXPANSION.
+
+! NUMBER OF TERMS OF POLYNOMIAL EXPANSION, AND HENCE ITS ACCURACY,
+! IS GOVERNED BY ITERATION LIMIT "IPOL".
+!      IPOL GREATER THAN 9 ONLY MAKES A DIFFERENCE ON DOUBLE
+!            PRECISION (RELATIVE ERRORS GIVEN IN PERCENT %).
+!       IPOL=9, FOR REL.ERROR <~ 1.6 E-6 % (8 SIGNIFICANT DIGITS)
+!       IPOL=8, FOR REL.ERROR <~ 1.8 E-5 % (7 SIGNIFICANT DIGITS)
+!       IPOL=7, FOR REL.ERROR <~ 1.8 E-4 % ...
+! ----------------------------------------------------------------------
+      BFAC = DTHR * C1* EXP (0.08* TAVGC - C2* SNDENS)
+      IPOL = 4
+      PEXP = 0.
+!        PEXP = (1. + PEXP)*BFAC*ESDC/REAL(J+1)
+      DO J = IPOL,1, -1
+         PEXP = (1. + PEXP)* BFAC * ESDCX / REAL (J +1)
+      END DO
+
+      PEXP = PEXP + 1.
+! ----------------------------------------------------------------------
+! ABOVE LINE ENDS POLYNOMIAL SUBSTITUTION
+! ----------------------------------------------------------------------
+!     END OF KOREAN FORMULATION
+
+!     BASE FORMULATION (COGLEY ET AL., 1990)
+!     CONVERT DENSITY FROM G/CM3 TO KG/M3
+!       DSM=SNDENS*1000.0
+
+!       DSX=DSM+DTSEC*0.5*DSM*G*SNEQV/
+!    &      (1E7*EXP(-0.02*DSM+KN/(TAVGC+273.16)-14.643))
+
+!  &   CONVERT DENSITY FROM KG/M3 TO G/CM3
+!       DSX=DSX/1000.0
+
+!     END OF COGLEY ET AL. FORMULATION
+
+! ----------------------------------------------------------------------
+! SET UPPER/LOWER LIMIT ON SNOW DENSITY
+! ----------------------------------------------------------------------
+      DSX = SNDENS * (PEXP)
+      IF (DSX > 0.40) DSX = 0.40
+      IF (DSX < 0.05) DSX = 0.05
+! ----------------------------------------------------------------------
+! UPDATE OF SNOW DEPTH AND DENSITY DEPENDING ON LIQUID WATER DURING
+! SNOWMELT.  ASSUMED THAT 13% OF LIQUID WATER CAN BE STORED IN SNOW PER
+! DAY DURING SNOWMELT TILL SNOW DENSITY 0.40.
+! ----------------------------------------------------------------------
+      SNDENS = DSX
+      IF (TSNOWC >=  0.) THEN
+         DW = 0.13* DTHR /24.
+         SNDENS = SNDENS * (1. - DW) + DW
+         IF (SNDENS >=  0.40) SNDENS = 0.40
+! ----------------------------------------------------------------------
+! CALCULATE SNOW DEPTH (CM) FROM SNOW WATER EQUIVALENT AND SNOW DENSITY.
+! CHANGE SNOW DEPTH UNITS TO METERS
+! ----------------------------------------------------------------------
+      END IF
+      SNOWHC = ESDC / SNDENS
+      SNOWH = SNOWHC * 0.01
+
+! ----------------------------------------------------------------------
+  END SUBROUTINE SNOWPACK
+! ----------------------------------------------------------------------
+
+  SUBROUTINE SNOWZ0 (Z0, Z0BRD, SNOWH)
+! ----------------------------------------------------------------------
+! CALCULATE TOTAL ROUGHNESS LENGTH OVER SNOW
+! Z0      ROUGHNESS LENGTH (m)
+! Z0S     SNOW ROUGHNESS LENGTH:=0.001 (m)
+! ----------------------------------------------------------------------
+    IMPLICIT NONE
+    REAL, INTENT(IN)        :: Z0BRD
+    REAL, INTENT(OUT)       :: Z0
+    REAL, PARAMETER         :: Z0S=0.001
+    REAL, INTENT(IN)        :: SNOWH
+    REAL                    :: BURIAL
+    REAL                    :: Z0EFF
+
+    BURIAL = 7.0*Z0BRD - SNOWH
+    IF(BURIAL.LE.0.0007) THEN
+       Z0EFF = Z0S
+    ELSE      
+       Z0EFF = BURIAL/7.0
+    ENDIF
+
+    Z0 = Z0EFF
+
+! ----------------------------------------------------------------------
+  END SUBROUTINE SNOWZ0
+! ----------------------------------------------------------------------
+
+  SUBROUTINE SNOW_NEW (TEMP,NEWSN,SNOWH,SNDENS)
+
+! ----------------------------------------------------------------------
+! CALCULATE SNOW DEPTH AND DENSITY TO ACCOUNT FOR THE NEW SNOWFALL.
+! UPDATED VALUES OF SNOW DEPTH AND DENSITY ARE RETURNED.
+
+! TEMP    AIR TEMPERATURE (K)
+! NEWSN   NEW SNOWFALL (M)
+! SNOWH   SNOW DEPTH (M)
+! SNDENS  SNOW DENSITY (G/CM3=DIMENSIONLESS FRACTION OF H2O DENSITY)
+! ----------------------------------------------------------------------
+    IMPLICIT NONE
+    REAL, INTENT(IN)        :: NEWSN, TEMP
+    REAL, INTENT(INOUT)     :: SNDENS, SNOWH
+    REAL                    :: DSNEW, HNEWC, SNOWHC,NEWSNC,TEMPC
+
+! ----------------------------------------------------------------------
+! CALCULATING NEW SNOWFALL DENSITY DEPENDING ON TEMPERATURE
+! EQUATION FROM GOTTLIB L. 'A GENERAL RUNOFF MODEL FOR SNOWCOVERED
+! AND GLACIERIZED BASIN', 6TH NORDIC HYDROLOGICAL CONFERENCE,
+! VEMADOLEN, SWEDEN, 1980, 172-177PP.
+!-----------------------------------------------------------------------
+    TEMPC = TEMP - 273.15
+    IF ( TEMPC <=  -15. ) THEN
+       DSNEW = 0.05
+    ELSE
+       DSNEW = 0.05 + 0.0017 * ( TEMPC + 15. ) ** 1.5
+    ENDIF
+
+! ----------------------------------------------------------------------
+! CONVERSION INTO SIMULATION UNITS
+! ----------------------------------------------------------------------
+    SNOWHC = SNOWH * 100.
+    NEWSNC = NEWSN * 100.
+
+! ----------------------------------------------------------------------
+! ADJUSTMENT OF SNOW DENSITY DEPENDING ON NEW SNOWFALL
+! ----------------------------------------------------------------------
+    HNEWC = NEWSNC / DSNEW
+    IF ( SNOWHC + HNEWC < 1.0E-3 ) THEN
+       SNDENS = MAX ( DSNEW , SNDENS )
+    ELSE
+       SNDENS = ( SNOWHC * SNDENS + HNEWC * DSNEW ) / ( SNOWHC + HNEWC )
+    ENDIF
+    SNOWHC = SNOWHC + HNEWC
+    SNOWH = SNOWHC * 0.01
+
+! ----------------------------------------------------------------------
+  END SUBROUTINE SNOW_NEW
+! ----------------------------------------------------------------------
+
+END MODULE module_sf_noahlsm_glacial_only
diff --git a/src/core_atmosphere/physics/physics_wrf/module_sf_sfclay.F b/src/core_atmosphere/physics/physics_wrf/module_sf_sfclay.F
index 010f54dbf6..4db5b42e97 100644
--- a/src/core_atmosphere/physics/physics_wrf/module_sf_sfclay.F
+++ b/src/core_atmosphere/physics/physics_wrf/module_sf_sfclay.F
@@ -1,12 +1,3 @@
-!=================================================================================================================
-!module_sf_sfclay.F was originally copied from ./phys/module_sf_sfclay.F from WRF version 3.8.1.
-!Laura D. Fowler (laura@ucar.edu) / 2016-10-26.
-
-!modifications to sourcecode for MPAS:
-!   * added the actual size of each cell in the calculation of the Mahrt and Sun low-resolution correction.
-!     Laura D. Fowler (laura@ucar.edu) / 2016-10-26. 
-
-!=================================================================================================================
 !WRF:MODEL_LAYER:PHYSICS
 !
 MODULE module_sf_sfclay
@@ -33,11 +24,8 @@ SUBROUTINE SFCLAY(U3D,V3D,T3D,QV3D,P3D,dz8w,                    &
                      ids,ide, jds,jde, kds,kde,                    &
                      ims,ime, jms,jme, kms,kme,                    &
                      its,ite, jts,jte, kts,kte,                    &
-                     ustm,ck,cka,cd,cda,isftcflx,iz0tlnd,scm_force_flux &
-#if defined(mpas)
-                    ,dxCell                                        &
-#endif
-                         )
+                     ustm,ck,cka,cd,cda,                           &
+                     isftcflx,iz0tlnd,scm_force_flux)
 !-------------------------------------------------------------------
       IMPLICIT NONE
 !-------------------------------------------------------------------
@@ -185,8 +173,10 @@ SUBROUTINE SFCLAY(U3D,V3D,T3D,QV3D,P3D,dz8w,                    &
       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
                 INTENT(INOUT)   ::                                 &
                                                               QGH
+      REAL,     INTENT(IN   )               ::   CP,G,ROVCP,R,XLV
 
-      REAL,     INTENT(IN   )               ::   CP,G,ROVCP,R,XLV,DX
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(IN   )               ::                 DX
  
       REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme )              , &
                 INTENT(OUT)     ::                  ck,cka,cd,cda
@@ -197,19 +187,15 @@ SUBROUTINE SFCLAY(U3D,V3D,T3D,QV3D,P3D,dz8w,                    &
       INTEGER,  OPTIONAL,  INTENT(IN )   ::     ISFTCFLX, IZ0TLND
       INTEGER,  OPTIONAL,  INTENT(IN )   ::     SCM_FORCE_FLUX
 
-#if defined(mpas)
-      real,intent(in),dimension(ims:ime,jms:jme),optional:: dxCell
-      real,intent(inout),dimension(ims:ime,jms:jme):: qsfc
-      real,intent(out),dimension(ims:ime,jms:jme)  :: u10,v10,th2,t2,q2
-#else
+      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
+                INTENT(INOUT  )             ::               QSFC
+
       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
                 INTENT(OUT  )               ::                U10, &
                                                               V10, &
                                                               TH2, &
                                                                T2, &
-                                                               Q2, &
-                                                             QSFC
-#endif
+                                                               Q2
 
 ! LOCAL VARS
 
@@ -221,9 +207,16 @@ SUBROUTINE SFCLAY(U3D,V3D,T3D,QV3D,P3D,dz8w,                    &
 
       REAL,     DIMENSION( its:ite ) ::                    dz8w1d
 
+      REAL,     DIMENSION( its:ite ) ::                      DX2D
+
       INTEGER ::  I,J
 
       DO J=jts,jte
+
+        DO i=its,ite
+           DX2D(i)=DX(i,j)
+        ENDDO
+
         DO i=its,ite
           dz8w1d(I) = dz8w(i,1,j)
         ENDDO
@@ -249,17 +242,13 @@ SUBROUTINE SFCLAY(U3D,V3D,T3D,QV3D,P3D,dz8w,                    &
                 U10(ims,j),V10(ims,j),TH2(ims,j),T2(ims,j),        &
                 Q2(ims,j),FLHC(ims,j),FLQC(ims,j),QGH(ims,j),      &
                 QSFC(ims,j),LH(ims,j),                             &
-                GZ1OZ0(ims,j),WSPD(ims,j),BR(ims,j),ISFFLX,DX,     &
+                GZ1OZ0(ims,j),WSPD(ims,j),BR(ims,j),ISFFLX,DX2D,   &
                 SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,EOMEG,STBOLT,  &
                 P1000mb,                                           &
                 ids,ide, jds,jde, kds,kde,                         &
                 ims,ime, jms,jme, kms,kme,                         &
                 its,ite, jts,jte, kts,kte                          &
-#if defined(mpas)
-               ,isftcflx,iz0tlnd,scm_force_flux,                   &
-               USTM(ims,j),CK(ims,j),CKA(ims,j),                   &
-               CD(ims,j),CDA(ims,j),dxCell(ims,j)                  &
-#elif ( EM_CORE == 1 )
+#if ( ( EM_CORE == 1 ) || ( defined(mpas) ) )
                 ,isftcflx,iz0tlnd,scm_force_flux,                  &
                 USTM(ims,j),CK(ims,j),CKA(ims,j),                  &
                 CD(ims,j),CDA(ims,j)                               &
@@ -285,11 +274,7 @@ SUBROUTINE SFCLAY1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d,                &
                      ims,ime, jms,jme, kms,kme,                    &
                      its,ite, jts,jte, kts,kte,                    &
                      isftcflx, iz0tlnd, scm_force_flux,            &
-#if defined(mpas)
-                     ustm,ck,cka,cd,cda,dxCell                     )
-#else
                      ustm,ck,cka,cd,cda                            )
-#endif
 !-------------------------------------------------------------------
       IMPLICIT NONE
 !-------------------------------------------------------------------
@@ -348,7 +333,9 @@ SUBROUTINE SFCLAY1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d,                &
                                                 TH2,T2,Q2,QSFC,LH
 
                                     
-      REAL,     INTENT(IN   )               ::   CP,G,ROVCP,R,XLV,DX
+      REAL,     INTENT(IN   )               ::   CP,G,ROVCP,R,XLV
+
+      REAL,     DIMENSION( its:ite ),  INTENT(IN   )   ::      DX
 
 ! MODULE-LOCAL VARIABLES, DEFINED IN SUBROUTINE SFCLAY
       REAL,     DIMENSION( its:ite ),  INTENT(IN   )   ::  dz8w1d
@@ -359,10 +346,6 @@ SUBROUTINE SFCLAY1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d,                &
                                                               P1D, &
                                                               T1D
  
-#if defined(mpas)
-      real,intent(in),dimension(ims:ime),optional:: dxCell
-#endif
-
       REAL, OPTIONAL, DIMENSION( ims:ime )                       , &
                 INTENT(OUT)     ::                  ck,cka,cd,cda
       REAL, OPTIONAL, DIMENSION( ims:ime )                       , &
@@ -539,14 +522,7 @@ SUBROUTINE SFCLAY1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d,                &
         VCONV = SQRT(DTHVM)
         endif
 ! Mahrt and Sun low-res correction
-!MPAS specific (Laura D. Fowler): We take into accound the actual size of individual
-!grid-boxes:
-        if(present(dxCell)) then
-           vsgd = 0.32 * (max(dxCell(i)/5000.-1.,0.))**.33
-        else
-           VSGD = 0.32 * (max(dx/5000.-1.,0.))**.33
-        endif
-!MPAS specific end.
+        VSGD = 0.32 * (max(dx(i)/5000.-1.,0.))**.33
         WSPD(I)=SQRT(WSPD(I)*WSPD(I)+VCONV*VCONV+vsgd*vsgd)
         WSPD(I)=AMAX1(WSPD(I),0.1)
         BR(I)=GOVRTH(I)*ZA(I)*DTHVDZ/(WSPD(I)*WSPD(I))                        
@@ -796,14 +772,19 @@ SUBROUTINE SFCLAY1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d,                &
            Cda(I)=(karman/psix)*(karman/psix)
         ENDIF
         IF ( PRESENT(IZ0TLND) ) THEN
-           IF ( IZ0TLND.EQ.1 .AND. (XLAND(I)-1.5).LE.0. ) THEN
+           IF ( IZ0TLND.GE.1 .AND. (XLAND(I)-1.5).LE.0. ) THEN
               ZL=ZNT(I)
 !             CZIL RELATED CHANGES FOR LAND
               VISC=(1.32+0.009*(SCR3(I)-273.15))*1.E-5
               RESTAR=UST(I)*ZL/VISC
-!             Modify CZIL according to Chen & Zhang, 2009
+!             Modify CZIL according to Chen & Zhang, 2009 if iz0tlnd = 1
+!             If iz0tlnd = 2, use traditional value
 
-              CZIL = 10.0 ** ( -0.40 * ( ZL / 0.07 ) )
+              IF ( IZ0TLND.EQ.1 ) THEN
+                 CZIL = 10.0 ** ( -0.40 * ( ZL / 0.07 ) )
+              ELSE IF ( IZ0TLND.EQ.2 ) THEN
+                 CZIL = 0.1
+              END IF
 
               PSIT=GZ1OZ0(I)-PSIH(I)+CZIL*KARMAN*SQRT(RESTAR)
               PSIQ=GZ1OZ0(I)-PSIH(I)+CZIL*KARMAN*SQRT(RESTAR)
@@ -863,6 +844,8 @@ SUBROUTINE SFCLAY1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d,                &
 !         ZNT(I)=CZO*UST(I)*UST(I)/G+OZO                                   
 ! Since V3.7 (ref: EC Physics document for Cy36r1)
           ZNT(I)=CZO*UST(I)*UST(I)/G+0.11*1.5E-5/UST(I)
+! V3.9: Add limit as in isftcflx = 1,2
+          ZNT(I)=MIN(ZNT(I),2.85e-3)
 ! COARE 3.5 (Edson et al. 2013)
 !         CZC = 0.0017*WSPD(I)-0.005
 !         CZC = min(CZC,0.028)
diff --git a/src/core_atmosphere/physics/physics_wrf/module_sf_urban.F b/src/core_atmosphere/physics/physics_wrf/module_sf_urban.F
index d2ac6a0b48..62a8a976df 100644
--- a/src/core_atmosphere/physics/physics_wrf/module_sf_urban.F
+++ b/src/core_atmosphere/physics/physics_wrf/module_sf_urban.F
@@ -1,10 +1,12 @@
 MODULE module_sf_urban
-
-#ifdef mpas
-use mpas_atmphys_utilities, only: physics_error_fatal
+#if defined(mpas)
+use mpas_atmphys_utilities, only: physics_message,physics_error_fatal
 #define FATAL_ERROR(M) call physics_error_fatal( M )
+#define WRITE_MESSAGE(M) call physics_message( M )
 #else
-#define FATAL_ERROR(M) write(0,*) M ; stop
+use module_wrf_error
+#define FATAL_ERROR(M) call wrf_error_fatal( M )
+#define WRITE_MESSAGE(M) call wrf_message( M )
 #endif
 
 !===============================================================================
@@ -26,6 +28,7 @@ MODULE module_sf_urban
    REAL, ALLOCATABLE, DIMENSION(:) :: RW_TBL
    REAL, ALLOCATABLE, DIMENSION(:) :: HGT_TBL
    REAL, ALLOCATABLE, DIMENSION(:) :: AH_TBL
+   REAL, ALLOCATABLE, DIMENSION(:) :: ALH_TBL
    REAL, ALLOCATABLE, DIMENSION(:) :: BETR_TBL
    REAL, ALLOCATABLE, DIMENSION(:) :: BETB_TBL
    REAL, ALLOCATABLE, DIMENSION(:) :: BETG_TBL
@@ -74,12 +77,28 @@ MODULE module_sf_urban
    REAL, DIMENSION(1:24)           :: ahdiuprf        ! ah diurnal profile, tloc: 1-24
    REAL, DIMENSION(1:24)           :: hsequip_tbl
 
+!===Yang, 2014/10/08, urban hydrological processes for single layer UCM===
+   INTEGER                         :: IMP_SCHEME, IRI_SCHEME
+   INTEGER                         :: alhoption       ! anthropogenic latent heat option
+   INTEGER                         :: groption        ! anthropogenic latent heat option
+   REAL                            :: fgr             ! green roof fraction
+   REAL                            :: oasis           ! urban oasis parameter
+   REAL, DIMENSION(1:4)            :: DZGR            ! Layer depth of green roof 
+   REAL, DIMENSION(1:4)            :: alhseason       ! seasonal variation of alh
+   REAL, DIMENSION(1:48)           :: alhdiuprf       ! alh diurnal profile, tloc2: 1-48
+   REAL, DIMENSION(1:3)            :: porimp          ! porosity of pavement over impervious surface
+   REAL, DIMENSION(1:3)            :: dengimp         ! maximum water-holding depth of pavement
+
+!===end hydrological processes===
+   
    INTEGER                         :: allocate_status 
 
 !   INTEGER                         :: num_roof_layers
 !   INTEGER                         :: num_wall_layers
 !   INTEGER                         :: num_road_layers
 
+   CHARACTER (LEN=256) , PRIVATE   :: mesg
+
    CONTAINS
 
 !===============================================================================
@@ -194,6 +213,7 @@ MODULE module_sf_urban
 ! Following parameter are assigned in run/URBPARM.TBL
 !
 !  AH  [ W m{-2} ]        : anthropogenic heat  ( W m{-2} in the table, converted internally to cal cm{-2} )
+!  ALH [ W m{-2} ]        : anthropogenic latent heat  ( W m{-2} in the table, converted internally to cal cm{-2} )
 !  CAPR[ J m{-3} K{-1} ]  : heat capacity of roof ( units converted in code to [ cal cm{-3} deg{-1} ] )
 !  CAPB[ J m{-3} K{-1} ]  : heat capacity of building wall ( units converted in code to [ cal cm{-3} deg{-1} ] )
 !  CAPG[ J m{-3} K{-1} ]  : heat capacity of road ( units converted in code to [ cal cm{-3} deg{-1} ] )
@@ -227,7 +247,11 @@ MODULE module_sf_urban
 !                         [1: M-O Similarity Theory,  2: Empirical Form (recommend)]
 !  TS_SCHEME [integer 1 or 2] : Scheme for computing surface temperature (for roof, wall, and road)
 !                         [1: 4-layer model,  2: Force-Restore method]
-!
+!  IMP_SCHEME[integer 1 or 2] : Evaporation scheme for impervious surfaces (roof, wall, and road)
+!                         [1: Hypothesized evaporation during large rainfall events
+!                         [2: Water-holding scheme over impervious surface
+!  IRI_SCHEME[integer 0 or 1] : Scheme for urban irrigation
+!                         [0: No irrigation,  1: Summertime (May-Sep) irrigation everyday at 9pm]
 !for BEP
 !  numdir [ - ]             : Number of street directions defined for a particular urban category
 !  street_direction [ deg ] : Direction of streets for a particular urban category and a particular street direction
@@ -256,6 +280,7 @@ MODULE module_sf_urban
 !     Kusaka et al. (2001) Bound.-Layer Meteor., vol.101, p329-358
 !
 ! History:
+!     2014/10,         modified by Jiachuan Yang (ASU)
 !     2006/06          modified by H. Kusaka (Univ. Tsukuba), M. Tewari 
 !     2005/10/26,      modified by Fei Chen, Mukul Tewari
 !     2003/07/21 WRF , modified  by H. Kusaka of CRIEPI (NCAR/MMM)
@@ -281,8 +306,10 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
                     SW,ALB,LW,G,RN,PSIM,PSIH,                         & ! O
                     GZ1OZ0,                                           & ! O
                     CMR_URB,CHR_URB,CMC_URB,CHC_URB,                  & ! I/O
-                    U10,V10,TH2,Q2,UST                                & ! O
-                    )
+                    U10,V10,TH2,Q2,UST,mh_urb,stdh_urb,lf_urb,        & ! O 
+                    lp_urb,hgt_urb,frc_urb,lb_urb,zo_check,           & ! O
+                    CMCR,TGR,TGRL,SMR,CMGR_URB,CHGR_URB,jmonth,       & ! H
+                    DRELR,DRELB,DRELG,FLXHUMR,FLXHUMB,FLXHUMG)
 
    IMPLICIT NONE
 
@@ -325,7 +352,7 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
 
    INTEGER, INTENT(IN) :: UTYPE ! urban type [1=Commercial/Industrial, 2=High-intensity residential, 
                                 ! 3=low-intensity residential]
-
+   INTEGER, INTENT(IN) :: jmonth! current month 
    REAL, INTENT(IN)    :: TA   ! potential temp at 1st atmospheric level [K]
    REAL, INTENT(IN)    :: QA   ! mixing ratio at 1st atmospheric level  [kg/kg]
    REAL, INTENT(IN)    :: UA   ! wind speed at 1st atmospheric level    [m/s]
@@ -342,7 +369,6 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
 
    REAL, INTENT(IN)    :: XLAT ! latitude                               [deg]
    REAL, INTENT(IN)    :: DELT ! time step                              [s]
-   REAL, INTENT(IN)    :: ZNT  ! roughness length                       [m]
    REAL, INTENT(IN)    :: CHS,CHS2 ! CH*U at za and 2 m             [m/s]
 
    REAL, INTENT(INOUT) :: SSGD ! downward direct short wave radiation   [W/m/m]
@@ -351,6 +377,18 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
    REAL, INTENT(INOUT) :: CHR_URB
    REAL, INTENT(INOUT) :: CMC_URB
    REAL, INTENT(INOUT) :: CHC_URB
+   REAL, INTENT(INOUT) :: ZNT  ! roughness length                       [m]    ! modified by danli
+!-------------------------------------------------------------------------------
+! I: NUDAPT Input Parameters
+!-------------------------------------------------------------------------------
+   REAL, INTENT(INOUT) :: mh_urb   ! mean building height [m]
+   REAL, INTENT(INOUT) :: stdh_urb ! standard deviation of building height [m]
+   REAL, INTENT(INOUT) :: hgt_urb  ! area weighted mean building height [m] 
+   REAL, INTENT(INOUT) :: lp_urb   ! plan area fraction [-]
+   REAL, INTENT(INOUT) :: frc_urb  ! urban fraction [-]
+   REAL, INTENT(INOUT) :: lb_urb   ! building surface to plan area ratio [-]
+   REAL, INTENT(INOUT), DIMENSION(4) :: lf_urb   ! frontal area index [-]
+   REAL, INTENT(INOUT) :: zo_check  ! check for printing ZOC
 
 !-------------------------------------------------------------------------------
 ! O: output variables from Urban to LSM 
@@ -402,11 +440,30 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
    REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: TBL
    REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: TGL
 
+!===Yang,2014/10/08, urban hydrological variables for single layer UCM===
+! FLXHUMR: evaporation over roof  [m/s];     FLXHUMRP: at previous time step [m/s]
+! FLXHUMB: evaporation over wall  [m/s];     FLXHUMBP: at previous time step [m/s]
+! FLXHUMG: evaporation over road  [m/s];     FLXHUMGP: at previous time step [m/s]
+
+! DRELR: water retention depth on roof [m];  DRELRP: at previous time stp [m] 
+! DRELB: water retention depth on wall [m];  DRELBP: at previous time stp [m] 
+! DRELG: water retention depth on road [m];  DRELGP: at previous time stp [m]
+  
+! TGR: green roof surface temperature  [K];      TGRP: at previous time step [K]
+! CMCR: Canopy intercepted water on green roof;  CMCRP: at previous time step
+! SMR: soil moisture at each layer on roof [-];  SMRP: at previous time step
+! TGRL:layer temperature on green roof [K]
+  
+   REAL, INTENT(INOUT):: FLXHUMR,FLXHUMB,FLXHUMG,DRELR,DRELB,DRELG
+   REAL, INTENT(INOUT):: TGR,CMCR,CHGR_URB,CMGR_URB
+   REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: SMR        
+   REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: TGRL
+
 !-------------------------------------------------------------------------------
 ! L:  Local variables from read_param
 !-------------------------------------------------------------------------------
 
-   REAL :: ZR, Z0C, Z0HC, ZDC, SVF, R, RW, HGT, AH
+   REAL :: ZR, Z0C, Z0HC, ZDC, SVF, R, RW, HGT, AH, ALH
    REAL :: SIGMA_ZED
    REAL :: CAPR, CAPB, CAPG, AKSR, AKSB, AKSG, ALBR, ALBB, ALBG 
    REAL :: EPSR, EPSB, EPSG, Z0R,  Z0B,  Z0G,  Z0HB, Z0HG
@@ -443,12 +500,12 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
    REAL :: W, VFGS, VFGW, VFWG, VFWS, VFWW
    REAL :: HOUI1, HOUI2, HOUI3, HOUI4, HOUI5, HOUI6, HOUI7, HOUI8
    REAL :: SLX, SLX1, SLX2, SLX3, SLX4, SLX5, SLX6, SLX7, SLX8
-   REAL :: FLXTHR, FLXTHB, FLXTHG, FLXHUMR, FLXHUMB, FLXHUMG
+   REAL :: FLXTHR, FLXTHB, FLXTHG
    REAL :: SR, SB, SG, RR, RB, RG
    REAL :: SR1, SR2, SB1, SB2, SG1, SG2, RR1, RR2, RB1, RB2, RG1, RG2
    REAL :: HR, HB, HG, ELER, ELEB, ELEG, G0R, G0B, G0G
    REAL :: ALPHAC, ALPHAR, ALPHAB, ALPHAG
-   REAL :: CHC, CHR, CHB, CHG, CDC, CDR, CDB, CDG
+   REAL :: CHC, CHR, CHB, CHG, CDC, CDR, CDB, CDG, CDGR
    REAL :: C1R, C1B, C1G, TE, TC1, TC2, QC1, QC2, QS0R, QS0B, QS0G,RHO,ES
 
    REAL :: DESDT
@@ -481,8 +538,55 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
 
    REAL :: TRP, TBP, TGP, TCP, QCP, TST, QST
 
-   INTEGER :: iteration, K 
-   INTEGER :: tloc
+   REAL :: WDR,HGT2,BW,DHGT
+   REAL, parameter :: VonK = 0.4
+   REAL :: lambda_f,alpha_macd,beta_macd,lambda_fr
+
+   INTEGER :: iteration, K, NUDAPT 
+   INTEGER :: tloc, tloc2, Kalh
+
+!===Yang,2014/10/08, urban hydrological variables for single layer UCM===
+   REAL :: FLXHUMRP, FLXHUMBP, FLXHUMGP
+   REAL :: DRELRP, DRELBP, DRELGP
+   REAL :: TGRP, CMCRP
+   REAL, DIMENSION(1:num_roof_layers) :: ZSOILR, ETR, SMRP
+!===Define parameters for green roof===
+   INTEGER :: KZ
+   REAL :: RUNOFF1, RUNOFF2, RUNOFF3
+   REAL :: SGR, SGR1, T1VGR, CHGR, ALPHAGR 
+   REAL :: FLXTHGR, FLXHUMGR, HGR, ELEGR, G0GR
+   REAL :: QS0GR, EPGR, EDIR, ETTR, FV, DTGR, DRIP
+!   REAL :: DQS0GRDTGR, ETR, ECR,RAIN1, RAINDR, DEW, ETAR, BETGR
+   REAL :: DQS0GRDTGR, ECR,RAIN1, RAINDR, DEW, ETAR, BETGR
+!   REAL :: DF1, RGR, RGRR, RCH, RR1, RR2, YY, ZZ1, SSOILR
+   REAL :: DF1, RGR, RGRR, RCH, YY, ZZ1, SSOILR
+   REAL :: DRRDTGR, DHRDTGR, DELERDTGR, DG0RDTGR, DFDVT  
+   real,parameter  :: SHDFAC   = 0.80   ! Vegetated area fraction of green roof vegetation
+   real,parameter  :: ALBV     = 0.20   ! green roof albedo
+   real,parameter  :: EPSV     = 0.93   ! green roof emissivity
+   real,parameter  :: LAI      = 1.50   ! leaf area index on green roof
+   real,parameter  :: CMCMAX   = 0.5E-3 ! Maximum canopy interception capacity   
+   real,parameter  :: SMCREF   = 0.329  ! Reference soil moisture
+   real,parameter  :: SMCDRY   = 0.066  ! Residual  soil moisture
+   real,parameter  :: SMCWLT   = 0.084  ! Wilting point        
+   real,parameter  :: SMCMAX   = 0.439  ! Saturated soil moisture
+   real,parameter  :: RSMAX    = 5000   ! Maximum stomatal resistance
+   real,parameter  :: RSMIN    = 100    ! Minimum stomatal resistance
+   real,parameter  :: RGL      = 100    ! Radiation limit where photosynthesis begins
+   real,parameter  :: CFACTR   = 0.5    ! Parameter used in the canopy inteception calculation        
+   real,parameter  :: DWSAT    = 0.143E-4 ! Saturated soil conductivity            
+   real,parameter  :: DKSAT    = 3.38E-6  ! Saturated soil diffusivity
+   real,parameter  :: BEXP     = 5.25   ! B parameter in soil hydraulic calculation
+   real,parameter  :: FXEXP    = 2.0    ! Parameter for computing direct soil evaporation        
+   real,parameter  :: ZBOT     = -2.0   
+   real,parameter  :: QUARTZ   = 0.40
+   real,parameter  :: CSOIL    = 2.0E+6
+   real,parameter  :: HS       = 36
+   integer,parameter ::  NROOT = 2      ! Root depth layer of green roof
+   integer,parameter ::  NGR   = 4      ! Layer of green roof
+   integer,parameter ::  IMPR  = 1     
+   integer,parameter ::  IMPB  = 2      
+   integer,parameter ::  IMPG  = 3    
 
 !-------------------------------------------------------------------------------
 ! Set parameters
@@ -491,8 +595,15 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
 ! Miao, 2007/01/17, cal. ah
    if(ahoption==1) then
      tloc=mod(int(OMG/PI*180./15.+12.+0.5 ),24)
+     if(tloc.lt.0) tloc=tloc+24
      if(tloc==0) tloc=24
    endif
+! Yang, 2014/10/08, cal. alh
+   if(alhoption==1) then
+     tloc2=mod(int((OMG/PI*180./15.+12.)*2.+0.5 ),48)
+     if(tloc2.lt.0) tloc2=tloc2+48
+     if(tloc2==0) tloc2=48
+   endif
 
    CALL read_param(UTYPE,ZR,SIGMA_ZED,Z0C,Z0HC,ZDC,SVF,R,RW,HGT,  &
                    AH,CAPR,CAPB,CAPG,AKSR,AKSB,AKSG,ALBR,ALBB,    &
@@ -504,11 +615,167 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
                    HPERCENT_BIN,                                  & 
 !end BEP
                    BOUNDR,BOUNDB,BOUNDG,CH_SCHEME,TS_SCHEME,      &
-                   AKANDA_URBAN)
+                   AKANDA_URBAN,ALH)
+
+! Glotfelty, 2012/07/05, NUDAPT Modification
+
+ if(mh_urb.gt.0.0)THEN 
+  !write(mesg,*) 'Mean Height NUDAPT',mh_urb
+  !WRITE_MESSAGE(mesg)
+  !write(mesg,*) 'Mean Height Table',ZR
+  !WRITE_MESSAGE(mesg)
+  if(zo_check.eq.1)THEN
+   write(mesg,*) 'Mean Height NUDAPT',mh_urb
+   WRITE_MESSAGE(mesg)
+   write(mesg,*) 'Mean Height Table',ZR
+   WRITE_MESSAGE(mesg)
+   write(mesg,*) 'Roughness Length Table',Z0C
+   WRITE_MESSAGE(mesg)
+   write(mesg,*) 'Roof Roughness Length Table',Z0R
+   WRITE_MESSAGE(mesg)
+   write(mesg,*) 'Sky View Factor Table',SVF
+   WRITE_MESSAGE(mesg)
+   write(mesg,*) 'Normalized Height Table',HGT
+   WRITE_MESSAGE(mesg)
+   write(mesg,*) 'Plan Area Fraction', lp_urb
+   WRITE_MESSAGE(mesg)
+   write(mesg,*) 'Plan Area Fraction table', R
+   WRITE_MESSAGE(mesg)
+  end if
+  !write(mesg,*) 'Area Weighted Mean Height',hgt_urb
+  !WRITE_MESSAGE(mesg)
+  !write(mesg,*) 'Plan Area Fraction', lp_urb
+  !WRITE_MESSAGE(mesg)
+  !write(mesg,*) 'STD Height', stdh_urb
+  !WRITE_MESSAGE(mesg)
+  !write(mesg,*) 'Frontal Area Index',lf_urb
+  !WRITE_MESSAGE(mesg)
+  !write(mesg,*) 'Urban Fraction',frc_urb
+  !WRITE_MESSAGE(mesg)
+  !write(mesg,*) 'Building Surf Ratio',lb_urb
+  !WRITE_MESSAGE(mesg)
+ 
+ !Calculate Building Width and Street Width Based on BEP formulation
+ if(lb_urb.gt.lp_urb)THEN
+  BW=2.*hgt_urb*lp_urb/(lb_urb-lp_urb)
+  SW=2.*hgt_urb*lp_urb*((frc_urb/lp_urb)-1.)/(lb_urb-lp_urb)
+  !write(mesg,*) 'Building Width',BW
+  !WRITE_MESSAGE(mesg)
+  !write(mesg,*) 'Street Width',SW
+  !WRITE_MESSAGE(mesg)
+ elseif (SW.lt.0.0.or.BW.lt.0.0)then
+  BW=BUILDING_WIDTH(1)
+  SW=STREET_WIDTH(1)
+ else
+    BW=BUILDING_WIDTH(1)
+  SW=STREET_WIDTH(1)
+ end if
+ 
+ !Assign NUDAPT Parameters
+   ZR = mh_urb
+    R = lp_urb
+    RW = 1.0-R
+   HGT = mh_urb/(BW+SW)
+   SIGMA_ZED = stdh_urb
+
+ !Calculate Wind Direction and Assign Appropriae lf_urb
+   !WDR = (180.0/PI)*ATAN2(U10,V10)
+   
+   IF(WDR.ge.0.0.and.WDR.lt.22.5)THEN
+     lambda_f = lf_urb(1)
+   ELSEIF(WDR.ge.-22.5.and.WDR.lt.0.0)THEN
+     lambda_f = lf_urb(1)
+   ELSEIF(WDR.gt.157.5.and.WDR.le.180.0)THEN
+     lambda_f = lf_urb(1)
+   ELSEIF(WDR.lt.-157.5)THEN
+     lambda_f = lf_urb(1)
+   ELSEIF(WDR.gt.22.5.and.WDR.le.67.5)THEN
+     lambda_f = lf_urb(2)
+   ELSEIF(WDR.ge.-67.5.and.WDR.lt.-22.5)THEN
+     lambda_f = lf_urb(2)
+   ELSEIF(WDR.gt.67.5.and.WDR.le.112.5)THEN
+     lambda_f = lf_urb(3)
+   ELSEIF(WDR.ge.-112.5.and.WDR.lt.-67.5)THEN
+     lambda_f = lf_urb(3)
+   ELSEIF(WDR.gt.112.5.and.WDR.le.157.5)THEN
+     lambda_f = lf_urb(4)
+   ELSEIF(WDR.ge.-157.5.and.WDR.lt.-112.5)THEN
+     lambda_f = lf_urb(4)
+   ELSE
+     lambda_f = lf_urb(1)
+   ENDIF
+
+  !Calculate the following urban canyon geometry parameters following Macdonald's (1998) formulations
+      Cd         = 1.2
+      alpha_macd = 4.43
+      beta_macd  = 1.0
+
+
+      ZDC = ZR * ( 1.0 + ( alpha_macd ** ( -R ) )  * ( R - 1.0 ) )
+
+      Z0C = ZR * ( 1.0 - ZDC/ZR ) * &
+           exp (-(0.5 * beta_macd * Cd / (VonK**2) * ( 1.0-ZDC/ZR) * lambda_f )**(-0.5))
+     
+      if(zo_check.eq.1)THEN
+        write(mesg,*) 'Roughness Length NUDAPT',Z0C
+        WRITE_MESSAGE(mesg)
+      end if
+
+      lambda_fr  = stdh_urb/(SW + BW)
+
+       Z0R = ZR * ( 1.0 - ZDC/ZR) &
+             * exp ( -(0.5 * beta_macd * Cd / (VonK**2) &
+              * ( 1.0-ZDC/ZR) * lambda_fr )**(-0.5))
+
+    
+
+       Z0HC = 0.1 * Z0C
+
+  ! Calculate Sky View Factor
+
+     DHGT=HGT/100.
+     HGT2=0.
+     VFWS=0.
+     HGT2=HGT-DHGT/2.
+      do NUDAPT=1,99
+         HGT2=HGT2-DHGT
+         VFWS=VFWS+0.25*(1.-HGT2/SQRT(HGT2**2.+RW**2.))
+      end do
+
+     VFWS=VFWS/99.
+     VFWS=VFWS*2.
+
+     VFGS=1.-2.*VFWS*HGT/RW
+     SVF=VFGS
+
+    if(zo_check.eq.1)THEN
+      write(mesg,*) 'Roof Roughness Length NUDAPT',Z0R
+      WRITE_MESSAGE(mesg)
+      write(mesg,*) 'Sky View Factor NUDAPT',SVF
+      WRITE_MESSAGE(mesg)
+      write(mesg,*) 'normalized Height NUDAPT', HGT
+      WRITE_MESSAGE(mesg)
+    end if
+
+
+ endif
+
+ !End NUDAPT Modification
+
 
 ! Miao, 2007/01/17, cal. ah
    if(ahoption==1) AH=AH*ahdiuprf(tloc)
 
+! Yang, 2014/10/08, cal. alh
+   Kalh=0
+   if(alhoption==1) THEN
+     if(jmonth==3 .or. jmonth==4 .or. jmonth==5) Kalh=1
+     if(jmonth==6 .or. jmonth==7 .or. jmonth==8) Kalh=2
+     if(jmonth==9 .or. jmonth==10.or. jmonth==11)Kalh=3
+     if(jmonth==12.or. jmonth==1 .or. jmonth==2) Kalh=4
+   endif
+   if(alhoption==1) ALH = ALH*alhdiuprf(tloc2)*alhseason(Kalh)
+
    IF( ZDC+Z0C+2. >= ZA) THEN
     FATAL_ERROR("ZDC + Z0C + 2m is larger than the 1st WRF level - Stop in subroutine urban - change ZDC and Z0C" ) 
    END IF
@@ -544,6 +811,29 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
    TCP=TC
    QCP=QC
 
+!===Yang,2014/10/08, urban hydrological variables for single layer UCM===
+   FLXHUMRP = FLXHUMR
+   FLXHUMBP = FLXHUMB
+   FLXHUMGP = FLXHUMG
+   DRELRP = DRELR
+   DRELBP = DRELB
+   DRELGP = DRELG
+   TGRP   = TGR
+   CMCRP  = CMCR
+   SMRP   = SMR 
+
+!===Yang,2014/10/08, urban irrigation, May-Sep, 9-10pm
+   IF(IRI_SCHEME==1) THEN
+       IF (tloc==21 .or. tloc==22) THEN
+         IF(jmonth==5 .or. jmonth==6 .or. jmonth ==7 .or. &
+          jmonth==8 .or. jmonth==9 ) THEN
+            DO KZ = 1,2
+               SMRP(KZ)= SMCREF
+             END DO
+       ENDIF
+     ENDIF
+   ENDIF
+
    TAV=TA*(1.+0.61*QA)
    PS=RHOO*287.*TAV/100. ![hPa]
 
@@ -576,6 +866,7 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
      IF(.NOT.SHADOW) THEN              ! no shadow effects model
 
        SR1=SX*(1.-ALBR)
+       SGR1=SX*(1.-ALBV)
        SG1=SX*VFGS*(1.-ALBG)
        SB1=SX*VFWS*(1.-ALBB)
        SG2=SB1*ALBB/(1.-ALBB)*VFGW*(1.-ALBG)
@@ -621,6 +912,7 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
        SLX=(SLX1+SLX2+SLX3+SLX4+SLX5+SLX6+SLX7+SLX8)/8.
 
        SR1=SD*(1.-ALBR)+SQ*(1.-ALBR)
+       SGR1=SD*(1.-ALBV)+SQ*(1.-ALBV)
        SG1=SD*(RW-SLX)/RW*(1.-ALBG)+SQ*VFGS*(1.-ALBG)
        SB1=SD*SLX/W*(1.-ALBB)+SQ*VFWS*(1.-ALBB)
        SG2=SB1*ALBB/(1.-ALBB)*VFGW*(1.-ALBG)
@@ -629,15 +921,21 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
      END IF
 
      SR=SR1
+     SGR=SGR1
      SG=SG1+SG2
      SB=SB1+SB2
 
+     IF (GROPTION ==1) THEN
+     SNET=R*FGR*SGR+R*(1.-FGR)*SR+W*SB+RW*SG
+     ELSE
      SNET=R*SR+W*SB+RW*SG
+     ENDIF
 
    ELSE
 
      SR=0.
      SG=0.
+     SGR=0.
      SB=0.
      SNET=0.
 
@@ -667,7 +965,30 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
    ALPHAR =  RHO*CP*CHR_URB
    CHR=ALPHAR/RHO/CP/UA
 
-   IF(RAIN > 1.) BETR=0.7  
+! Yang, 03/12/2014 -- LH for impervious roof surface  
+   RAIN1 = RAIN * 0.001 /3600          ! CONVERT FROM mm/hr to m/s
+   IF (IMP_SCHEME==1) then
+   IF (RAIN > 1.) BETR=0.7
+   ENDIF   
+
+   IF (IMP_SCHEME==2) then
+   IF (FLXHUMRP <= 0.) FLXHUMRP = 0. 
+!  Compute water retention depth from previous time step 
+   DrelR = DrelRP+(RAIN1-FLXHUMRP)*DELT/porimp(IMPR)
+   IF (RAIN > 0. .AND. DrelR < DrelRP) DrelR = DrelRP 
+  
+   IF (DrelR <= 0.) then
+   DrelR  = 0.0
+   BETR	  = 0.0
+   ELSEIf (DrelR <= dengimp(IMPR)) then
+   BETR = DrelR/dengimp(IMPR)*porimp(IMPR)
+   ELSE
+   DrelR = dengimp(IMPR)
+   BETR  = porimp(IMPR)   
+   ENDIF
+
+   IF ( BETR < 1.E-5 ) BETR = 0.0
+   ENDIF
 
    IF (TS_SCHEME == 1) THEN 
 
@@ -740,6 +1061,113 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
    FLXTHR=HR/RHO/CP/100.
    FLXHUMR=ELER/RHO/EL/100.
 
+!-------------------------------------------------------------------------------
+! Green Roof
+! Must use multiple layers scheme (TS_SCHEME=1)
+!-------------------------------------------------------------------------------     
+   IF (GROPTION == 1) THEN
+   T1VGR = TGRP* (1.0+ 0.61 * QA) 
+   RLMO_URB=0.0
+   CALL SFCDIF_URB (ZA,Z0R,T1VGR,TH2V,UA,AKANDA_URBAN,CMGR_URB,CHGR_URB,RLMO_URB,CDGR)
+   ALPHAGR =  RHO*CP*CHGR_URB
+   CHGR=ALPHAGR/RHO/CP/UA
+   RUNOFF1 = 0.0
+   RUNOFF2 = 0.0
+   RUNOFF3 = 0.0
+
+   KZ = 1
+   ZSOILR (KZ) = - DZGR (KZ) 
+   DO KZ = 2,NGR
+      ZSOILR (KZ) = - DZGR(KZ) + ZSOILR (KZ -1)
+   END DO
+
+   DO ITERATION=1,100
+       KZ=1     
+       ES=6.11*EXP( (2.5*10.**6./461.51)*(TGRP-273.15)/(273.15*TGRP) )
+       DESDT=(2.5*10.**6./461.51)*ES/(TGRP**2.)
+       QS0GR=0.622*ES/(PS-0.378*ES) 
+       DQS0GRDTGR = DESDT*0.622*PS/((PS-0.378*ES)**2.) 
+       EPGR=RHOO*CHGR*UA*(QS0GR-QA)   ! Potential evaporation [kg/m2/s]
+
+       IF (EPGR > 0.0) THEN
+       ! Direct evaporation from soil on green roof 
+       CALL DIREVAP (EDIR,EPGR,SMRP(KZ),SHDFAC,SMCMAX,SMCDRY,FXEXP)    
+       ! Evapotranspiration and canopy intercepted evaporation
+       CALL TRANSP  (ETTR,ETR,ECR,SHDFAC,EPGR,CMCRP,CFACTR,CMCMAX,LAI,RSMIN,RSMAX,RGL,SX, &
+                     TGRP,TA,QA,SMRP,SMCWLT,SMCREF,CPP,PS,CHGR,EPSV,DELT,NROOT,NGR,DZGR, &
+                     ZSOILR,HS)
+       ! Update moisture in soil layers
+       CALL SMFLX   (SMRP,SMR,NGR,CMCRP,CMCR,DELT,RAIN,ZSOILR,SMCMAX,BEXP,SMCWLT,DKSAT,&
+                     DWSAT,SHDFAC,CMCMAX,RUNOFF1,RUNOFF2,RUNOFF3,EDIR,ECR,ETR,DRIP)  
+       else 
+       DEW  = - EPGR
+       RAINDR = RAIN  + DEW * 3600.
+       EDIR=0.0
+       ECR =0.0
+       ETTR=0.0
+       CALL SMFLX (SMRP,SMR,NGR,CMCRP,CMCR,DELT,RAINDR,ZSOILR,SMCMAX,BEXP,SMCWLT,DKSAT,&
+                   DWSAT,SHDFAC,CMCMAX,RUNOFF1,RUNOFF2,RUNOFF3,EDIR,ECR,ETR,DRIP)  
+       END IF
+! ----------------------------------------------------------------------
+! CONVERT MODELED EVAPOTRANSPIRATION FROM  M S-1  TO  KG M-2 S-1.
+! ----------------------------------------------------------------------
+       EDIR = EDIR  * 1000.0
+       ETTR = ETTR  * 1000.0
+       ECR  = ECR   * 1000.0
+       ETAR = EDIR + ETTR + ECR
+       IF (ETAR < 1.E-20) ETAR = 0.0
+
+       IF ( EPGR <= 0.0 ) THEN
+         BETGR = 0.0
+       ELSE
+         BETGR = ETAR / EPGR 
+       END IF   
+       ELEGR= ETAR* RHO * EL /RHOO * 100
+          
+       CALL TDFCND (DF1,SMR(KZ), QUARTZ, SMCMAX )
+       DF1 = DF1 * EXP(-2.0 * SHDFAC)  
+       RGR = EPSV*(RX-SIG*(TGRP**4.)/60.)
+       RGRR= (SGR+RGR) * 697.7 * 60.
+       RCH = RHOO*CPP*CHGR
+       RR1 = EPSV*(TA**4) * 6.48E-8 / (PS* CHGR) + 1.0
+       IF (RAIN >  0.0) then
+       RR2 = RR1 + RAIN / 3600 * 4.218E+3 / RCH
+       else
+       RR2 = RR1
+       end if 
+       YY  = TA + (RGRR / RCH - BETGR * EPGR * ELL/ RCH) / RR2  
+       ZZ1 = DF1 / (-0.5 * ZSOILR (KZ) * RCH * RR2 ) + 1.0
+
+
+       HGR=RHO*CP*CHGR*UA*(TGRP-TA)*100.     
+       RUNOFF3 = RUNOFF3/ DELT
+       RUNOFF2 = RUNOFF2+ RUNOFF3      
+       G0GR    = DF1*(TGRP-TGRL(1))/(DZGR(1)/2.)/697.7/60
+
+       FV = SGR + RGR - HGR - ELEGR - G0GR
+       DRRDTGR   = (-4.*EPSV*SIG*TGRP**3.)/60.
+       DHRDTGR   = RHO*CP*CHGR*UA*100.
+       DELERDTGR = RHO*EL*CHGR*UA*BETGR*DQS0GRDTGR*100.
+       DG0RDTGR  = 2.*DF1/ DZGR(KZ) * ( 1.0 / 4.1868 ) * 1.E-4
+       DFDVT = DRRDTGR - DHRDTGR - DELERDTGR - DG0RDTGR 
+       DTGR = FV/DFDVT/ 6
+       TGR  = TGRP - DTGR
+       TGRP = TGR
+
+       IF( ABS(FV) < 0.0001 .AND. ABS(DTGR) < 0.001 ) then
+       EXIT
+       ENDIF
+     END DO
+       ! Update temperature in soil layer
+       CALL SHFLX (SSOILR,TGRL,SMR,SMCMAX,NGR,TGRP,DELT,YY,ZZ1,ZSOILR,       &
+                   TRLEND,ZBOT,SMCWLT,DF1,QUARTZ,CSOIL,CAPR)
+   FLXTHGR=HGR/RHO/CP/100.
+   FLXHUMGR=ELEGR/RHO/EL/100.
+ELSE
+   FLXTHGR=0.
+   FLXHUMGR=0.
+ENDIF
+
 !-------------------------------------------------------------------------------
 !  Wall and Road 
 !-------------------------------------------------------------------------------
@@ -784,8 +1212,45 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
    CHB=ALPHAB/RHO/CP/UC
    CHG=ALPHAG/RHO/CP/UC
 
+!Yang 10/10/2013 -- LH from impervious wall and ground
+ IF (IMP_SCHEME==1) then
    BETB=0.0
    IF(RAIN > 1.) BETG=0.7
+ ENDIF
+
+ IF (IMP_SCHEME==2) then
+   IF (FLXHUMBP <= 0.) FLXHUMBP = 0. 
+   IF (FLXHUMGP <= 0.) FLXHUMGP = 0. 
+! Compute water retention from previous time step for wall and ground
+  DrelB = DrelBP+(RAIN1-FLXHUMBP)*DELT/porimp(IMPB) 
+    IF (RAIN > 0. .AND. DrelB < DrelBP) DrelB = DrelBP 
+  DrelG = DrelGP+(RAIN1-FLXHUMGP)*DELT/porimp(IMPG)  
+    IF (RAIN > 0. .AND. DrelG < DrelGP) DrelG = DrelGP 
+  
+  IF (DrelB <= 0.) then
+  DrelB   = 0.0
+  BETB    = 0.0
+  ELSEIf (DrelB <= dengimp(IMPB)) then
+  BETB  = DrelB/dengimp(IMPB)*porimp(IMPB) 
+  ELSE
+  DrelB = dengimp(IMPB)
+  BETB = porimp(IMPB) 
+  ENDIF
+
+  IF (DrelG <= 0.) then
+  DrelG   = 0.0
+  BETG    = 0.0
+  ELSEIf (DrelG <= dengimp(IMPG)) then
+  BETG  = DrelG/dengimp(IMPG)*porimp(IMPG) 
+  ELSE
+  DrelG = dengimp(IMPG)
+  BETG  = porimp(IMPG) 
+  ENDIF
+
+  if ( BETG < 1.E-5 ) BETG = 0.0
+  if ( BETB < 1.E-5 ) BETB = 0.0
+ 
+ENDIF
 
    IF (TS_SCHEME == 1) THEN
 
@@ -986,17 +1451,36 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
 !-------------------------------------------------------------------------------
 ! Total Fluxes from Urban Canopy
 !-------------------------------------------------------------------------------
-
-   FLXUV  = ( R*CDR + RW*CDC )*UA*UA
-! Miao, 2007/01/17, cal. ah
+!===Yang, 2014/10/08, cal. ah. alh. green roof===
+ if(groption==1) then
+   if(ahoption==1) then
+     FLXTH  = ((1.-FGR)*R*FLXTHR + FGR*R*FLXTHGR + W*FLXTHB + RW*FLXTHG)+ AH/RHOO/CPP
+   else
+     FLXTH  = ((1.-FGR)*R*FLXTHR + FGR*R*FLXTHGR + W*FLXTHB + RW*FLXTHG)
+   endif
+   if(alhoption==1) then
+     FLXHUM  = ((1.-FGR)*R*FLXHUMR + FGR*R*FLXHUMGR + W*FLXHUMB + RW*FLXHUMG)+ ALH/RHOO/ELL
+   else
+     FLXHUM  = ((1.-FGR)*R*FLXHUMR + FGR*R*FLXHUMGR + W*FLXHUMB + RW*FLXHUMG)
+   endif
+   FLXUV  = ((1.-FGR)*R*CDR + FGR*R*CDGR + RW*CDC )*UA*UA
+   FLXG =   ((1.-FGR)*R*G0R + FGR*R*G0GR+ W*G0B + RW*G0G)
+   LNET =   (1.-FGR) * R * RR + FGR *R* RGR + W * RB +  RW * RG 
+ else
    if(ahoption==1) then
      FLXTH  = ( R*FLXTHR  + W*FLXTHB  + RW*FLXTHG ) + AH/RHOO/CPP
    else
      FLXTH  = ( R*FLXTHR  + W*FLXTHB  + RW*FLXTHG )
    endif
-   FLXHUM = ( R*FLXHUMR + W*FLXHUMB + RW*FLXHUMG )
+   if(alhoption==1) then
+     FLXHUM = ( R*FLXHUMR + W*FLXHUMB + RW*FLXHUMG )+ ALH/RHOO/ELL
+   else
+     FLXHUM = ( R*FLXHUMR + W*FLXHUMB + RW*FLXHUMG )
+   endif
+   FLXUV  = ( R*CDR + RW*CDC )*UA*UA
    FLXG =   ( R*G0R + W*G0B + RW*G0G )
    LNET =     R*RR + W*RB + RW*RG
+ endif
 
 !----------------------------------------------------------------------------
 ! Convert Unit: FLUXES and u* T* q*  --> WRF
@@ -1023,6 +1507,7 @@ SUBROUTINE urban(LSOLAR,                                           & ! L
    Z0 = Z0C 
    Z0H = Z0HC
    Z = ZA - ZDC
+   ZNT = Z0   ! add by Dan Li
 
    XXX = 0.4*9.81*Z*TST/TA/UST/UST
 
@@ -1364,11 +1849,11 @@ SUBROUTINE read_param(UTYPE,                                        & ! in
                          HPERCENT_BIN,                                 & ! out
 !end BEP
                          BOUNDR,BOUNDB,BOUNDG,CH_SCHEME,TS_SCHEME,     & ! out
-                         AKANDA_URBAN)                                   ! out
+                         AKANDA_URBAN,ALH)         ! out
 
    INTEGER, INTENT(IN)  :: UTYPE 
 
-   REAL, INTENT(OUT)    :: ZR,Z0C,Z0HC,ZDC,SVF,R,RW,HGT,AH,              &
+   REAL, INTENT(OUT)    :: ZR,Z0C,Z0HC,ZDC,SVF,R,RW,HGT,AH,ALH,          &
                            CAPR,CAPB,CAPG,AKSR,AKSB,AKSG,ALBR,ALBB,ALBG, &
                            SIGMA_ZED,                                    &
                            EPSR,EPSB,EPSG,Z0R,Z0B,Z0G,Z0HB,Z0HG,         &
@@ -1397,6 +1882,7 @@ SUBROUTINE read_param(UTYPE,                                        & ! in
    RW=      RW_TBL(UTYPE)
    HGT=     HGT_TBL(UTYPE)
    AH=      AH_TBL(UTYPE)
+   ALH=     ALH_TBL(UTYPE)
    BETR=    BETR_TBL(UTYPE)
    BETB=    BETB_TBL(UTYPE)
    BETG=    BETG_TBL(UTYPE)
@@ -1550,6 +2036,8 @@ SUBROUTINE urban_param_init(DZR,DZB,DZG,num_soil_layers, &
             if(allocate_status /= 0) FATAL_ERROR('Error allocating HGT_TBL in urban_param_init')
             ALLOCATE( AH_TBL(ICATE), stat=allocate_status )
             if(allocate_status /= 0) FATAL_ERROR('Error allocating AH_TBL in urban_param_init')
+            ALLOCATE( ALH_TBL(ICATE), stat=allocate_status )
+            if(allocate_status /= 0) FATAL_ERROR('Error allocating ALH_TBL in urban_param_init')
             ALLOCATE( BETR_TBL(ICATE), stat=allocate_status )
             if(allocate_status /= 0) FATAL_ERROR('Error allocating BETR_TBL in urban_param_init')
             ALLOCATE( BETB_TBL(ICATE), stat=allocate_status )
@@ -1601,9 +2089,9 @@ SUBROUTINE urban_param_init(DZR,DZB,DZG,num_soil_layers, &
             ALLOCATE( FRC_URB_TBL(ICATE), stat=allocate_status )
             if(allocate_status /= 0) FATAL_ERROR('Error allocating FRC_URB_TBL in urban_param_init')
             ! ALLOCATE( ROOF_WIDTH(ICATE), stat=allocate_status )
-              if(allocate_status /= 0) FATAL_ERROR('Error allocating ROOF_WIDTH in urban_param_init')
+            ! if(allocate_status /= 0) FATAL_ERROR('Error allocating ROOF_WIDTH in urban_param_init')
             ! ALLOCATE( ROAD_WIDTH(ICATE), stat=allocate_status )
-              if(allocate_status /= 0) FATAL_ERROR('Error allocating ROAD_WIDTH in urban_param_init')
+            ! if(allocate_status /= 0) FATAL_ERROR('Error allocating ROAD_WIDTH in urban_param_init')
             !for BEP
             ALLOCATE( NUMDIR_TBL(ICATE), stat=allocate_status )
             if(allocate_status /= 0) FATAL_ERROR('Error allocating NUMDIR_TBL in urban_param_init')
@@ -1668,6 +2156,8 @@ SUBROUTINE urban_param_init(DZR,DZB,DZG,num_soil_layers, &
          read(string(indx+1:),*) road_width(1:icate)
       else if (name == "AH") then
          read(string(indx+1:),*) ah_tbl(1:icate)
+      else if (name == "ALH") then
+         read(string(indx+1:),*) alh_tbl(1:icate)
       else if (name == "FRC_URB") then
          read(string(indx+1:),*) frc_urb_tbl(1:icate)
       else if (name == "CAPR") then
@@ -1744,6 +2234,28 @@ SUBROUTINE urban_param_init(DZR,DZB,DZG,num_soil_layers, &
          read(string(indx+1:),*) ahoption
       else if (name == "AHDIUPRF") then
          read(string(indx+1:),*) ahdiuprf(1:24)
+      else if (name == "ALHOPTION") then
+         read(string(indx+1:),*) alhoption
+      else if (name == "ALHSEASON") then
+         read(string(indx+1:),*) alhseason(1:4)
+      else if (name == "ALHDIUPRF") then
+         read(string(indx+1:),*) alhdiuprf(1:48)
+      else if (name == "PORIMP") then
+         read(string(indx+1:),*) porimp(1:3)
+      else if (name == "DENGIMP") then
+         read(string(indx+1:),*) dengimp(1:3)
+      else if (name == "IMP_SCHEME") then
+         read(string(indx+1:),*) imp_scheme
+      else if (name == "IRI_SCHEME") then
+         read(string(indx+1:),*) iri_scheme
+      else if (name == "OASIS") then
+         read(string(indx+1:),*) oasis
+      else if (name == "GROPTION") then
+         read(string(indx+1:),*) groption
+      else if (name == "FGR") then
+         read(string(indx+1:),*) fgr
+      else if (name == "DZGR") then
+         read(string(indx+1:),*) dzgr(1:4)
 !for BEP
       else if (name == "STREET PARAMETERS") then
 
@@ -1899,6 +2411,10 @@ END SUBROUTINE urban_param_init
    SUBROUTINE urban_var_init(ISURBAN, TSURFACE0_URB,TLAYER0_URB,TDEEP0_URB,IVGTYP,  & ! in
                              ims,ime,jms,jme,kms,kme,num_soil_layers,         & ! in
 !                             num_roof_layers,num_wall_layers,num_road_layers, & ! in
+!                              num_roof_layers,num_wall_layers,num_road_layers, & !urban
+                             LOW_DENSITY_RESIDENTIAL,                    &
+		             HIGH_DENSITY_RESIDENTIAL,                   &
+		             HIGH_INTENSITY_INDUSTRIAL,                    &
                              restart,sf_urban_physics,                     & !in
                              XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D,  & ! inout
                              TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & ! inout
@@ -1906,6 +2422,7 @@ SUBROUTINE urban_var_init(ISURBAN, TSURFACE0_URB,TLAYER0_URB,TDEEP0_URB,IVGTYP,
                              SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D,           & ! inout
                              TS_URB2D,                                     & ! inout
                              num_urban_layers,                             & ! in
+                             num_urban_hi,                                 & ! in
                              TRB_URB4D,TW1_URB4D,TW2_URB4D,TGB_URB4D,      & ! inout
                              TLEV_URB3D,QLEV_URB3D,                        & ! inout
                              TW1LEV_URB3D,TW2LEV_URB3D,                    & ! inout
@@ -1914,6 +2431,12 @@ SUBROUTINE urban_var_init(ISURBAN, TSURFACE0_URB,TLAYER0_URB,TDEEP0_URB,IVGTYP,
                              SFVENT_URB3D,LFVENT_URB3D,                    & ! inout
                              SFWIN1_URB3D,SFWIN2_URB3D,                    & ! inout
                              SFW1_URB3D,SFW2_URB3D,SFR_URB3D,SFG_URB3D,    & ! inout
+                             LP_URB2D,HI_URB2D,LB_URB2D,                   & ! inout
+                             HGT_URB2D,MH_URB2D,STDH_URB2D,                & ! inout
+                             LF_URB2D,                                     & ! inout
+                             CMCR_URB2D,TGR_URB2D,TGRL_URB3D,SMR_URB3D,    & ! inout
+                             DRELR_URB2D,DRELB_URB2D,DRELG_URB2D,          & ! inout
+                             FLXHUMR_URB2D, FLXHUMB_URB2D, FLXHUMG_URB2D,  & ! inout
                              A_U_BEP,A_V_BEP,A_T_BEP,A_Q_BEP,              & ! inout multi-layer urban
                              A_E_BEP,B_U_BEP,B_V_BEP,                      & ! inout multi-layer urban
                              B_T_BEP,B_Q_BEP,B_E_BEP,DLG_BEP,              & ! inout multi-layer urban
@@ -1922,8 +2445,10 @@ SUBROUTINE urban_var_init(ISURBAN, TSURFACE0_URB,TLAYER0_URB,TDEEP0_URB,IVGTYP,
    IMPLICIT NONE
 
    INTEGER, INTENT(IN) :: ISURBAN, sf_urban_physics
+   INTEGER, INTENT(IN) :: LOW_DENSITY_RESIDENTIAL, HIGH_DENSITY_RESIDENTIAL, HIGH_INTENSITY_INDUSTRIAL
    INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme,num_soil_layers
    INTEGER, INTENT(IN) :: num_urban_layers                            !multi-layer urban
+   INTEGER, INTENT(IN) :: num_urban_hi                                !multi-layer urban
 !   INTEGER, INTENT(IN) :: num_roof_layers, num_wall_layers, num_road_layers
 
    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)                    :: TSURFACE0_URB
@@ -1942,12 +2467,23 @@ SUBROUTINE urban_var_init(ISURBAN, TSURFACE0_URB,TLAYER0_URB,TDEEP0_URB,IVGTYP,
    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D
    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D
 
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELR_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELB_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELG_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMR_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMB_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMG_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMCR_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TGR_URB2D
+
 !   REAL, DIMENSION(ims:ime, 1:num_roof_layers, jms:jme), INTENT(INOUT) :: TRL_URB3D
 !   REAL, DIMENSION(ims:ime, 1:num_wall_layers, jms:jme), INTENT(INOUT) :: TBL_URB3D
 !   REAL, DIMENSION(ims:ime, 1:num_road_layers, jms:jme), INTENT(INOUT) :: TGL_URB3D
    REAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TRL_URB3D
    REAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TBL_URB3D
    REAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TGL_URB3D
+   REAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TGRL_URB3D
+   REAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: SMR_URB3D
 
    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D
    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D
@@ -1977,6 +2513,13 @@ SUBROUTINE urban_var_init(ISURBAN, TSURFACE0_URB,TLAYER0_URB,TDEEP0_URB,IVGTYP,
    REAL, DIMENSION(ims:ime, 1:num_urban_layers, jms:jme), INTENT(INOUT) :: SFW2_URB3D
    REAL, DIMENSION(ims:ime, 1:num_urban_layers, jms:jme), INTENT(INOUT) :: SFR_URB3D
    REAL, DIMENSION(ims:ime, 1:num_urban_layers, jms:jme), INTENT(INOUT) :: SFG_URB3D
+   REAL, DIMENSION( ims:ime,1:num_urban_hi, jms:jme), INTENT(INOUT) :: HI_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LP_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LB_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: HGT_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: MH_URB2D
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: STDH_URB2D
+   REAL, DIMENSION( ims:ime, 4,jms:jme ), INTENT(INOUT) :: LF_URB2D
    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_U_BEP
    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_V_BEP
    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_T_BEP
@@ -1995,8 +2538,12 @@ SUBROUTINE urban_var_init(ISURBAN, TSURFACE0_URB,TLAYER0_URB,TDEEP0_URB,IVGTYP,
    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D
    INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D
    INTEGER                                            :: UTYPE_URB
+!FS
+   INTEGER :: SWITCH_URB
+
+   INTEGER :: I,J,K,CHECK
 
-   INTEGER :: I,J,K
+   CHECK = 0
 
    DO I=ims,ime
     DO J=jms,jme
@@ -2012,28 +2559,168 @@ SUBROUTINE urban_var_init(ISURBAN, TSURFACE0_URB,TLAYER0_URB,TDEEP0_URB,IVGTYP,
       RN_URB2D(I,J)=0.
       
 !m
-      FRC_URB2D(I,J)=0.
+!FS   FRC_URB2D(I,J)=0.
       UTYPE_URB2D(I,J)=0
+      SWITCH_URB=0
 
             IF( IVGTYP(I,J) == ISURBAN)  THEN
                UTYPE_URB2D(I,J) = 2  ! for default. high-intensity
                UTYPE_URB = UTYPE_URB2D(I,J)  ! for default. high-intensity
-               FRC_URB2D(I,J) = FRC_URB_TBL(UTYPE_URB)
-            ENDIF
-            IF( IVGTYP(I,J) == 31) THEN
-               UTYPE_URB2D(I,J) = 3  ! low-intensity residential
+               IF (HGT_URB2D(I,J)>0.) THEN
+                  CONTINUE
+               ELSE
+                  WRITE(mesg,*) 'USING DEFAULT URBAN MORPHOLOGY'
+                  WRITE_MESSAGE(mesg)
+                  LP_URB2D(I,J)=0.
+                  LB_URB2D(I,J)=0.
+                  HGT_URB2D(I,J)=0.
+                  IF ( sf_urban_physics == 1 ) THEN
+                     MH_URB2D(I,J)=0.
+                     STDH_URB2D(I,J)=0.
+                     DO K=1,4
+                       LF_URB2D(I,K,J)=0.
+                     ENDDO
+                  ELSE IF ( ( sf_urban_physics == 2 ) .or. ( sf_urban_physics == 3 ) ) THEN
+                     DO K=1,num_urban_hi
+                        HI_URB2D(I,K,J)=0.
+                     ENDDO
+                  ENDIF
+               ENDIF
+                IF (FRC_URB2D(I,J)>0.and.FRC_URB2D(I,J)<=1.) THEN
+                  CONTINUE
+                ELSE
+                  WRITE(mesg,*) 'WARNING, FRC_URB2D = 0 BUT IVGTYP IS URBAN'
+                  WRITE_MESSAGE(mesg)
+                  WRITE(mesg,*) 'WARNING, THE URBAN FRACTION WILL BE READ FROM URBPARM.TBL'
+                  WRITE_MESSAGE(mesg)
+                  FRC_URB2D(I,J) = FRC_URB_TBL(UTYPE_URB)
+                ENDIF           
+               SWITCH_URB=1
+            ENDIF 
+
+            IF( IVGTYP(I,J) == LOW_DENSITY_RESIDENTIAL) THEN
+               UTYPE_URB2D(I,J) = 1  ! low-intensity residential
                UTYPE_URB = UTYPE_URB2D(I,J)  ! low-intensity residential
-               FRC_URB2D(I,J) = FRC_URB_TBL(UTYPE_URB) 
+               IF (HGT_URB2D(I,J)>0.) THEN
+                  CONTINUE
+               ELSE
+                  WRITE(mesg,*) 'USING DEFAULT URBAN MORPHOLOGY'
+                  WRITE_MESSAGE(mesg)
+                  LP_URB2D(I,J)=0.
+                  LB_URB2D(I,J)=0.
+                  HGT_URB2D(I,J)=0.
+                  IF ( sf_urban_physics == 1 ) THEN
+                     MH_URB2D(I,J)=0.
+                     STDH_URB2D(I,J)=0.
+                     DO K=1,4
+                       LF_URB2D(I,K,J)=0.
+                     ENDDO
+                  ELSE IF ( ( sf_urban_physics == 2 ) .or. ( sf_urban_physics == 3 ) ) THEN
+                     DO K=1,num_urban_hi
+                        HI_URB2D(I,K,J)=0.
+                     ENDDO
+                  ENDIF
+               ENDIF
+                IF (FRC_URB2D(I,J)>0.and.FRC_URB2D(I,J)<=1.) THEN
+                  CONTINUE
+                ELSE
+                  WRITE(mesg,*) 'WARNING, FRC_URB2D = 0 BUT IVGTYP IS URBAN'
+                  WRITE_MESSAGE(mesg)
+                  WRITE(mesg,*) 'WARNING, THE URBAN FRACTION WILL BE READ FROM URBPARM.TBL'
+                  WRITE_MESSAGE(mesg)
+                  FRC_URB2D(I,J) = FRC_URB_TBL(UTYPE_URB)
+                ENDIF         
+              SWITCH_URB=1
             ENDIF
-            IF( IVGTYP(I,J) == 32) THEN
+
+           IF( IVGTYP(I,J) == HIGH_DENSITY_RESIDENTIAL) THEN
                UTYPE_URB2D(I,J) = 2  ! high-intensity
                UTYPE_URB = UTYPE_URB2D(I,J)  ! high-intensity
-               FRC_URB2D(I,J) = FRC_URB_TBL(UTYPE_URB) 
+              IF (HGT_URB2D(I,J)>0.) THEN
+                  CONTINUE
+               ELSE
+                  WRITE(mesg,*) 'USING DEFAULT URBAN MORPHOLOGY'
+                  WRITE_MESSAGE(mesg)
+                  LP_URB2D(I,J)=0.
+                  LB_URB2D(I,J)=0.
+                  HGT_URB2D(I,J)=0.
+                  IF ( sf_urban_physics == 1 ) THEN
+                     MH_URB2D(I,J)=0.
+                     STDH_URB2D(I,J)=0.
+                     DO K=1,4
+                       LF_URB2D(I,K,J)=0.
+                     ENDDO
+                  ELSE IF ( ( sf_urban_physics == 2 ) .or. ( sf_urban_physics == 3 ) ) THEN
+                     DO K=1,num_urban_hi
+                        HI_URB2D(I,K,J)=0.
+                     ENDDO
+                  ENDIF
+               ENDIF
+                IF (FRC_URB2D(I,J)>0.and.FRC_URB2D(I,J)<=1.) THEN
+                  CONTINUE
+                ELSE
+                  WRITE(mesg,*) 'WARNING, FRC_URB2D = 0 BUT IVGTYP IS URBAN'
+                  WRITE_MESSAGE(mesg)
+                  WRITE(mesg,*) 'WARNING, THE URBAN FRACTION WILL BE READ FROM URBPARM.TBL'
+                  WRITE_MESSAGE(mesg)
+                  FRC_URB2D(I,J) = FRC_URB_TBL(UTYPE_URB)
+                ENDIF
+              SWITCH_URB=1
             ENDIF
-            IF( IVGTYP(I,J) == 33) THEN
-               UTYPE_URB2D(I,J) = 1  !  Commercial/Industrial/Transportation
+
+            IF( IVGTYP(I,J) == HIGH_INTENSITY_INDUSTRIAL) THEN
+               UTYPE_URB2D(I,J) = 3  !  Commercial/Industrial/Transportation
                UTYPE_URB = UTYPE_URB2D(I,J)  !  Commercial/Industrial/Transportation
-               FRC_URB2D(I,J) = FRC_URB_TBL(UTYPE_URB) 
+              IF (HGT_URB2D(I,J)>0.) THEN
+                  CONTINUE
+               ELSE
+                  WRITE(mesg,*) 'USING DEFAULT URBAN MORPHOLOGY'
+                  WRITE_MESSAGE(mesg)
+                  LP_URB2D(I,J)=0.
+                  LB_URB2D(I,J)=0.
+                  HGT_URB2D(I,J)=0.
+                  IF ( sf_urban_physics == 1 ) THEN
+                     MH_URB2D(I,J)=0.
+                     STDH_URB2D(I,J)=0.
+                     DO K=1,4
+                       LF_URB2D(I,K,J)=0.
+                     ENDDO
+                  ELSE IF ( ( sf_urban_physics == 2 ) .or. ( sf_urban_physics == 3 ) ) THEN
+                     DO K=1,num_urban_hi
+                        HI_URB2D(I,K,J)=0.
+                     ENDDO
+                  ENDIF
+               ENDIF
+                IF (FRC_URB2D(I,J)>0.and.FRC_URB2D(I,J)<=1.) THEN
+                  CONTINUE
+                ELSE
+                  WRITE(mesg,*) 'WARNING, FRC_URB2D = 0 BUT IVGTYP IS URBAN'
+                  WRITE_MESSAGE(mesg)
+                  WRITE(mesg,*) 'WARNING, THE URBAN FRACTION WILL BE READ FROM URBPARM.TBL'
+                  WRITE_MESSAGE(mesg)
+                  FRC_URB2D(I,J) = FRC_URB_TBL(UTYPE_URB)
+                ENDIF
+               SWITCH_URB=1
+            ENDIF
+
+            IF (SWITCH_URB==1) THEN
+                CONTINUE
+            ELSE
+                FRC_URB2D(I,J)=0.
+                LP_URB2D(I,J)=0.
+                LB_URB2D(I,J)=0.
+                HGT_URB2D(I,J)=0.
+                IF ( sf_urban_physics == 1 ) THEN
+                   MH_URB2D(I,J)=0.
+                   STDH_URB2D(I,J)=0.
+                   DO K=1,4
+                      LF_URB2D(I,K,J)=0.
+                   ENDDO
+                ELSE IF ( ( sf_urban_physics == 2 ) .or. ( sf_urban_physics == 3 ) ) THEN
+                   DO K=1,num_urban_hi
+                      HI_URB2D(I,K,J)=0.
+                   ENDDO
+                ENDIF
             ENDIF
 
 
@@ -2046,6 +2733,16 @@ SUBROUTINE urban_var_init(ISURBAN, TSURFACE0_URB,TLAYER0_URB,TDEEP0_URB,IVGTYP,
       XXXG_URB2D(I,J)=0.
       XXXC_URB2D(I,J)=0.
 
+      IF ( sf_urban_physics == 1 ) THEN
+      DRELR_URB2D(I,J) = 0.
+      DRELB_URB2D(I,J) = 0.
+      DRELG_URB2D(I,J) = 0.
+      FLXHUMR_URB2D(I,J) = 0.
+      FLXHUMB_URB2D(I,J) = 0.
+      FLXHUMG_URB2D(I,J) = 0.
+      CMCR_URB2D(I,J)  = 0.
+      TGR_URB2D(I,J)=TSURFACE0_URB(I,J)+0.
+      ENDIF
 
       TC_URB2D(I,J)=TSURFACE0_URB(I,J)+0.
       TR_URB2D(I,J)=TSURFACE0_URB(I,J)+0.
@@ -2054,7 +2751,7 @@ SUBROUTINE urban_var_init(ISURBAN, TSURFACE0_URB,TLAYER0_URB,TDEEP0_URB,IVGTYP,
 !
       TS_URB2D(I,J)=TSURFACE0_URB(I,J)+0.
 
-!      DO K=1,num_roof_layers
+!     DO K=1,num_roof_layers
 !     DO K=1,num_soil_layers
 !         TRL_URB3D(I,1,J)=TLAYER0_URB(I,1,J)+0.
 !         TRL_URB3D(I,2,J)=TLAYER0_URB(I,2,J)+0.
@@ -2065,6 +2762,18 @@ SUBROUTINE urban_var_init(ISURBAN, TSURFACE0_URB,TLAYER0_URB,TDEEP0_URB,IVGTYP,
           TRL_URB3D(I,2,J)=0.5*(TLAYER0_URB(I,1,J)+TLAYER0_URB(I,2,J))
           TRL_URB3D(I,3,J)=TLAYER0_URB(I,2,J)+0.
           TRL_URB3D(I,4,J)=TLAYER0_URB(I,2,J)+(TLAYER0_URB(I,3,J)-TLAYER0_URB(I,2,J))*0.29
+
+      IF ( sf_urban_physics == 1 ) THEN
+          TGRL_URB3D(I,1,J)=TLAYER0_URB(I,1,J)+0.
+          TGRL_URB3D(I,2,J)=0.5*(TLAYER0_URB(I,1,J)+TLAYER0_URB(I,2,J))
+          TGRL_URB3D(I,3,J)=TLAYER0_URB(I,2,J)+0.
+          TGRL_URB3D(I,4,J)=TLAYER0_URB(I,2,J)+(TLAYER0_URB(I,3,J)-TLAYER0_URB(I,2,J))*0.29
+
+          SMR_URB3D(I,1,J)=0.2
+          SMR_URB3D(I,2,J)=0.2
+          SMR_URB3D(I,3,J)=0.2
+          SMR_URB3D(I,4,J)=0.
+      ENDIF
 !     END DO
 
 !      DO K=1,num_wall_layers
@@ -2160,6 +2869,60 @@ SUBROUTINE urban_var_init(ISURBAN, TSURFACE0_URB,TLAYER0_URB,TDEEP0_URB,IVGTYP,
       END DO
       ENDIF       !sf_urban_physics=2
      ENDIF        !restart
+
+
+      IF (CHECK.EQ.0)THEN
+      IF(IVGTYP(I,J).EQ.1)THEN
+        write(mesg,*) 'TSURFACE0_URB',TSURFACE0_URB(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'TDEEP0_URB', TDEEP0_URB(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'IVGTYP',IVGTYP(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'TR_URB2D',TR_URB2D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'TB_URB2D',TB_URB2D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'TG_URB2D',TG_URB2D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'TC_URB2D',TC_URB2D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'QC_URB2D',QC_URB2D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'XXXR_URB2D',XXXR_URB2D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'SH_URB2D',SH_URB2D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'LH_URB2D',LH_URB2D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'G_URB2D',G_URB2D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'RN_URB2D',RN_URB2D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'TS_URB2D',TS_URB2D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'LF_AC_URB3D', LF_AC_URB3D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'SF_AC_URB3D', SF_AC_URB3D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'CM_AC_URB3D', CM_AC_URB3D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'SFVENT_URB3D', SFVENT_URB3D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'LFVENT_URB3D', LFVENT_URB3D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'FRC_URB2D', FRC_URB2D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'UTYPE_URB2D', UTYPE_URB2D(I,J)
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'I',I,'J',J
+        WRITE_MESSAGE(mesg)
+        write(mesg,*) 'num_urban_hi', num_urban_hi
+        WRITE_MESSAGE(mesg)
+        CHECK = 1
+       END IF
+       END IF
+
     END DO
    END DO
    RETURN
@@ -2424,4 +3187,856 @@ SUBROUTINE SFCDIF_URB (ZLM,Z0,THZ0,THLM,SFCSPD,AKANDA,AKMS,AKHS,RLMO,CD)
   END SUBROUTINE SFCDIF_URB
 ! ----------------------------------------------------------------------
 !===========================================================================
+!  DIREVAP 
+!  CALCULATE DIRECT SOIL EVAPORATION
+!===========================================================================
+   SUBROUTINE DIREVAP (EDIR,ETP,SMC,SHDFAC,SMCMAX,SMCDRY,FXEXP)
+
+     REAL, INTENT(IN)  :: ETP,SMC,SHDFAC,SMCMAX,SMCDRY,FXEXP
+     REAL, INTENT(OUT) :: EDIR
+     REAL              :: FX, SRATIO
+
+! ----------------------------------------------------------------------
+! FX > 1 REPRESENTS DEMAND CONTROL
+! FX < 1 REPRESENTS FLUX CONTROL
+! ----------------------------------------------------------------------
+      SRATIO = (SMC - SMCDRY) / (SMCMAX - SMCDRY)
+      IF (SRATIO > 0.) THEN
+        FX = SRATIO**FXEXP
+        FX = MAX ( MIN ( FX, 1. ) ,0. )
+      ELSE
+        FX = 0.
+      ENDIF
+      EDIR = FX * ( 1.0- SHDFAC ) * ETP * 0.001
+      
+ END SUBROUTINE DIREVAP
+!===========================================================================
+!  TRANSP
+!  CALCULATE EVAPOTRANSPIRATION FOR VEGETATIO SURFACE
+!===========================================================================
+      
+     SUBROUTINE TRANSP (ETT,ET,EC,SHDFAC,ETP1,CMC,CFACTR,CMCMAX,LAI,RSMIN,RSMAX,RGL,SX, &
+                        TS,TA,QA,SMC,SMCWLT,SMCREF,CPP,PS,CH,EPSV,DELT, NROOT,NSOIL,    &
+                        DZVR, ZSOIL, HS)
+     INTEGER, INTENT(IN)   :: NROOT, NSOIL
+     REAL, INTENT(IN)  :: SHDFAC,ETP1,CMC,CFACTR,CMCMAX,LAI,RSMIN,RSMAX,RGL,SX,TA
+     REAL, INTENT(IN)  :: TS,QA, SMCWLT, SMCREF, CPP, PS,CH, EPSV, DELT, HS
+     REAL, DIMENSION(1:NSOIL), INTENT(IN)   :: ZSOIL, DZVR, SMC
+     REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: ET
+     REAL, INTENT(OUT) :: EC, ETT
+     REAL              :: RC, RCS, RCT, RCQ, RCSOIL, FF, WS, SLV, DESDT
+     REAL              :: SIGMA, PC, CMC2MS, SGX, DENOM, RTX, ETT1
+     INTEGER           :: K
+     REAL, DIMENSION(1:NROOT) ::  PART, GX
+     
+     SLV    = 2.501E+6
+     SIGMA  = 5.67E-8
+     ETT    = 0.0
+     DO K = 1, NSOIL
+       ET(K) = 0.
+     END DO
+     
+! ----------------------------------------------------------------------
+! INITIALIZE CANOPY RESISTANCE MULTIPLIER TERMS.
+! ----------------------------------------------------------------------
+      RCS = 0.0
+      RCT = 0.0
+      RCQ = 0.0
+      RCSOIL = 0.0
+      
+! ----------------------------------------------------------------------
+! CONTRIBUTION DUE TO INCOMING SOLAR RADIATION
+! ----------------------------------------------------------------------
+      FF  = 0.55*2.0* SX*697.7 * 60/ (RGL * LAI)
+      RCS = (FF + RSMIN / RSMAX) / (1.0+ FF)
+      RCS = MAX (RCS,0.0001)
+! ----------------------------------------------------------------------
+! CONTRIBUTION DUE TO AIR TEMPERATURE AT FIRST MODEL LEVEL ABOVE GROUND
+! RCT EXPRESSION FROM NOILHAN AND PLANTON (1989, MWR).
+! ----------------------------------------------------------------------
+      RCT = 1.0- 0.0016* ( (298 - TA)**2.0)
+      RCT = MAX (RCT,0.0001)
+! ----------------------------------------------------------------------
+! CONTRIBUTION DUE TO VAPOR PRESSURE DEFICIT AT FIRST MODEL LEVEL.
+! RCQ EXPRESSION FROM SSIB  (Niyogi and Raman, 1997)
+! ----------------------------------------------------------------------
+      EA = 6.11*EXP((2.5*10.**6./461.51)*(TA-273.15)/(273.15*TA) )
+      WS = 0.622*EA/1013   
+      RCQ = 1.0/ (1.0+ HS * (WS - QA))
+      RCQ = MAX (RCQ,0.01)
+! ----------------------------------------------------------------------
+! CONTRIBUTION DUE TO SOIL MOISTURE AVAILABILITY.
+! DETERMINE CONTRIBUTION FROM EACH SOIL LAYER, THEN ADD THEM UP.
+! ----------------------------------------------------------------------
+      DO K = 1, NROOT  
+       GX(K) = (SMC(K) - SMCWLT) / (SMCREF - SMCWLT)
+         IF (GX(K) >  1.) GX(K) = 1.
+         IF (GX(K) <  0.) GX(K) = 0.
+         PART (K) = ( -DZVR (K)/ ZSOIL (3)) * GX(K)
+      END DO
+      
+      SGX =0.0
+      DO K = 1, NROOT 
+        SGX    = SGX    + GX (K)
+        RCSOIL = RCSOIL + PART (K)
+      END DO
+      SGX =SGX / NROOT
+      
+      RCSOIL = MAX (RCSOIL,0.0001)
+
+      RC = RSMIN / (LAI * RCS * RCT * RCQ * RCSOIL)
+      DESDT = 0.622*SLV*EA/461.51/TA/TA/1013
+      DELTA = (SLV / CPP)* DESDT
+      RR = (4.* EPSV *SIGMA * 287.04 / CPP)* (TA **4.)/ (TS * CH) + 1.0
+      PC = (RR + DELTA)/ (RR * (1. + RC * CH) + DELTA)  
+      
+      IF (CMC .ne. 0.0) THEN
+         ETT1 = SHDFAC * PC * ETP1 * (1.0- (CMC / CMCMAX) ** CFACTR) * 0.001
+      ELSE
+         ETT1 = SHDFAC * PC * ETP1 * 0.001
+      ENDIF
+
+      DENOM = 0.
+      DO K = 1, NROOT 
+         RTX= (-DZVR (K)/ ZSOIL (3)) + GX(K) - SGX
+         GX (K) = GX (K) * MAX ( RTX, 0. )
+         DENOM  = DENOM + GX (K)
+      END DO 
+      IF (DENOM .le. 0.0) DENOM =1.
+      
+      DO K = 1, NROOT 
+         ET(K) = ETT1 * GX (K) / DENOM
+         ETT   = ETT + ET (K)
+      END DO
+      
+      
+      IF (CMC > 0.0) THEN
+      EC = SHDFAC * ( ( CMC / CMCMAX ) ** CFACTR ) * ETP1 * 0.001
+      ELSE
+      EC = 0.0
+      END IF
+      CMC2MS = CMC / DELT
+      EC   = MIN ( CMC2MS, EC )
+      
+  END SUBROUTINE TRANSP
+! ----------------------------------------------------------------------
+! SUBROUTINE SMFLX
+! ----------------------------------------------------------------------
+  
+       SUBROUTINE SMFLX (SMCP,SMC,NSOIL,CMCP,CMC,DT,PRCP1,ZSOIL,       &
+     &                   SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT,               &
+     &                   SHDFAC,CMCMAX,RUNOFF1,RUNOFF2,RUNOFF3,        &
+                         EDIR,EC,ET,DRIP)              
+
+! CALCULATE SOIL MOISTURE FLUX.  THE SOIL MOISTURE CONTENT IS UPDATED WITH
+! PROGNOSTIC EQNS. THE CANOPY MOISTURE CONTENT (CMC) IS ALSO UPDATED.
+! ----------------------------------------------------------------------
+      IMPLICIT NONE
+
+      INTEGER, INTENT(IN)   :: NSOIL
+      INTEGER               :: I,K
+      REAL, INTENT(IN)      :: BEXP, CMCMAX, DKSAT,DWSAT, DT, EC, EDIR,  &
+                               PRCP1, SHDFAC, SMCMAX, SMCWLT
+      REAL, INTENT(OUT)     :: DRIP, RUNOFF1, RUNOFF2, RUNOFF3
+      REAL, INTENT(IN)      :: CMCP
+      REAL, INTENT(OUT)     :: CMC
+      REAL, DIMENSION(1:NSOIL), INTENT(IN)   :: ZSOIL, ET
+      REAL, DIMENSION(1:NSOIL), INTENT(IN)   :: SMCP
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT)  :: SMC
+      REAL, DIMENSION(1:NSOIL)               :: AI, BI, CI, STCF,RHSTS, RHSTT
+      REAL                  :: EXCESS,PCPDRP,RHSCT,TRHSCT
+
+
+! ----------------------------------------------------------------------
+! ADD PRECIPITATION TO EXISTING CMC.IF RESULTING AMT EXCEEDS MAX CAPACITY,
+! IT BECOMES DRIP AND WILL FALL TO THE GRND.
+! ----------------------------------------------------------------------
+      RHSCT = SHDFAC * PRCP1 * 0.001 /3600. - EC
+      DRIP = 0.
+      TRHSCT = DT * RHSCT
+      EXCESS = CMCP + TRHSCT
+
+! ----------------------------------------------------------------------
+! PCPDRP IS THE COMBINED PRCP1 AND DRIP (FROM CMCP) THAT GOES INTO THE
+! SOIL
+! ----------------------------------------------------------------------
+      IF (EXCESS > CMCMAX) DRIP = EXCESS - CMCMAX
+      PCPDRP = (1. - SHDFAC) * PRCP1 * 0.001 /3600. + DRIP / DT
+
+! ----------------------------------------------------------------------
+! CALL SUBROUTINES SRT AND SSTEP TO SOLVE THE SOIL MOISTURE
+! TENDENCY EQUATIONS.
+! ----------------------------------------------------------------------
+      CALL SRT (RHSTT,EDIR,ET,SMCP,NSOIL,PCPDRP,ZSOIL,DWSAT,DKSAT,    &
+                   SMCMAX,BEXP,RUNOFF1,RUNOFF2,DT,SMCWLT,AI,BI,CI) 
+                   
+      CALL SSTEP (SMCP,SMC,CMCP,CMC,RHSTT,RHSCT,DT,NSOIL,SMCMAX,     &
+                        CMCMAX,RUNOFF3,ZSOIL,AI,BI,CI)
+! ----------------------------------------------------------------------
+  END SUBROUTINE SMFLX
+! ----------------------------------------------------------------------
+
+      SUBROUTINE SRT (RHSTT,EDIR,ET,SMCP,NSOIL,PCPDRP,ZSOIL,DWSAT,    &
+                      DKSAT,SMCMAX,BEXP,RUNOFF1,            &
+                      RUNOFF2,DT,SMCWLT,AI,BI,CI)
+
+! ----------------------------------------------------------------------
+! CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY TERM OF THE SOIL
+! WATER DIFFUSION EQUATION.  ALSO TO COMPUTE ( PREPARE ) THE MATRIX
+! COEFFICIENTS FOR THE TRI-DIAGONAL MATRIX OF THE IMPLICIT TIME SCHEME.
+! ----------------------------------------------------------------------
+      IMPLICIT NONE
+      INTEGER, INTENT(IN)       :: NSOIL
+      INTEGER                   :: K, KS
+
+      REAL, INTENT(IN)          :: BEXP, DKSAT, DT, DWSAT, EDIR,  &
+                                   PCPDRP, SMCMAX, SMCWLT
+      REAL, INTENT(OUT)         :: RUNOFF1, RUNOFF2
+      REAL, DIMENSION(1:NSOIL), INTENT(IN)   :: SMCP, ZSOIL, ET
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT)  :: RHSTT
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT)  :: AI, BI, CI
+      REAL, DIMENSION(1:NSOIL)  :: DDMAX
+      REAL                      :: DD, DDT, DDZ, DDZ2, DENOM,       &
+                                   DENOM2, DSMDZ, DSMDZ2, DT1,      &
+                                   INFMAX,MXSMC,MXSMC2,NUMER,PDDUM, &
+                                   PX,SMCAV, SSTT, PAR,         &
+                                   VAL, WCND, WCND2, WDF, WDF2,KDT
+
+! ----------------------------------------------------------------------
+! DETERMINE RAINFALL INFILTRATION RATE AND RUNOFF.  INCLUDE THE
+! INFILTRATION FORMULE FROM SCHAAKE AND KOREN MODEL.
+! MODIFIED BY Q DUAN
+! ----------------------------------------------------------------------
+         
+         PDDUM = PCPDRP
+         RUNOFF1 = 0.0
+         PAR = 2.0E-6
+         
+         IF (PCPDRP /=  0.0) THEN         
+         SMCAV = SMCMAX - SMCWLT
+         DDMAX (1) = - ZSOIL (1)* SMCAV
+         DDMAX (1) = DDMAX (1)* (1.0- (SMCP (1) - SMCWLT)/ SMCAV)        
+         DDMAX (2) = (ZSOIL (1) - ZSOIL (2))* SMCAV
+         DDMAX (2) = DDMAX (2)* (1.0- (SMCP (2) - SMCWLT)/ SMCAV)
+         DDMAX (3) = (ZSOIL (2) - ZSOIL (3))* SMCAV
+         DDMAX (3) = DDMAX (3)* (1.0- (SMCP (3) - SMCWLT)/ SMCAV)
+         
+         DD = DDMAX(1)+DDMAX(2)+DDMAX(3)
+         DT1 = DT/86400
+         KDT = 3.0 * DKSAT / PAR
+         VAL = (1. - EXP ( - KDT * DT1))
+         DDT = DD * VAL
+         PX = PCPDRP * DT
+         IF (PX <  0.0) PX = 0.0
+
+         INFMAX = (PX * (DDT / (PX + DDT)))/ DT
+         MXSMC = SMCP (1)
+         CALL WDFCND (WDF,WCND,MXSMC,SMCMAX,BEXP,DKSAT,DWSAT)
+         INFMAX = MAX (INFMAX,WCND)
+         INFMAX = MIN (INFMAX,PX/DT)
+         
+
+         IF (PCPDRP >  INFMAX) THEN
+          RUNOFF1  = PCPDRP - INFMAX
+          PDDUM = INFMAX
+         END IF
+        END IF
+! ----------------------------------------------------------------------
+! TOP LAYER
+! ----------------------------------------------------------------------
+      CALL WDFCND (WDF,WCND,SMCP(1),SMCMAX,BEXP,DKSAT,DWSAT)
+      DDZ = 1. / ( - .5 * ZSOIL (2) )
+      AI (1) = 0.0
+      BI (1) = WDF * DDZ / ( - ZSOIL (1) )
+      CI (1) = - BI (1)   
+      DSMDZ = (SMCP (1) - SMCP (2) )/( - 0.5 * ZSOIL(2))
+      RHSTT (1) = (WDF * DSMDZ + WCND- PDDUM + EDIR + ET(1))/ ZSOIL (1)
+      SSTT = WDF * DSMDZ + WCND+ EDIR + ET(1)
+
+! ----------------------------------------------------------------------
+! LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABV PROCESS
+! ----------------------------------------------------------------------
+      DDZ2 = 0.0
+      DO K = 2,NSOIL-1
+         DENOM2 = (ZSOIL (K -1) - ZSOIL (K))
+         IF (K /= NSOIL-1) THEN
+            MXSMC2 = SMCP (K)
+            CALL WDFCND (WDF2,WCND2,MXSMC2,SMCMAX,BEXP,DKSAT,DWSAT)
+            DENOM = (ZSOIL (K -1) - ZSOIL (K +1))
+            DSMDZ2 = (SMCP (K) - SMCP (K +1)) / (DENOM * 0.5)
+            DDZ2 = 2.0 / DENOM
+            CI (K) = - WDF2 * DDZ2 / DENOM2
+         ELSE
+          CALL WDFCND (WDF2,WCND2,SMCP(NSOIL-1),SMCMAX,BEXP,DKSAT,DWSAT)
+            DSMDZ2 = 0.0
+            CI (K) = 0.0
+         END IF  
+         NUMER = (WDF2 * DSMDZ2) - (WDF * DSMDZ)         &
+                 - WCND+ ET(K)
+         RHSTT (K) = NUMER / ( - DENOM2)
+         AI (K) = - WDF * DDZ / DENOM2
+         BI (K) = - ( AI (K) + CI (K) )
+         IF (K .eq. NSOIL-1) THEN
+            RUNOFF2 = 0.0
+         END IF
+         IF (K .ne. NSOIL-1) THEN
+            WDF = WDF2
+            WCND = WCND2
+            DSMDZ = DSMDZ2
+            DDZ = DDZ2
+         END IF
+      END DO
+! ----------------------------------------------------------------------
+  END SUBROUTINE SRT
+! ----------------------------------------------------------------------
+
+      SUBROUTINE SSTEP (SMCP,SMC,CMCP,CMC,RHSTT,RHSCT,DT,     &
+                        NSOIL,SMCMAX,CMCMAX,RUNOFF3,ZSOIL,        &
+                        AI,BI,CI)
+
+! ----------------------------------------------------------------------
+! SUBROUTINE SSTEP
+! ----------------------------------------------------------------------
+! CALCULATE/UPDATE SOIL MOISTURE CONTENT VALUES AND CANOPY MOISTURE
+! CONTENT VALUES.
+! ----------------------------------------------------------------------
+      IMPLICIT NONE
+      INTEGER, INTENT(IN)       :: NSOIL
+      INTEGER                   :: I, K, KK11
+
+      REAL, INTENT(IN)          :: CMCMAX, DT, SMCMAX
+      REAL, INTENT(OUT)         :: RUNOFF3
+      REAL, INTENT(IN)          :: CMCP
+      REAL, INTENT(OUT)         :: CMC
+      REAL, DIMENSION(1:NSOIL), INTENT(IN)     :: SMCP, ZSOIL
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT)    :: SMC
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT)  :: RHSTT
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT)  :: AI, BI, CI 
+      REAL, DIMENSION(1:NSOIL)  :: RHSTTin, SMCOUT,SMCIN
+      REAL, DIMENSION(1:NSOIL)  :: CIin
+      REAL                      :: DDZ, RHSCT, WPLUS, STOT
+
+! ----------------------------------------------------------------------
+! CREATE 'AMOUNT' VALUES OF VARIABLES TO BE INPUT TO THE
+! TRI-DIAGONAL MATRIX ROUTINE.
+! ----------------------------------------------------------------------
+      DO K = 1,NSOIL-1
+         RHSTT (K) = RHSTT (K) * DT
+         AI (K) = AI (K) * DT
+         BI (K) = 1. + BI (K) * DT
+         CI (K) = CI (K) * DT
+      END DO
+! ----------------------------------------------------------------------
+! COPY VALUES FOR INPUT VARIABLES BEFORE CALL TO ROSR12
+! ----------------------------------------------------------------------
+      DO K = 1,NSOIL-1
+         RHSTTin (K) = RHSTT (K)
+      END DO
+      DO K = 1,NSOIL-1
+         CIin (K) = CI (K)
+      END DO
+! ----------------------------------------------------------------------
+! CALL ROSR12 TO SOLVE THE TRI-DIAGONAL MATRIX
+! ----------------------------------------------------------------------
+      CALL ROSR12 (CI,AI,BI,CIin,RHSTTin,RHSTT,NSOIL-1)
+! ----------------------------------------------------------------------
+! SUM THE PREVIOUS SMC VALUE AND THE MATRIX SOLUTION TO GET A
+! NEW VALUE.  MIN ALLOWABLE VALUE OF SMC WILL BE 0.02.
+! RUNOFF3: RUNOFF WITHIN SOIL LAYERS
+! ----------------------------------------------------------------------
+      WPLUS = 0.0
+      RUNOFF3 = 0.
+
+      DDZ = - ZSOIL (1)
+      DO K = 1,NSOIL-1
+         IF (K /= 1) DDZ = ZSOIL (K - 1) - ZSOIL (K)
+         SMCOUT (K) = SMCP (K) + CI (K) + WPLUS / DDZ
+         STOT = SMCOUT (K)
+         IF (STOT > SMCMAX) THEN
+            IF (K .eq. 1) THEN
+               DDZ = - ZSOIL (1)
+            ELSE
+               KK11 = K - 1
+               DDZ = - ZSOIL (K) + ZSOIL (KK11)
+            END IF
+            WPLUS = (STOT - SMCMAX) * DDZ
+         ELSE
+            WPLUS = 0.
+         END IF
+         SMC (K) = MAX ( MIN (STOT,SMCMAX),0.066 )
+      END DO
+
+! ----------------------------------------------------------------------
+! UPDATE CANOPY WATER CONTENT/INTERCEPTION (CMC).  CONVERT RHSCT TO
+! AN 'AMOUNT' VALUE AND ADD TO PREVIOUS CMC VALUE TO GET NEW CMC.
+! ----------------------------------------------------------------------
+      RUNOFF3 = WPLUS
+      CMC = CMCP + DT * RHSCT
+      IF (CMC < 1.E-20) CMC = 0.0
+      CMC = MIN (CMC,CMCMAX)
+
+! ----------------------------------------------------------------------
+  END SUBROUTINE SSTEP
+! ----------------------------------------------------------------------
+
+      SUBROUTINE WDFCND (WDF,WCND,SMC,SMCMAX,BEXP,DKSAT,DWSAT)
+
+! ----------------------------------------------------------------------
+! SUBROUTINE WDFCND
+! ----------------------------------------------------------------------
+! CALCULATE SOIL WATER DIFFUSIVITY AND SOIL HYDRAULIC CONDUCTIVITY.
+! ----------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL     BEXP
+      REAL     DKSAT
+      REAL     DWSAT
+      REAL     EXPON
+      REAL     FACTR1
+      REAL     FACTR2
+      REAL     SMC
+      REAL     SMCMAX
+      REAL     WCND
+
+! ----------------------------------------------------------------------
+!     CALC THE RATIO OF THE ACTUAL TO THE MAX PSBL SOIL H2O CONTENT
+! ----------------------------------------------------------------------
+      REAL     WDF
+      FACTR1 = 0.05 / SMCMAX
+
+! ----------------------------------------------------------------------
+! PREP AN EXPNTL COEF AND CALC THE SOIL WATER DIFFUSIVITY AND CONDUCTIVITY
+! ----------------------------------------------------------------------
+      FACTR2 = SMC / SMCMAX
+      FACTR1 = MIN(FACTR1,FACTR2)
+      EXPON  = BEXP + 2.0
+      WDF    = DWSAT * FACTR2 ** EXPON
+      EXPON  = (2.0 * BEXP) + 3.0
+      WCND   = DKSAT * FACTR2 ** EXPON
+
+! ----------------------------------------------------------------------
+  END SUBROUTINE WDFCND
+! ----------------------------------------------------------------------
+! SUBROUTINE ROSR12
+! ----------------------------------------------------------------------
+! INVERT (SOLVE) THE TRI-DIAGONAL MATRIX PROBLEM SHOWN BELOW:
+! ###                                            ### ###  ###   ###  ###
+! #B(1), C(1),  0  ,  0  ,  0  ,   . . .  ,    0   # #      #   #      #
+! #A(2), B(2), C(2),  0  ,  0  ,   . . .  ,    0   # #      #   #      #
+! # 0  , A(3), B(3), C(3),  0  ,   . . .  ,    0   # #      #   # D(3) #
+! # 0  ,  0  , A(4), B(4), C(4),   . . .  ,    0   # # P(4) #   # D(4) #
+! # 0  ,  0  ,  0  , A(5), B(5),   . . .  ,    0   # # P(5) #   # D(5) #
+! # .                                          .   # #  .   # = #   .  #
+! # .                                          .   # #  .   #   #   .  #
+! # .                                          .   # #  .   #   #   .  #
+! # 0  , . . . , 0 , A(M-2), B(M-2), C(M-2),   0   # #P(M-2)#   #D(M-2)#
+! # 0  , . . . , 0 ,   0   , A(M-1), B(M-1), C(M-1)# #P(M-1)#   #D(M-1)#
+! # 0  , . . . , 0 ,   0   ,   0   ,  A(M) ,  B(M) # # P(M) #   # D(M) #
+! ###                                            ### ###  ###   ###  ###
+! ----------------------------------------------------------------------
+  
+  SUBROUTINE ROSR12 (P,A,B,C,D,DELTA,NSOIL)
+      IMPLICIT NONE
+
+      INTEGER, INTENT(IN)   :: NSOIL
+      INTEGER               :: K, KK
+
+      REAL, DIMENSION(1:NSOIL), INTENT(IN):: A, B, D
+      REAL, DIMENSION(1:NSOIL),INTENT(INOUT):: C,P,DELTA
+
+! ----------------------------------------------------------------------
+! INITIALIZE EQN COEF C FOR THE LOWEST SOIL LAYER
+! ----------------------------------------------------------------------
+      C (NSOIL) = 0.0
+      P (1) = - C (1) / B (1)
+      DELTA (1) = D (1) / B (1)
+      DO K = 2,NSOIL
+         P (K) = - C (K) * ( 1.0 / (B (K) + A (K) * P (K -1)) )
+         DELTA (K) = (D (K) - A (K)* DELTA (K -1))* (1.0/ (B (K) + A (K)&
+                    * P (K -1)))
+      END DO
+! ----------------------------------------------------------------------
+! SET P TO DELTA FOR LOWEST SOIL LAYER
+! ----------------------------------------------------------------------
+      P (NSOIL) = DELTA (NSOIL)
+
+! ----------------------------------------------------------------------
+! ADJUST P FOR SOIL LAYERS 2 THRU NSOIL
+! ----------------------------------------------------------------------
+      DO K = 2,NSOIL
+         KK = NSOIL - K + 1
+         P (KK) = P (KK) * P (KK +1) + DELTA (KK)
+      END DO
+! ----------------------------------------------------------------------
+  END SUBROUTINE ROSR12
+!----------------------------------------------------------------------
+
+      SUBROUTINE SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL, &
+                         TBOT,ZBOT,SMCWLT,DF1,QUARTZ,CSOIL,CAPR)
+
+! ----------------------------------------------------------------------
+! SUBROUTINE SHFLX
+! ----------------------------------------------------------------------
+! UPDATE THE TEMPERATURE STATE OF THE SOIL COLUMN BASED ON THE THERMAL
+! DIFFUSION EQUATION AND UPDATE THE FROZEN SOIL MOISTURE CONTENT BASED
+! ON THE TEMPERATURE.
+! ----------------------------------------------------------------------
+      IMPLICIT NONE
+
+      INTEGER, INTENT(IN)   :: NSOIL
+      INTEGER               :: I
+
+      REAL, INTENT(IN)      :: DF1,DT,SMCMAX, SMCWLT, TBOT,YY, ZBOT,ZZ1, QUARTZ
+      REAL, INTENT(IN)      :: CSOIL, CAPR
+      REAL, INTENT(INOUT)   :: T1
+      REAL, INTENT(OUT)     :: SSOIL
+      REAL, DIMENSION(1:NSOIL), INTENT(IN)    :: SMC,ZSOIL
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: STC
+      REAL, DIMENSION(1:NSOIL)             :: AI, BI, CI, STCF,RHSTS
+
+! ----------------------------------------------------------------------
+! HRT ROUTINE CALCS THE RIGHT HAND SIDE OF THE SOIL TEMP DIF EQN
+! ----------------------------------------------------------------------
+
+      ! Land case
+
+      CALL HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,TBOT,        &
+                ZBOT,DT,DF1,AI,BI,CI,QUARTZ,CSOIL,CAPR)
+
+      CALL HSTEP (STCF,STC,RHSTS,DT,NSOIL,AI,BI,CI)
+
+      DO I = 1,NSOIL
+         STC (I) = STCF (I)
+      ENDDO
+
+! ----------------------------------------------------------------------
+! CALCULATE SURFACE SOIL HEAT FLUX
+! ----------------------------------------------------------------------
+      T1 = (YY + (ZZ1- 1.0) * STC (1)) / ZZ1
+      SSOIL = DF1 * (STC (1) - T1) / (0.5 * ZSOIL (1))
+
+! ----------------------------------------------------------------------
+  END SUBROUTINE SHFLX
+! ----------------------------------------------------------------------
+! SUBROUTINE HRT
+! ----------------------------------------------------------------------
+! CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY TERM OF THE SOIL
+! THERMAL DIFFUSION EQUATION.  ALSO TO COMPUTE ( PREPARE ) THE MATRIX
+! COEFFICIENTS FOR THE TRI-DIAGONAL MATRIX OF THE IMPLICIT TIME SCHEME.
+! ----------------------------------------------------------------------
+
+      SUBROUTINE HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,          &
+                       TBOT,ZBOT,DT,DF1,AI,BI,CI,QUARTZ,CSOIL,CAPR)
+                       
+      IMPLICIT NONE
+      LOGICAL              :: ITAVG
+      INTEGER, INTENT(IN)  :: NSOIL
+      INTEGER              :: I, K
+
+      REAL, INTENT(IN)     :: DF1, DT,SMCMAX ,TBOT,YY,ZZ1, ZBOT, QUARTZ, CSOIL, CAPR
+      REAL, DIMENSION(1:NSOIL), INTENT(IN)   :: SMC,STC,ZSOIL
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT)  :: RHSTS
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT)  :: AI, BI,CI
+      REAL                 :: DDZ, DDZ2, DENOM, DF1K, DTSDZ,DF1N,      &
+                              DTSDZ2,HCPCT,QTOT,SSOIL,SICE,TAVG,TBK,     &
+                              TBK1,TSNSR,TSURF
+      REAL, PARAMETER      :: CAIR = 1004.0, CH2O = 4.2E6
+
+
+! ----------------------------------------------------------------------
+! INITIALIZE LOGICAL FOR SOIL LAYER TEMPERATURE AVERAGING.
+! ----------------------------------------------------------------------
+       ITAVG = .TRUE.
+       
+! ----------------------------------------------------------------------
+! TOP SOIL LAYER
+! ----------------------------------------------------------------------
+      HCPCT = SMC (1)* CH2O + (1.0- SMCMAX)* CSOIL + (SMCMAX - SMC (1))&
+       * CAIR                                                          
+      DDZ = 1.0 / ( -0.5 * ZSOIL (2) )
+      AI (1) = 0.0
+      CI (1) = (DF1 * DDZ) / (ZSOIL (1) * HCPCT)
+
+! ----------------------------------------------------------------------
+! CALCULATE THE VERTICAL SOIL TEMP GRADIENT BTWN THE 1ST AND 2ND SOIL
+! LAYERS.  THEN CALCULATE THE SUBSURFACE HEAT FLUX. 
+! ----------------------------------------------------------------------
+      BI (1) = - CI (1) + DF1 / (0.5 * ZSOIL (1) * ZSOIL (1)* HCPCT *    &
+       ZZ1)
+      DTSDZ = (STC (1) - STC (2)) / (-0.5 * ZSOIL (2))
+      SSOIL = DF1 * (STC (1) - YY) / (0.5 * ZSOIL (1) * ZZ1)
+      DENOM = (ZSOIL (1) * HCPCT)
+
+! ----------------------------------------------------------------------
+! NEXT CAPTURE THE VERTICAL DIFFERENCE OF THE HEAT FLUX AT TOP AND
+! BOTTOM OF FIRST SOIL LAYER FOR USE IN HEAT FLUX CONSTRAINT
+! ----------------------------------------------------------------------
+      RHSTS (1) = (DF1 * DTSDZ - SSOIL) / DENOM
+      QTOT = -1.0* RHSTS (1)* DENOM
+      IF (ITAVG) THEN
+         TSURF = (YY + (ZZ1-1) * STC (1)) / ZZ1
+         CALL TBND (STC (1),STC (2),ZSOIL,ZBOT,1,NSOIL,TBK)
+     ENDIF
+      DDZ2 = 0.0
+      DF1N = DF1
+
+! ----------------------------------------------------------------------
+! LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABOVE PROCESS
+! (EXCEPT SUBSFC OR "GROUND" HEAT FLUX NOT REPEATED IN LOWER LAYERS)
+! ----------------------------------------------------------------------
+      DO K = 2,NSOIL
+! ----------------------------------------------------------------------
+! THIS SECTION FOR LAYER 2 OR GREATER, BUT NOT LAST LAYER.
+! ----------------------------------------------------------------------
+         IF (K < NSOIL-1 ) THEN
+         HCPCT = SMC (K)* CH2O + (1.0- SMCMAX)* CSOIL + (SMCMAX - SMC (  &
+                K))* CAIR 
+            CALL TDFCND  (DF1K, SMC(K), QUARTZ, SMCMAX)
+            DENOM = 0.5 * ( ZSOIL (K -1) - ZSOIL (K +1) )
+            DTSDZ2 = (STC (K) - STC (K +1) ) / DENOM
+            DDZ2 = 2. / (ZSOIL (K -1) - ZSOIL (K +1))
+
+! ----------------------------------------------------------------------
+! IF TEMPERATURE AVERAGING INVOKED (ITAVG=TRUE; ELSE SKIP):  CALCULATE
+! TEMP AT BOTTOM OF LAYER.
+! ----------------------------------------------------------------------
+            CI (K) = - DF1K * DDZ2 / ( (ZSOIL (K -1) - ZSOIL (K)) *      &
+       HCPCT)
+            IF (ITAVG) THEN
+               CALL TBND (STC (K),STC (K +1),ZSOIL,ZBOT,K,NSOIL,TBK1)
+            END IF
+
+         ELSEIF (K == NSOIL-1) THEN
+         
+         HCPCT = SMC (K)* CH2O + (1.0- SMCMAX)* CSOIL + (SMCMAX- SMC (  &
+                K))* CAIR 
+            CALL TDFCND  (DF1K, SMC(K), QUARTZ, SMCMAX)
+            DENOM = 0.5 * ( ZSOIL (K -1) - ZSOIL (K +1) )
+            DTSDZ2 = (STC (K) - STC (K +1) ) / DENOM
+            DDZ2 = 2. / (ZSOIL (K -1) - ZSOIL (K +1))
+!-----------------------------------------------------------------------
+! IF TEMPERATURE AVERAGING INVOKED (ITAVG=TRUE; ELSE SKIP):  CALCULATE
+! TEMP AT BOTTOM OF LAST LAYER.
+! ----------------------------------------------------------------------
+            CI (K) = - DF1K * DDZ2 / ( (ZSOIL (K -1) - ZSOIL (K)) *      &
+       HCPCT)
+            IF (ITAVG) THEN
+               CALL TBND (STC (K),TBOT,ZSOIL,ZBOT,K,NSOIL,TBK1)
+            END IF        
+         ELSE         
+! ----------------------------------------------------------------------
+! SPECIAL CASE OF BOTTOM LAYER (CONCRETE ROOF)
+! ----------------------------------------------------------------------
+            HCPCT = CAPR * 4.1868 * 1.E6
+            DF1K  = 3.24
+! ----------------------------------------------------------------------
+! CALC THE VERTICAL TEMP GRADIENT THRU BOTTOM LAYER.
+! ----------------------------------------------------------------------
+            DENOM = .5 * (ZSOIL (K -1) + ZSOIL (K)) - ZBOT
+            DTSDZ2 = (STC (K) - TBOT) / DENOM
+! ----------------------------------------------------------------------
+! IF TEMPERATURE AVERAGING INVOKED (ITAVG=TRUE; ELSE SKIP):  CALCULATE
+! TEMP AT BOTTOM OF LAST LAYER.
+! ----------------------------------------------------------------------
+            CI (K) = 0.
+            IF (ITAVG) THEN
+               CALL TBND (STC (K),TBOT,ZSOIL,ZBOT,K,NSOIL,TBK1)
+            END IF
+! ----------------------------------------------------------------------
+! THIS ENDS SPECIAL LOOP FOR BOTTOM LAYER.
+         END IF
+! ----------------------------------------------------------------------
+! CALCULATE RHSTS FOR THIS LAYER AFTER CALC'NG A PARTIAL PRODUCT.
+! ----------------------------------------------------------------------
+         DENOM = ( ZSOIL (K) - ZSOIL (K -1) ) * HCPCT
+         RHSTS (K) = ( DF1K * DTSDZ2- DF1N * DTSDZ ) / DENOM
+         QTOT = -1.0* DENOM * RHSTS (K)
+
+! ----------------------------------------------------------------------
+! CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER.
+! ----------------------------------------------------------------------
+         AI (K) = - DF1N * DDZ / ( (ZSOIL (K -1) - ZSOIL (K)) * HCPCT)
+
+! ----------------------------------------------------------------------
+! RESET VALUES OF DF1, DTSDZ, DDZ, AND TBK FOR LOOP TO NEXT SOIL LAYER.
+! ----------------------------------------------------------------------
+         BI (K) = - (AI (K) + CI (K))
+         TBK = TBK1
+         DF1N = DF1K
+         DTSDZ = DTSDZ2
+         DDZ = DDZ2
+      END DO
+! ----------------------------------------------------------------------
+  END SUBROUTINE HRT
+! ----------------------------------------------------------------------
+
+      SUBROUTINE HSTEP (STCOUT,STCIN,RHSTS,DT,NSOIL,AI,BI,CI)
+!      CALCULATE/UPDATE THE SOIL TEMPERATURE FIELD.
+! ----------------------------------------------------------------------
+      IMPLICIT NONE
+      INTEGER, INTENT(IN)  :: NSOIL
+      INTEGER              :: K
+
+      REAL, DIMENSION(1:NSOIL), INTENT(IN):: STCIN
+      REAL, DIMENSION(1:NSOIL), INTENT(OUT):: STCOUT
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: RHSTS
+      REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: AI,BI,CI
+      REAL, DIMENSION(1:NSOIL) :: RHSTSin
+      REAL, DIMENSION(1:NSOIL) :: CIin
+      REAL                 :: DT
+
+! ----------------------------------------------------------------------
+! CREATE FINITE DIFFERENCE VALUES FOR USE IN ROSR12 ROUTINE
+! ----------------------------------------------------------------------
+      DO K = 1,NSOIL
+         RHSTS (K) = RHSTS (K) * DT
+         AI (K) = AI (K) * DT
+         BI (K) = 1. + BI (K) * DT
+         CI (K) = CI (K) * DT
+      END DO
+! ----------------------------------------------------------------------
+! COPY VALUES FOR INPUT VARIABLES BEFORE CALL TO ROSR12
+! ----------------------------------------------------------------------
+      DO K = 1,NSOIL
+         RHSTSin (K) = RHSTS (K)
+      END DO
+      DO K = 1,NSOIL
+         CIin (K) = CI (K)
+      END DO
+! ----------------------------------------------------------------------
+! SOLVE THE TRI-DIAGONAL MATRIX EQUATION
+! ----------------------------------------------------------------------
+      CALL ROSR12 (CI,AI,BI,CIin,RHSTSin,RHSTS,NSOIL)
+! ----------------------------------------------------------------------
+! CALC/UPDATE THE SOIL TEMPS USING MATRIX SOLUTION
+! ----------------------------------------------------------------------
+      DO K = 1,NSOIL
+         STCOUT (K) = STCIN (K) + CI (K)
+      END DO
+! ----------------------------------------------------------------------
+  END SUBROUTINE HSTEP
+! ----------------------------------------------------------------------
+! ----------------------------------------------------------------------
+
+      SUBROUTINE TBND (TU,TB,ZSOIL,ZBOT,K,NSOIL,TBND1)
+
+! ----------------------------------------------------------------------
+! SUBROUTINE TBND
+! ----------------------------------------------------------------------
+! CALCULATE TEMPERATURE ON THE BOUNDARY OF THE LAYER BY INTERPOLATION OF
+! THE MIDDLE LAYER TEMPERATURES
+! ----------------------------------------------------------------------
+      IMPLICIT NONE
+      INTEGER, INTENT(IN)       :: NSOIL
+      INTEGER                   :: K
+      REAL, INTENT(IN)          :: TB, TU, ZBOT
+      REAL, INTENT(OUT)         :: TBND1
+      REAL, DIMENSION(1:NSOIL), INTENT(IN)   :: ZSOIL
+      REAL                      :: ZB, ZUP
+
+! ----------------------------------------------------------------------
+! USE SURFACE TEMPERATURE ON THE TOP OF THE FIRST LAYER
+! ----------------------------------------------------------------------
+     IF (K == 1) THEN
+         ZUP = 0.
+      ELSE
+         ZUP = ZSOIL (K -1)
+      END IF
+! ----------------------------------------------------------------------
+! USE DEPTH OF THE CONSTANT BOTTOM TEMPERATURE WHEN INTERPOLATE
+! TEMPERATURE INTO THE LAST LAYER BOUNDARY
+! ----------------------------------------------------------------------
+      IF (K ==  NSOIL) THEN
+         ZB = 2.* ZBOT - ZSOIL (K)
+      ELSE
+         ZB = ZSOIL (K +1)
+      END IF
+! ----------------------------------------------------------------------
+! LINEAR INTERPOLATION BETWEEN THE AVERAGE LAYER TEMPERATURES
+! ----------------------------------------------------------------------
+
+      TBND1 = TU + (TB - TU)* (ZUP - ZSOIL (K))/ (ZUP - ZB)
+! ----------------------------------------------------------------------
+  END SUBROUTINE TBND
+! ----------------------------------------------------------------------
+      SUBROUTINE TDFCND (DF, SMC, QZ, SMCMAX)
+! ----------------------------------------------------------------------
+! CALCULATE THERMAL CONDUCTIVITY OF THE SOIL
+! ----------------------------------------------------------------------
+! PETERS-LIDARD APPROACH (PETERS-LIDARD et al., 1998)
+! ----------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL, INTENT(IN)          :: QZ,  SMC, SMCMAX
+      REAL, INTENT(OUT)         :: DF
+      REAL                      :: AKE, GAMMD, THKDRY, THKO,         &
+                                   THKQTZ,THKSAT,THKS,THKW,SATRATIO
+
+! ----------------------------------------------------------------------
+! IF THE SOIL HAS ANY MOISTURE CONTENT COMPUTE A PARTIAL SUM/PRODUCT
+! OTHERWISE USE A CONSTANT VALUE WHICH WORKS WELL WITH MOST SOILS
+! ----------------------------------------------------------------------
+!  THKW ......WATER THERMAL CONDUCTIVITY
+!  THKQTZ ....THERMAL CONDUCTIVITY FOR QUARTZ
+!  THKO ......THERMAL CONDUCTIVITY FOR OTHER SOIL COMPONENTS
+!  THKS ......THERMAL CONDUCTIVITY FOR THE SOLIDS COMBINED(QUARTZ+OTHER)
+!  SMCMAX ....POROSITY (= SMCMAX)
+!  QZ .........QUARTZ CONTENT (SOIL TYPE DEPENDENT)
+! ----------------------------------------------------------------------
+! USE AS IN PETERS-LIDARD, 1998 (MODIF. FROM JOHANSEN, 1975).
+
+!                                  PABLO GRUNMANN, 08/17/98
+! REFS.:
+!      FAROUKI, O.T.,1986: THERMAL PROPERTIES OF SOILS. SERIES ON ROCK
+!              AND SOIL MECHANICS, VOL. 11, TRANS TECH, 136 PP.
+!      JOHANSEN, O., 1975: THERMAL CONDUCTIVITY OF SOILS. PH.D. THESIS,
+!              UNIVERSITY OF TRONDHEIM,
+!      PETERS-LIDARD, C. D., ET AL., 1998: THE EFFECT OF SOIL THERMAL
+!              CONDUCTIVITY PARAMETERIZATION ON SURFACE ENERGY FLUXES
+!              AND TEMPERATURES. JOURNAL OF THE ATMOSPHERIC SCIENCES,
+!              VOL. 55, PP. 1209-1224.
+! ----------------------------------------------------------------------
+! NEEDS PARAMETERS
+! POROSITY(SOIL TYPE):
+!      POROS = SMCMAX
+! SATURATION RATIO:
+! PARAMETERS  W/(M.K)
+      SATRATIO = SMC / SMCMAX
+! WATER CONDUCTIVITY:
+      THKW = 0.57
+! THERMAL CONDUCTIVITY OF "OTHER" SOIL COMPONENTS
+!      IF (QZ .LE. 0.2) THKO = 3.0
+      THKO = 2.0
+! QUARTZ' CONDUCTIVITY
+      THKQTZ = 7.7
+! SOLIDS' CONDUCTIVITY
+      THKS = (THKQTZ ** QZ)* (THKO ** (1. - QZ))
+
+! SATURATED THERMAL CONDUCTIVITY
+      THKSAT = THKS ** (1. - SMCMAX)* THKW ** (SMCMAX)
+
+! DRY DENSITY IN KG/M3
+      GAMMD = (1. - SMCMAX)*2700.
+
+! DRY THERMAL CONDUCTIVITY IN W.M-1.K-1
+      THKDRY = (0.135* GAMMD+ 64.7)/ (2700. - 0.947* GAMMD)
+
+! KERSTEN NUMBER (USING "FINE" FORMULA, VALID FOR SOILS CONTAINING AT
+! LEAST 5% OF PARTICLES WITH DIAMETER LESS THAN 2.E-6 METERS.)
+! (FOR "COARSE" FORMULA, SEE PETERS-LIDARD ET AL., 1998).
+
+         IF ( SATRATIO >  0.1 ) THEN
+
+            AKE = LOG10 (SATRATIO) + 1.0
+
+! USE K = KDRY
+         ELSE
+
+            AKE = 0.0
+         END IF
+!  THERMAL CONDUCTIVITY
+
+      DF = AKE * (THKSAT - THKDRY) + THKDRY
+! ----------------------------------------------------------------------
+  END SUBROUTINE TDFCND
+! ----------------------------------------------------------------------
+!===========================================================================
 END MODULE module_sf_urban
diff --git a/src/core_init_atmosphere/Makefile b/src/core_init_atmosphere/Makefile
index 9579f48573..e8f71becfc 100644
--- a/src/core_init_atmosphere/Makefile
+++ b/src/core_init_atmosphere/Makefile
@@ -99,10 +99,10 @@ clean:
 .F.o:
 	$(RM) $@ $*.mod
 ifeq "$(GEN_F90)" "true"
-	$(CPP) $(CPPFLAGS) $(CPPINCLUDES) $< > $*.f90
+	$(CPP) $(CPPFLAGS) $(CPPINCLUDES) -I./inc $< > $*.f90
 	$(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I../framework -I../operators  -I../external/esmf_time_f90
 else
-	$(FC) $(CPPFLAGS) $(FFLAGS) -c $*.F $(CPPINCLUDES) $(FCINCLUDES) -I../framework -I../operators  -I../external/esmf_time_f90
+	$(FC) $(CPPFLAGS) $(FFLAGS) -c $*.F $(CPPINCLUDES) $(FCINCLUDES) -I./inc -I../framework -I../operators  -I../external/esmf_time_f90
 endif
 
 .c.o:
diff --git a/src/core_init_atmosphere/Registry.xml b/src/core_init_atmosphere/Registry.xml
index 3a89997b2c..515b881d01 100644
--- a/src/core_init_atmosphere/Registry.xml
+++ b/src/core_init_atmosphere/Registry.xml
@@ -1,28 +1,45 @@
 <?xml version="1.0"?>
-<registry model="mpas" core="init_atmosphere" core_abbrev="init_atm" version="6.3">
+<registry model="mpas" core="init_atmosphere" core_abbrev="init_atm" version="7.0">
 
 <!-- **************************************************************************************** -->
 <!-- ************************************** Dimensions ************************************** -->
 <!-- **************************************************************************************** -->
 
         <dims>
-                <dim name="nCells"/>
-                <dim name="nEdges"/>
-                <dim name="maxEdges"/>
-                <dim name="maxEdges2"/>
-                <dim name="nVertices"/>
-                <dim name="TWO"                definition="2"/>
-                <dim name="THREE"              definition="3"/>
-                <dim name="vertexDegree"/>
-                <dim name="FIFTEEN"            definition="15"/>
-                <dim name="TWENTYONE"          definition="21"/>
-                <dim name="R3"                 definition="3"/>
-                <dim name="nVertLevels"        definition="namelist:config_nvertlevels"/>
-                <dim name="nSoilLevels"        definition="namelist:config_nsoillevels"/>
-                <dim name="nFGLevels"          definition="namelist:config_nfglevels"/>
-                <dim name="nFGSoilLevels"      definition="namelist:config_nfgsoillevels"/>
-                <dim name="nVertLevelsP1"      definition="nVertLevels+1"/>
-                <dim name="nMonths"            definition="namelist:config_months"/>
+                <dim name="nCells"
+                     description="The number of Voronoi cells in the primal mesh"/>
+                <dim name="nEdges"
+                     description="The number of cell faces (edges) in the primal and dual meshes"/>
+                <dim name="maxEdges"
+                     description="The largest number of neighbors that a primal mesh cell may have"/>
+                <dim name="maxEdges2"
+                     description="Twice the value of maxEdges"/>
+                <dim name="nVertices"
+                     description="The number of Delaunay triangles in the dual mesh, equivalent to the number of cell corners in the primal mesh"/>
+                <dim name="TWO" definition="2"
+                     description="A constant value of 2"/>
+                <dim name="THREE" definition="3"
+                     description="A constant value of 3"/>
+                <dim name="vertexDegree"
+                     description="The number of edges or cells that meet at vertices"/>
+                <dim name="FIFTEEN" definition="15"
+                     description="A constant value of 15"/>
+                <dim name="TWENTYONE" definition="21"
+                     description="A constant value of 21"/>
+                <dim name="R3" definition="3"
+                     description="The dimensionality of vectors in $\Re^3$"/>
+                <dim name="nVertLevels" definition="namelist:config_nvertlevels"
+                     description="The number of atmospheric layers"/>
+                <dim name="nSoilLevels" definition="namelist:config_nsoillevels"
+                     description="The number of soil layers used by the land-surface scheme"/>
+                <dim name="nFGLevels" definition="namelist:config_nfglevels"
+                     description="The number of first-guess atmospheric layers"/>
+                <dim name="nFGSoilLevels" definition="namelist:config_nfgsoillevels"
+                     description="The number of first-guess soil layers"/>
+                <dim name="nVertLevelsP1" definition="nVertLevels+1"
+                     description="The number of atmospheric levels, always one more than the number of layers"/>
+                <dim name="nMonths" definition="namelist:config_months"
+                     description="The number of months in a year"/>
         </dims>
 
 
@@ -34,16 +51,17 @@
 
                 <nml_option name="config_init_case"             type="integer"       default_value="7"
                      units="-"
-                     description="config\_init\_case & Type of initial conditions to create: \newline
-                                        1 = Jablonowski \& Williamson barolinic wave (no initial perturbation), \newline
-                                        2 = Jablonowski \& Williamson barolinic wave (with initial perturbation), \newline
-                                        3 = Jablonowski \& Williamson barolinic wave (with normal-mode perturbation), \newline
+                     description="Type of initial conditions to create: \newline
+                                        1 = Jablonowski &amp; Williamson barolinic wave (no initial perturbation), \newline
+                                        2 = Jablonowski &amp; Williamson barolinic wave (with initial perturbation), \newline
+                                        3 = Jablonowski &amp; Williamson barolinic wave (with normal-mode perturbation), \newline
                                         4 = squall line, \newline
                                         5 = super-cell, \newline
                                         6 = mountain wave, \newline
                                         7 = real-data initial conditions from, e.g., GFS, \newline
-                                        8 = surface field (SST, sea-ice) update file for use with real-data simulations"
-                     possible_values="1 -- 8"/>
+                                        8 = surface field (SST, sea-ice) update file for use with real-data simulations \newline
+                                        9 = lateral boundary conditions update file for use with real-data simulations"
+                     possible_values="1 -- 9"/>
 
                 <nml_option name="config_calendar_type" type="character" default_value="gregorian" in_defaults="false"
                      units="-"
@@ -52,12 +70,12 @@
 
                 <nml_option name="config_start_time"            type="character"     default_value="2010-10-23_00:00:00"
                      units="-"
-                     description="Time to begin processing first-guess data (cases 7 and 8 only)"
+                     description="Time to begin processing first-guess data (cases 7, 8, and 9 only)"
                      possible_values="`YYYY-MM-DD_hh:mm:ss'"/>
 
                 <nml_option name="config_stop_time"             type="character"     default_value="2010-10-23_00:00:00"
                      units="-"
-                     description="Time to end processing first-guess data (case 8 only)"
+                     description="Time to end processing first-guess data (cases 8 and 9 only)"
                      possible_values="`YYYY-MM-DD_hh:mm:ss'"/>
 
                 <nml_option name="config_theta_adv_order" type="integer" default_value="3"
@@ -91,7 +109,7 @@
 
                 <nml_option name="config_nfglevels"             type="integer"       default_value="38"
                      units="-"
-                     description="The number of atmospheric levels (including surface and sea-level) in the first-guess dataset (case 7 only)"
+                     description="The number of atmospheric levels (including surface and sea-level) in the first-guess dataset (cases 7 and 9 only)"
                      possible_values="Positive integer values"/>
 
                 <nml_option name="config_nfgsoillevels"         type="integer"       default_value="4"
@@ -108,14 +126,14 @@
 
         <nml_record name="data_sources" in_defaults="true">
 
-                <nml_option name="config_geog_data_path"        type="character"     default_value="/glade/p/work/wrfhelp/WPS_GEOG/"
+                <nml_option name="config_geog_data_path"        type="character"     default_value="/glade/work/wrfhelp/WPS_GEOG/"
                      units="-"
                      description="Path to the WPS static data files (case 7 only)"
                      possible_values="Any valid path"/>
 
                 <nml_option name="config_met_prefix"            type="character"     default_value="CFSR"
                      units="-"
-                     description="Filename prefix of ungrib intermediate file to use for initial conditions (case 7 only)"
+                     description="Filename prefix of ungrib intermediate file to use for initial conditions (cases 7 and 9 only)"
                      possible_values="Any alpha-numeric string"/>
 
                 <nml_option name="config_sfc_prefix"            type="character"     default_value="SST"
@@ -125,19 +143,39 @@
 
                 <nml_option name="config_fg_interval"           type="integer"       default_value="86400"
                      units="-"
-                     description="Interval between SST and sea-ice files (case 8 only)"
+                     description="Interval between intermediate files (cases 8 and 9 only)"
                      possible_values="[DDD_]hh:mm:ss"/>
 
-                <nml_option name="config_landuse_data"          type="character"     default_value="USGS"
+                <nml_option name="config_landuse_data"          type="character"     default_value="MODIFIED_IGBP_MODIS_NOAH"
                      units="-"
                      description="The land use classification to use (case 7 only)"
-                     possible_values="`USGS' or `MODIFIED\_IGBP\_MODIS\_NOAH'"/>
+                     possible_values="`USGS' or `MODIFIED_IGBP_MODIS_NOAH'"/>
 
-                <nml_option name="config_topo_data"             type="character"     default_value="GTOPO30"
+                <nml_option name="config_topo_data"             type="character"     default_value="GMTED2010"
                      units="-"
                      description="The topography dataset to use for the model terrain and for GWDO static fields (case 7 only)"
                      possible_values="`GTOPO30' or `GMTED2010'"/>
 
+                <nml_option name="config_vegfrac_data"          type="character"     default_value="MODIS"
+                     units="-"
+                     description="The climatological monthly vegetation fraction dataset to use (case 7 only)"
+                     possible_values="`MODIS' or `NCEP'"/>
+
+                <nml_option name="config_albedo_data"           type="character"     default_value="MODIS"
+                     units="-"
+                     description="The climatological monthly albedo dataset to use (case 7 only)"
+                     possible_values="`MODIS' or `NCEP'"/>
+
+                <nml_option name="config_maxsnowalbedo_data"    type="character"     default_value="MODIS"
+                     units="-"
+                     description="The maximum snow albedo dataset to use (case 7 only)"
+                     possible_values="`MODIS' or `NCEP'"/>
+
+                <nml_option name="config_supersample_factor"    type="integer"       default_value="3"
+                     units="-"
+                     description="The supersampling factor to be used for MODIS maximum snow albedo and monthly albedo datasets (case 7 only)"
+                     possible_values="Positive integer values"/>
+
                 <nml_option name="config_use_spechumd"          type="logical"       default_value="false"
                      units="-"
                      description="Whether to use specific-humidity as the first-guess moisture variable. If this option is False, relative humidity will be used."
@@ -177,6 +215,16 @@
                      description="Whether to use the vertical layer profile that was developed for use in real-time TC experiments"
                      possible_values="true or false"/>
 
+                <nml_option name="config_specified_zeta_levels" type="character"     default_value=""    in_defaults="false"
+                     units="-"
+                     description="The name of a text file containing a list of vertical coordinate (zeta) values in increasing order at layer interfaces."
+                     possible_values="Any valid filename"/>
+
+                <nml_option name="config_blend_bdy_terrain"     type="logical"       default_value="false"
+                     units="-"
+                     description="Whether to blend terrain along domain boundaries with first-guess terrain. Only useful for limited-area domains."
+                     possible_values="true or false"/>
+
         </nml_record>
 
         <nml_record name="interpolation_control" in_defaults="true">
@@ -272,7 +320,9 @@
         <packages>
                 <package name="initial_conds" description="Used by test cases that produce initial conditions."/>
                 <package name="sfc_update" description="Used by test cases that produce surface updates."/>
-                <package name="gwd_stage_in" description="Active only if GWD static fields will be generated and other static fields will not be generated"/>
+                <package name="lbcs" description="Active when lateral boundary conditions are interpolated and written."/>
+                <package name="gwd_stage_in" description="Active only if GWD static fields are be generated and other static fields are not being generated"/>
+                <package name="gwd_stage_out" description="Active only if GWD static fields are be generated and other static fields are not being generated"/>
                 <package name="vertical_stage_in" description="Active only if a vertical grid is being generated"/>
                 <package name="vertical_stage_out" description="Active only if a vertical grid is being generated"/>
                 <package name="met_stage_in" description="Active only if meteorological fields are being interpolated"/>
@@ -327,6 +377,9 @@
                         <var name="cellsOnVertex"/>
                         <var name="kiteAreasOnVertex"/>
                         <var name="meshDensity"/>
+                        <var name="bdyMaskCell"/>
+                        <var name="bdyMaskEdge"/>
+                        <var name="bdyMaskVertex"/>
                         <var name="edgeNormalVectors" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
                         <var name="localVerticalUnitVectors" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
                         <var name="cellTangentPlane" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
@@ -334,8 +387,10 @@
                         <var name="fVertex" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
                         <var name="ter" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
                         <var name="landmask" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
-                        <var name="ivgtyp" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
                         <var name="mminlu" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
+                        <var name="isice_lu" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
+                        <var name="iswater_lu" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
+                        <var name="ivgtyp" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
                         <var name="isltyp" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
                         <var name="snoalb" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
                         <var name="soiltemp" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
@@ -343,17 +398,16 @@
                         <var name="shdmin" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
                         <var name="shdmax" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
                         <var name="albedo12m" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
-                        <var name="varsso" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
-                        <var name="var2d" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
-                        <var name="con" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
-                        <var name="oa1" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
-                        <var name="oa2" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
-                        <var name="oa3" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
-                        <var name="oa4" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
-                        <var name="ol1" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
-                        <var name="ol2" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
-                        <var name="ol3" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
-                        <var name="ol4" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
+                        <var name="var2d" packages="vertical_stage_in;met_stage_in"/>
+                        <var name="con" packages="vertical_stage_in;met_stage_in"/>
+                        <var name="oa1" packages="vertical_stage_in;met_stage_in"/>
+                        <var name="oa2" packages="vertical_stage_in;met_stage_in"/>
+                        <var name="oa3" packages="vertical_stage_in;met_stage_in"/>
+                        <var name="oa4" packages="vertical_stage_in;met_stage_in"/>
+                        <var name="ol1" packages="vertical_stage_in;met_stage_in"/>
+                        <var name="ol2" packages="vertical_stage_in;met_stage_in"/>
+                        <var name="ol3" packages="vertical_stage_in;met_stage_in"/>
+                        <var name="ol4" packages="vertical_stage_in;met_stage_in"/>
                         <var name="deriv_two" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
                         <var name="advCells" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
                         <var name="defc_a" packages="gwd_stage_in;vertical_stage_in;met_stage_in"/>
@@ -421,6 +475,9 @@
                         <var name="cellsOnVertex"/>
                         <var name="kiteAreasOnVertex"/>
                         <var name="meshDensity"/>
+                        <var name="bdyMaskCell"/>
+                        <var name="bdyMaskEdge"/>
+                        <var name="bdyMaskVertex"/>
                         <var name="edgeNormalVectors"/>
                         <var name="localVerticalUnitVectors"/>
                         <var name="cellTangentPlane"/>
@@ -428,8 +485,10 @@
                         <var name="fVertex"/>
                         <var name="ter"/>
                         <var name="landmask"/>
-                        <var name="ivgtyp"/>
                         <var name="mminlu"/>
+                        <var name="isice_lu"/>
+                        <var name="iswater_lu"/>
+                        <var name="ivgtyp"/>
                         <var name="isltyp"/>
                         <var name="snoalb"/>
                         <var name="soiltemp"/>
@@ -437,17 +496,16 @@
                         <var name="shdmin"/>
                         <var name="shdmax"/>
                         <var name="albedo12m"/>
-                        <var name="varsso"/>
-                        <var name="var2d"/>
-                        <var name="con"/>
-                        <var name="oa1"/>
-                        <var name="oa2"/>
-                        <var name="oa3"/>
-                        <var name="oa4"/>
-                        <var name="ol1"/>
-                        <var name="ol2"/>
-                        <var name="ol3"/>
-                        <var name="ol4"/>
+                        <var name="var2d" packages="gwd_stage_out;vertical_stage_out;met_stage_out"/>
+                        <var name="con" packages="gwd_stage_out;vertical_stage_out;met_stage_out"/>
+                        <var name="oa1" packages="gwd_stage_out;vertical_stage_out;met_stage_out"/>
+                        <var name="oa2" packages="gwd_stage_out;vertical_stage_out;met_stage_out"/>
+                        <var name="oa3" packages="gwd_stage_out;vertical_stage_out;met_stage_out"/>
+                        <var name="oa4" packages="gwd_stage_out;vertical_stage_out;met_stage_out"/>
+                        <var name="ol1" packages="gwd_stage_out;vertical_stage_out;met_stage_out"/>
+                        <var name="ol2" packages="gwd_stage_out;vertical_stage_out;met_stage_out"/>
+                        <var name="ol3" packages="gwd_stage_out;vertical_stage_out;met_stage_out"/>
+                        <var name="ol4" packages="gwd_stage_out;vertical_stage_out;met_stage_out"/>
                         <var name="deriv_two"/>
                         <var name="advCells"/>
                         <var name="defc_a"/>
@@ -469,6 +527,7 @@
                         <var name="zb3" packages="vertical_stage_out;met_stage_out"/>
                         <var name="dss" packages="vertical_stage_out;met_stage_out"/>
                         <var name="u_init" packages="met_stage_out"/>
+                        <var name="v_init" packages="met_stage_out"/>
                         <var name="t_init" packages="met_stage_out"/>
                         <var name="qv_init" packages="met_stage_out"/>
                         <var_array name="scalars" packages="met_stage_out"/>
@@ -498,11 +557,11 @@
                         <var name="theta_base" packages="met_stage_out"/>
                         <var name="surface_pressure" packages="met_stage_out"/>
                         <var name="precipw" packages="met_stage_out"/>
-			<var name="h_oml_initial" packages="met_stage_out"/>
+                        <var name="h_oml_initial" packages="met_stage_out"/>
                         <var name="u10" packages="met_stage_out"/>
                         <var name="v10" packages="met_stage_out"/>
                         <var name="q2" packages="met_stage_out"/>
-			<var name="rh2" packages="met_stage_out"/>
+                        <var name="rh2" packages="met_stage_out"/>
                         <var name="t2m" packages="met_stage_out"/>
 		</stream>
 
@@ -519,6 +578,18 @@
 			<var name="xice"/>
 		</stream>
 
+		<stream name="lbc"
+                        type="output"
+                        filename_template="lbc.$Y-$M-$D_$h.$m.$s.nc"
+                        output_interval="3:00:00"
+                        filename_interval="output_interval"
+                        packages="lbcs"
+                        immutable="true">
+
+			<var name="xtime"/>
+			<var_struct name="lbc_state"/>
+		</stream>
+
 	</streams>
 
 
@@ -527,208 +598,556 @@
 <!-- **************************************************************************************** -->
 
         <var_struct name="mesh" time_levs="1">
-                <var name="latCell"                      type="real"     dimensions="nCells"/>
-                <var name="lonCell"                      type="real"     dimensions="nCells"/>
-                <var name="xCell"                        type="real"     dimensions="nCells"/>
-                <var name="yCell"                        type="real"     dimensions="nCells"/>
-                <var name="zCell"                        type="real"     dimensions="nCells"/>
-                <var name="indexToCellID"                type="integer"  dimensions="nCells"/>
-                <var name="latEdge"                      type="real"     dimensions="nEdges"/>
-                <var name="lonEdge"                      type="real"     dimensions="nEdges"/>
-                <var name="xEdge"                        type="real"     dimensions="nEdges"/>
-                <var name="yEdge"                        type="real"     dimensions="nEdges"/>
-                <var name="zEdge"                        type="real"     dimensions="nEdges"/>
-                <var name="indexToEdgeID"                type="integer"  dimensions="nEdges"/>
-                <var name="latVertex"                    type="real"     dimensions="nVertices"/>
-                <var name="lonVertex"                    type="real"     dimensions="nVertices"/>
-                <var name="xVertex"                      type="real"     dimensions="nVertices"/>
-                <var name="yVertex"                      type="real"     dimensions="nVertices"/>
-                <var name="zVertex"                      type="real"     dimensions="nVertices"/>
-                <var name="indexToVertexID"              type="integer"  dimensions="nVertices"/>
-                <var name="cellsOnEdge"                  type="integer"  dimensions="TWO nEdges"/>
-                <var name="nEdgesOnCell"                 type="integer"  dimensions="nCells"/>
-                <var name="nEdgesOnEdge"                 type="integer"  dimensions="nEdges"/>
-                <var name="edgesOnCell"                  type="integer"  dimensions="maxEdges nCells"/>
-                <var name="edgesOnEdge"                  type="integer"  dimensions="maxEdges2 nEdges"/>
-                <var name="weightsOnEdge"                type="real"     dimensions="maxEdges2 nEdges"/>
-                <var name="dvEdge"                       type="real"     dimensions="nEdges"/>
-                <var name="dcEdge"                       type="real"     dimensions="nEdges"/>
-                <var name="angleEdge"                    type="real"     dimensions="nEdges"/>
-                <var name="areaCell"                     type="real"     dimensions="nCells"/>
-                <var name="areaTriangle"                 type="real"     dimensions="nVertices"/>
-                <var name="edgeNormalVectors"            type="real"     dimensions="R3 nEdges"/>
-                <var name="localVerticalUnitVectors"     type="real"     dimensions="R3 nCells"/>
-                <var name="cellTangentPlane"             type="real"     dimensions="R3 TWO nCells"/>
-                <var name="cellsOnCell"                  type="integer"  dimensions="maxEdges nCells"/>
-                <var name="verticesOnCell"               type="integer"  dimensions="maxEdges nCells"/>
-                <var name="verticesOnEdge"               type="integer"  dimensions="TWO nEdges"/>
-                <var name="edgesOnVertex"                type="integer"  dimensions="vertexDegree nVertices"/>
-                <var name="cellsOnVertex"                type="integer"  dimensions="vertexDegree nVertices"/>
-                <var name="kiteAreasOnVertex"            type="real"     dimensions="vertexDegree nVertices"/>
-                <var name="fEdge"                        type="real"     dimensions="nEdges"/>
-                <var name="fVertex"                      type="real"     dimensions="nVertices"/>
-                <var name="meshDensity"                  type="real"     dimensions="nCells"/>
+
+                <var name="latCell" type="real" dimensions="nCells" units="rad"
+                     description="Latitude of cells"/>
+
+                <var name="lonCell" type="real" dimensions="nCells" units="rad"
+                     description="Longitude of cells"/>
+
+                <var name="xCell" type="real" dimensions="nCells" units="m"
+                     description="Cartesian x-coordinate of cells"/>
+
+                <var name="yCell" type="real" dimensions="nCells" units="m"
+                     description="Cartesian y-coordinate of cells"/>
+
+                <var name="zCell" type="real" dimensions="nCells" units="m"
+                     description="Cartesian z-coordinate of cells"/>
+
+                <var name="indexToCellID" type="integer" dimensions="nCells" units="-"
+                     description="Mapping from local array index to global cell ID"/>
+
+                <var name="latEdge" type="real" dimensions="nEdges" units="rad"
+                     description="Latitude of edges"/>
+
+                <var name="lonEdge" type="real" dimensions="nEdges" units="rad"
+                     description="Longitude of edges"/>
+
+                <var name="xEdge" type="real" dimensions="nEdges" units="m"
+                     description="Cartesian x-coordinate of edges"/>
+
+                <var name="yEdge" type="real" dimensions="nEdges" units="m"
+                     description="Cartesian y-coordinate of edges"/>
+
+                <var name="zEdge" type="real" dimensions="nEdges" units="m"
+                     description="Cartesian z-coordinate of edges"/>
+
+                <var name="indexToEdgeID" type="integer" dimensions="nEdges" units="-"
+                     description="Mapping from local array index to global edge ID"/>
+
+                <var name="latVertex" type="real" dimensions="nVertices" units="rad"
+                     description="Latitude of vertices"/>
+
+                <var name="lonVertex" type="real" dimensions="nVertices" units="rad"
+                     description="Longitude of vertices"/>
+
+                <var name="xVertex" type="real" dimensions="nVertices" units="m"
+                     description="Cartesian x-coordinate of vertices"/>
+
+                <var name="yVertex" type="real" dimensions="nVertices" units="m"
+                     description="Cartesian y-coordinate of vertices"/>
+
+                <var name="zVertex" type="real" dimensions="nVertices" units="m"
+                     description="Cartesian z-coordinate of vertices"/>
+
+                <var name="indexToVertexID" type="integer" dimensions="nVertices" units="-"
+                     description="Mapping from local array index to global vertex ID"/>
+
+                <var name="cellsOnEdge" type="integer" dimensions="TWO nEdges" units="-"
+                     description="IDs of cells divided by an edge"/>
+
+                <var name="nEdgesOnCell" type="integer" dimensions="nCells" units="-"
+                     description="Number of edges forming the boundary of a cell"/>
+
+                <var name="nEdgesOnEdge" type="integer" dimensions="nEdges" units="-"
+                     description="Number of edges involved in reconstruction of tangential velocity for an edge"/>
+
+                <var name="edgesOnCell" type="integer" dimensions="maxEdges nCells" units="-"
+                     description="IDs of edges forming the boundary of a cell"/>
+
+                <var name="edgesOnEdge" type="integer" dimensions="maxEdges2 nEdges" units="-"
+                     description="IDs of edges involved in reconstruction of tangential velocity for an edge"/>
+
+                <var name="weightsOnEdge" type="real" dimensions="maxEdges2 nEdges" units="-"
+                     description="Weights used in reconstruction of tangential velocity for an edge"/>
+
+                <var name="dvEdge" type="real" dimensions="nEdges" units="-"
+                     description="Spherical distance between vertex endpoints of an edge"/>
+
+                <var name="dcEdge" type="real" dimensions="nEdges" units="m"
+                     description="Spherical distance between cells separated by an edge"/>
+
+                <var name="angleEdge" type="real" dimensions="nEdges" units="rad"
+                     description="Angle between local north and the positive tangential direction of an edge"/>
+
+                <var name="areaCell" type="real" dimensions="nCells" units="m^2"
+                     description="Spherical area of a Voronoi cell"/>
+
+                <var name="areaTriangle" type="real" dimensions="nVertices" units="m^2"
+                     description="Spherical area of a Delaunay triangle"/>
+
+                <var name="edgeNormalVectors" type="real" dimensions="R3 nEdges" units="unitless"
+                     description="Cartesian components of the vector normal to an edge and tangential to the surface of the sphere"/>
+
+                <var name="localVerticalUnitVectors" type="real" dimensions="R3 nCells" units="unitless"
+                     description="Cartesian components of the vector pointing in the local vertical direction for a cell"/>
+
+                <var name="cellTangentPlane" type="real" dimensions="R3 TWO nCells" units="unitless"
+                     description="Components of a pair of vectors defining the tangent plane at a cell"/>
+
+                <var name="cellsOnCell" type="integer" dimensions="maxEdges nCells" units="-"
+                     description="IDs of cells neighboring a cell"/>
+
+                <var name="verticesOnCell" type="integer" dimensions="maxEdges nCells" units="-"
+                     description="IDs of vertices (corner points) of a cell"/>
+
+                <var name="verticesOnEdge" type="integer" dimensions="TWO nEdges" units="-"
+                     description="IDs of the two vertex endpoints of an edge"/>
+
+                <var name="edgesOnVertex" type="integer" dimensions="vertexDegree nVertices" units="-"
+                     description="IDs of the edges that meet at a vertex"/>
+
+                <var name="cellsOnVertex" type="integer" dimensions="vertexDegree nVertices" units="-"
+                     description="IDs of the cells that meet at a vertex"/>
+
+                <var name="kiteAreasOnVertex" type="real" dimensions="vertexDegree nVertices" units="m^2"
+                     description="Intersection areas between primal (Voronoi) and dual (triangular) mesh cells"/>
+
+                <var name="fEdge" type="real" dimensions="nEdges" units="unitless"
+                     description="Coriolis parameter at an edge"/>
+
+                <var name="fVertex" type="real" dimensions="nVertices" units="unitless"
+                     description="Coriolis parameter at a vertex"/>
+
+                <var name="meshDensity" type="real" dimensions="nCells" units="unitless"
+                     description="Mesh density function (used when generating the mesh) evaluated at a cell"/>
 
                 <!-- coefficients for vertical extrapolation to the surface -->
-                <var name="cf1"                          type="real"     dimensions=""/>
-                <var name="cf2"                          type="real"     dimensions=""/>
-                <var name="cf3"                          type="real"     dimensions=""/>
+                <var name="cf1" type="real" dimensions="" units="unitless"
+                     description="Surface interpolation weight for level k=1 value"/>
+
+                <var name="cf2" type="real" dimensions="" units="unitless"
+                     description="Surface interpolation weight for level k=2 value"/>
+
+                <var name="cf3" type="real" dimensions="" units="unitless"
+                     description="Surface interpolation weight for level k=3 value"/>
 
                 <!-- static terrestrial fields -->
-                <var name="ter"                                  type="real"     dimensions="nCells"/>
-                <var name="landmask"                             type="integer"  dimensions="nCells"/>
-                <var name="ivgtyp"   name_in_code="lu_index"     type="integer"  dimensions="nCells"/>
-                <var name="mminlu"                               type="text"     dimensions=""/>
-                <var name="isltyp"   name_in_code="soilcat_top"  type="integer"  dimensions="nCells"/>
-                <var name="snoalb"                               type="real"     dimensions="nCells"/>
-                <var name="soiltemp"                             type="real"     dimensions="nCells"/>
-                <var name="greenfrac"                            type="real"     dimensions="nMonths nCells"/>
-                <var name="shdmin"                               type="real"     dimensions="nCells"/>
-                <var name="shdmax"                               type="real"     dimensions="nCells"/>
-                <var name="albedo12m"                            type="real"     dimensions="nMonths nCells"/>
+                <var name="ter" type="real" dimensions="nCells" units="m"
+                     description="terrain height"/>
+
+                <var name="landmask" type="integer"  dimensions="nCells" units="unitless"
+                     description="land-ocean mask (1=land ; 0=ocean)"/>
+
+                <var name="ivgtyp" name_in_code="lu_index" type="integer"  dimensions="nCells" units="unitless"
+                     description="dominant vegetation category"/>
+
+                <var name="mminlu" type="text" dimensions="" units="unitless"
+                     description="land use classification"/>
+
+                <var name="isltyp" name_in_code="soilcat_top"  type="integer"  dimensions="nCells" units="unitless"
+                     description="dominate soil category"/>
+
+                <var name="snoalb" type="real" dimensions="nCells" units="unitless"
+                     description="annual maximum snow albedo"/>
+
+                <var name="soiltemp" type="real" dimensions="nCells" units="K"
+                     description="annual mean deep soil temperature"/>
+
+                <var name="greenfrac" type="real" dimensions="nMonths nCells" units="unitless"
+                     description="monthly-mean climatological greeness fraction"/>
+
+                <var name="shdmin" type="real" dimensions="nCells" units="unitless"
+                     description="minimum fractional coverage of annual green vegetation fraction"/>
+
+                <var name="shdmax" type="real" dimensions="nCells" units="unitless"
+                     description="maximum fractional coverage of annual green vegetation fraction"/>
+
+                <var name="albedo12m" type="real" dimensions="nMonths nCells" units="unitless"
+                     description="monthly-mean climatological surface albedo"/>
+
+                <var name="isice_lu" type="integer" dimensions="" units="unitless" default_value="24"
+                     description="Index category for snow/ice"/>
+
+                <var name="iswater_lu" type="integer" dimensions="" units="unitless" default_value="16"
+                     description="Index category for water"/>
 
                 <!-- GWDO fields -->
-                <var name="varsso"                               type="real"     dimensions="nCells"/>
-                <var name="var2d"                                type="real"     dimensions="nCells"/>
-                <var name="con"                                  type="real"     dimensions="nCells"/>
-                <var name="oa1"                                  type="real"     dimensions="nCells"/>
-                <var name="oa2"                                  type="real"     dimensions="nCells"/>
-                <var name="oa3"                                  type="real"     dimensions="nCells"/>
-                <var name="oa4"                                  type="real"     dimensions="nCells"/>
-                <var name="ol1"                                  type="real"     dimensions="nCells"/>
-                <var name="ol2"                                  type="real"     dimensions="nCells"/>
-                <var name="ol3"                                  type="real"     dimensions="nCells"/>
-                <var name="ol4"                                  type="real"     dimensions="nCells"/>
+                <var name="var2d" type="real" dimensions="nCells" units="m^{2}"
+                     description="variance of orography"/>
+
+                <var name="con" type="real" dimensions="nCells" units="m^{2}"
+                     description="convexity of orography"/>
+
+                <var name="oa1" type="real" dimensions="nCells" units="unitless"
+                     description="directional asymmetry function of orography"/>
+
+                <var name="oa2" type="real" dimensions="nCells" units="unitless"
+                     description="directional asymmetry function of orography"/>
+
+                <var name="oa3" type="real" dimensions="nCells" units="unitless"
+                     description="directional asymmetry function of orography"/>
+
+                <var name="oa4" type="real" dimensions="nCells" units="unitless"
+                     description="directional asymmetry function of orography"/>
+
+                <var name="ol1" type="real" dimensions="nCells" units="unitless"
+                     description="directional asymmetry function of orography"/>
+
+                <var name="ol2" type="real" dimensions="nCells" units="unitless"
+                     description="directional asymmetry function of orography"/>
+
+                <var name="ol3" type="real" dimensions="nCells" units="unitles"
+                     description="directional asymmetry function of orography"/>
+
+                <var name="ol4" type="real" dimensions="nCells" units="unitless"
+                     description="directional asymmetry function of orography"/>
 
                 <!-- description of the vertical grid structure -->
-                <var name="hx"                         type="real"     dimensions="nVertLevelsP1 nCells"/>
-                <var name="zgrid"                      type="real"     dimensions="nVertLevelsP1 nCells"/>
-                <var name="rdzw"                       type="real"     dimensions="nVertLevels"/>
-                <var name="dzu"                        type="real"     dimensions="nVertLevels"/>
-                <var name="rdzu"                       type="real"     dimensions="nVertLevels"/>
-                <var name="fzm"                        type="real"     dimensions="nVertLevels"/>
-                <var name="fzp"                        type="real"     dimensions="nVertLevels"/>
-                <var name="zxu"                        type="real"     dimensions="nVertLevels nEdges"/>
-                <var name="zz"                         type="real"     dimensions="nVertLevels nCells"/>
-                <var name="zb"                         type="real"     dimensions="nVertLevelsP1 TWO nEdges"/>
-                <var name="zb3"                        type="real"     dimensions="nVertLevelsP1 TWO nEdges"/>
+                <var name="hx" type="real" dimensions="nVertLevelsP1 nCells" units="m"
+                     description="terrain influence in vertical coordinate, $h_s(x,y,\zeta)$ in Klemp (MWR 2011)"/>
+
+                <var name="zgrid" type="real" dimensions="nVertLevelsP1 nCells" units="m MSL"
+                     description="Geometric height of layer interfaces"/>
+
+                <var name="rdzw" type="real" dimensions="nVertLevels" units="unitless"
+                     description="Reciprocal dzw"/>
+
+                <var name="dzu" type="real" dimensions="nVertLevels" units="unitless"
+                     description="d(zeta) at w levels"/>
+
+                <var name="rdzu" type="real" dimensions="nVertLevels" units="unitless"
+                     description="Reciprocal dzu"/>
+
+                <var name="fzm" type="real" dimensions="nVertLevels" units="unitless"
+                     description="Weight for linear interpolation to w(k) point for u(k) level variable"/>
+
+                <var name="fzp" type="real" dimensions="nVertLevels" units="unitless"
+                     description="Weight for linear interpolation to w(k) point for u(k-1) level variable"/>
+
+                <var name="zxu" type="real" dimensions="nVertLevels nEdges" units="unitless"
+                     description="dz/dx on horizontal coordinate surfaces at u levels"/>
+
+                <var name="zz" type="real" dimensions="nVertLevels nCells" units="unitless"
+                     description="d(zeta)/dz, vertical metric term"/>
+
+                <var name="zb" type="real" dimensions="nVertLevelsP1 TWO nEdges" units="unitless"
+                     description="Coefficients for contribution from u to omega diagnosis, edge-oriented"/>
+
+                <var name="zb3" type="real" dimensions="nVertLevelsP1 TWO nEdges" units="unitless"
+                     description="Coefficients for 3rd-order correction to contribution from u to omega diagnosis, edge-oriented"/>
 
                 <!-- W-Rayleigh damping coefficient -->
-                <var name="dss"                        type="real"     dimensions="nVertLevels nCells"/>
+                <var name="dss" type="real" dimensions="nVertLevels nCells" units="unitless"
+                     description="w-damping coefficient"/>
 
-                <var name="u_init"                     type="real"     dimensions="nVertLevels"/>
-                <var name="t_init"                     type="real"     dimensions="nVertLevels nCells"/>
-                <var name="qv_init"                    type="real"     dimensions="nVertLevels"/>
+                <var name="u_init" type="real" dimensions="nVertLevels" units="m s^{-1}"
+                     description="u reference profile"/>
+
+                <var name="v_init" type="real" dimensions="nVertLevels" units="m s^{-1}"
+                     description="v reference profile"/>
+
+                <var name="t_init" type="real" dimensions="nVertLevels nCells" units="K"
+                     description="theta reference profile"/>
+
+                <var name="qv_init" type="real" dimensions="nVertLevels" units="kg kg^{-1}"
+                     description="qv reference profile"/>
 
                 <!-- variables needed for advection -->
-                <var name="deriv_two"                  type="real"     dimensions="FIFTEEN TWO nEdges"/>
-                <var name="advCells"                   type="integer"  dimensions="TWENTYONE nCells"/>
+                <var name="deriv_two" type="real" dimensions="FIFTEEN TWO nEdges" units="unitless"
+                     description="weights for cell-centered second derivative, normal to edge, for transport scheme"/>
+
+                <var name="advCells" type="integer" dimensions="TWENTYONE nCells" units="-"
+                     description="cells used in least squares fit of polynomial for advection"/>
 
                 <!-- deformation calculation weights -->
-                <var name="defc_a"                     type="real"     dimensions="maxEdges nCells"/>
-                <var name="defc_b"                     type="real"     dimensions="maxEdges nCells"/>
+                <var name="defc_a" type="real" dimensions="maxEdges nCells" units="unitless"
+                     description="Coefficients for computing the off-diagonal components of the horizontal deformation"/>
+
+                <var name="defc_b" type="real" dimensions="maxEdges nCells" units="unitless"
+                     description="Coefficients for computing the diagonal components of the horizontal deformation"/>
 
                 <!-- arrays required for reconstruction of velocity field -->
-                <var name="coeffs_reconstruct"         type="real"     dimensions="R3 maxEdges nCells"/>
+                <var name="coeffs_reconstruct" type="real" dimensions="R3 maxEdges nCells" units="unitless"
+                     description="Coefficients to reconstruct velocity vectors at cell centers"/>
+
+                <var name="bdyMaskCell" type="integer" dimensions="nCells" default_value="0" units="-"
+                     description="Indicator of whether a cell is an interior cell, a relaxation-zone cell, or a specified-zone cell"/>
+
+                <var name="bdyMaskEdge" type="integer" dimensions="nEdges" default_value="0" units="-"
+                     description="Indicator of whether an edge is an interior edge, a relaxation-zone edge, or a specified-zone edge"/>
+
+                <var name="bdyMaskVertex" type="integer" dimensions="nVertices" default_value="0" units="-"
+                     description="Indicator of whether an vertex is an interior vertex, a relaxation-zone vertex, or a specified-zone vertex"/>
         </var_struct>
 
         <var_struct name="state" time_levs="1">
                 <var name="initial_time" type="text" dimensions="" units="YYYY-MM-DD_hh:mm:ss"
                      description="Model initialization time"/>
-                <var name="xtime"                      type="text"     dimensions="Time"/>
-                <var name="u"                          type="real"     dimensions="nVertLevels nEdges Time"/>
-                <var name="w"                          type="real"     dimensions="nVertLevelsP1 nCells Time"/>
-                <var name="rho_zz"                     type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="theta_m"                    type="real"     dimensions="nVertLevels nCells Time"/>
+
+                <var name="xtime" type="text" dimensions="Time" units="YYYY-MM-DD_hh:mm:ss"
+                     description="Model valid time"/>
+
+                <var name="u" type="real" dimensions="nVertLevels nEdges Time" units="m s^{-1}"
+                     description="Horizontal normal velocity at edges"/>
+
+                <var name="w" type="real" dimensions="nVertLevelsP1 nCells Time" units="m s^{-1}"
+                     description="Vertical velocity at vertical cell faces"/>
+
+                <var name="rho_zz" type="real" dimensions="nVertLevels nCells Time" units="kg m^{-3}"
+                     description="Dry air density divided by d(zeta)/dz"/>
+
+                <var name="theta_m" type="real" dimensions="nVertLevels nCells Time" units="K"
+                     description="Moist potential temperature: theta*(1+q_v*R_v/R_d)"/>
 
                 <var_array name="scalars" type="real" dimensions="nVertLevels nCells Time">
-                        <var name="qv"      array_group="moist"/>
-                        <var name="qc"      array_group="moist"/>
-                        <var name="qr"      array_group="moist"/>
+                        <var name="qv" array_group="moist" units="kg kg^{-1}"
+                             description="Water vapor mixing ratio"/>
+
+                        <var name="qc" array_group="moist" units="kg kg^{-1}"
+                             description="Cloud water mixing ratio"/>
+
+                        <var name="qr" array_group="moist" units="kg kg^{-1}"
+                             description="Rain water mixing ratio"/>
                 </var_array>
 
                 <!-- Climatology for ocean mixed-layer depth -->
-                <var name="h_oml_initial"              type="real"     dimensions="nCells Time"/>
+                <var name="h_oml_initial" type="real" dimensions="nCells Time" units="m"
+                     description="Initial depth of ocean mix layer"/>
+        </var_struct>
+
+        <var_struct name="lbc_state" time_levs="1">
+                <var name="lbc_u" type="real" dimensions="nVertLevels nEdges Time" packages="lbcs"
+                     units="m s^{-1}"
+                     description="Horizontal normal velocity on domain lateral boundary edges"/>
+
+                <var name="lbc_w" type="real" dimensions="nVertLevelsP1 nCells Time" packages="lbcs"
+                     units="m s^{-1}"
+                     description="Vertical velocity on domain lateral boundary vertical cell faces"/>
+
+                <var name="lbc_rho" type="real" dimensions="nVertLevels nCells Time" packages="lbcs"
+                     units="kg m^{-3}"
+                     description="Dry air density on lateral boundary cells"/>
+
+                <var name="lbc_theta" type="real" dimensions="nVertLevels nCells Time" packages="lbcs"
+                     units="K"
+                     description="Potential temperature on lateral boundary cells"/>
+
+                <var_array name="lbc_scalars" type="real" dimensions="nVertLevels nCells Time" packages="lbcs">
+                        <var name="lbc_qv" array_group="moist" units="kg kg^{-1}"
+                             description="Water vapor mixing ratio on lateral boundary cells"/>
+
+                        <var name="lbc_qc" array_group="moist" units="kg kg^{-1}"
+                             description="Cloud water mixing ratio on lateral boundary cells"/>
+
+                        <var name="lbc_qr" array_group="moist" units="kg kg^{-1}"
+                             description="Rain water mixing ratio on lateral boundary cells"/>
+                </var_array>
+
         </var_struct>
 
         <var_struct name="fg" time_levs="1">
-                
+
                 <!-- horizontally interpolated from first-guess data -->
-                <var name="u_fg"       name_in_code="u"       type="real"     dimensions="nFGLevels nEdges Time"/>
-                <var name="v_fg"       name_in_code="v"       type="real"     dimensions="nFGLevels nEdges Time"/>
-                <var name="t_fg"       name_in_code="t"       type="real"     dimensions="nFGLevels nCells Time"/>
-                <var name="p_fg"       name_in_code="p"       type="real"     dimensions="nFGLevels nCells Time"/>
-                <var name="z_fg"       name_in_code="z"       type="real"     dimensions="nFGLevels nCells Time"/>
-                <var name="rh_fg"      name_in_code="rh"      type="real"     dimensions="nFGLevels nCells Time"/>
-                <var name="sh_fg"      name_in_code="sh"      type="real"     dimensions="nFGLevels nCells Time"/>
-                <var name="soilz_fg"   name_in_code="soilz"   type="real"     dimensions="nCells Time"/>
-                <var name="psfc_fg"    name_in_code="psfc"    type="real"     dimensions="nCells Time"/>
-                <var name="pmsl_fg"    name_in_code="pmsl"    type="real"     dimensions="nCells Time"/>
-                <var name="dz_fg"                             type="real"     dimensions="nFGSoilLevels nCells Time"/>
-                <var name="dzs_fg"                            type="real"     dimensions="nFGSoilLevels nCells Time"/>
-                <var name="zs_fg"                             type="real"     dimensions="nFGSoilLevels nCells Time"/>
-                <var name="st_fg"                             type="real"     dimensions="nFGSoilLevels nCells Time"/>
-                <var name="sm_fg"                             type="real"     dimensions="nFGSoilLevels nCells Time"/>
+                <var name="u_fg" name_in_code="u" type="real" dimensions="nFGLevels nEdges Time" units="m s^{-1}"
+                     description="First guess zonal wind component"/>
+
+                <var name="v_fg" name_in_code="v" type="real" dimensions="nFGLevels nEdges Time" units="m s^{-1}"
+                     description="First guess merdian wind component"/>
+
+                <var name="t_fg" name_in_code="t" type="real" dimensions="nFGLevels nCells Time" units="K"
+                     description="First guess temperature"/>
+
+                <var name="p_fg" name_in_code="p" type="real" dimensions="nFGLevels nCells Time" units="Pa"
+                     description="First guess pressure"/>
+
+                <var name="z_fg" name_in_code="z" type="real" dimensions="nFGLevels nCells Time" units="m"
+                     description="First guess geopotential height"/>
+
+                <var name="rh_fg" name_in_code="rh" type="real" dimensions="nFGLevels nCells Time" units="percent"
+                     description="First guess relative humidity with respect to liquid water"/>
+
+                <var name="sh_fg" name_in_code="sh" type="real" dimensions="nFGLevels nCells Time" units="kg kg^{-1}"
+                     description="First guess specific humidity"/>
+
+                <var name="soilz_fg" name_in_code="soilz" type="real" dimensions="nCells Time" units="m"
+                     description="First guess soil height"/>
+
+                <var name="psfc_fg" name_in_code="psfc" type="real" dimensions="nCells Time" units="Pa"
+                     description="First guess surface pressure"/>
+
+                <var name="pmsl_fg" name_in_code="pmsl" type="real" dimensions="nCells Time" units="Pa"
+                     description="First guess mean sea level pressure"/>
+
+                <var name="dz_fg" type="real" dimensions="nFGSoilLevels nCells Time" units="cm"
+                     description="First guess depth of soil layer bottom"/>
+
+                <var name="dzs_fg" type="real" dimensions="nFGSoilLevels nCells Time" units="cm"
+                     description="First guess soil layer thickness"/>
+
+                <var name="zs_fg" type="real" dimensions="nFGSoilLevels nCells Time" units="cm"
+                     description="First guess depth of centers of soil levels"/>
+
+                <var name="st_fg" type="real" dimensions="nFGSoilLevels nCells Time" units="k"
+                     description="First guess soil temperature"/>
+
+                <var name="sm_fg" type="real" dimensions="nFGSoilLevels nCells Time" units="m^{3} m^{-3}"
+                     description="First guess soil moisture"/>
 
                 <!-- horizontally interpolated from first-guess data, and should be read in by model -->
-                <var name="dz"                                type="real"     dimensions="nSoilLevels nCells Time"/>
-                <var name="dzs"                               type="real"     dimensions="nSoilLevels nCells Time"/>
-                <var name="zs"                                type="real"     dimensions="nSoilLevels nCells Time"/>
-                <var name="sh2o"                              type="real"     dimensions="nSoilLevels nCells Time"/>
-                <var name="smois"                             type="real"     dimensions="nSoilLevels nCells Time"/>
-                <var name="tslb"                              type="real"     dimensions="nSoilLevels nCells Time"/>
-                <var name="smcrel"                            type="real"     dimensions="nSoilLevels nCells Time"/>
-                <var name="tmn"                               type="real"     dimensions="nCells Time"/>
-                <var name="skintemp"                          type="real"     dimensions="nCells Time"/>
-                <var name="sst"                               type="real"     dimensions="nCells Time"/>
-                <var name="snow"                              type="real"     dimensions="nCells Time"/>
-                <var name="snowc"                             type="real"     dimensions="nCells Time"/>
-                <var name="snowh"                             type="real"     dimensions="nCells Time"/>
-                <var name="xice"                              type="real"     dimensions="nCells Time"/>
-                <var name="seaice"                            type="real"     dimensions="nCells Time"/>
-                <var name="gfs_z"                             type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="vegfra"                            type="real"     dimensions="nCells Time"/>
-                <var name="sfc_albbck"                        type="real"     dimensions="nCells Time"/>
-                <var name="xland"                             type="real"     dimensions="nCells Time"/>
+                <var name="dz" type="real" dimensions="nSoilLevels nCells Time" units="m"
+                     description="depth of soil layer bottom"/>
+
+                <var name="dzs" type="real" dimensions="nSoilLevels nCells Time" units="m"
+                     description="soil layer thickness"/>
+
+                <var name="zs" type="real" dimensions="nSoilLevels nCells Time" units="m"
+                     description="depth of centers of soil layers"/>
+
+                <var name="sh2o" type="real" dimensions="nSoilLevels nCells Time" units="m3 m^{-3}"
+                     description="soil equivalent liquid water "/>
+
+                <var name="smois" type="real" dimensions="nSoilLevels nCells Time" units="m3 m^{-3}"
+                     description="soil moisture"/>
+
+                <var name="tslb" type="real" dimensions="nSoilLevels nCells Time" units="K"
+                     description="soil layer temperature"/>
+
+                <var name="smcrel" type="real" dimensions="nSoilLevels nCells Time" units="m3 m^{-3}"
+                     description="soil moisture threshold below which transpiration begins to stress"/>
+
+                <var name="tmn" type="real" dimensions="nCells Time" units="K"
+                     description="deep soil temperature"/>
+
+                <var name="skintemp" type="real" dimensions="nCells Time" units="K"
+                     description="ground or water surface temperature"/>
+
+                <var name="sst" type="real" dimensions="nCells Time" units="K"
+                     description="sea-surface temperature"/>
+
+                <var name="snow" type="real" dimensions="nCells Time" units="kg m^{-2}"
+                     description="snow water equivalent"/>
+
+                <var name="snowc" type="real" dimensions="nCells Time" units="unitless"
+                     description="flag for snow on ground (=0 no snow; =1,otherwise"/>
+
+                <var name="snowh" type="real" dimensions="nCells Time" units="m"
+                     description="physical snow depth"/>
+
+                <var name="xice" type="real" dimensions="nCells Time" units="unitless"
+                     description="fractional area coverage of sea-ice"/>
+
+                <var name="seaice" type="real" dimensions="nCells Time" units="unitless"
+                     description="sea-ice flag (0=no seaice; =1 otherwise)"/>
+
+                <var name="gfs_z" type="real" dimensions="nVertLevels nCells Time" units="m"
+                     description="geopotential height vertically interpolated from first guess"/>
+
+                <var name="vegfra" type="real" dimensions="nCells Time" units="unitless"
+                     description="vegetation fraction"/>
+
+                <var name="sfc_albbck" type="real" dimensions="nCells Time" units="unitless"
+                     description="background surface albedo"/>
+
+                <var name="xland" type="real" dimensions="nCells Time" units="unitless"
+                     description="land-ocean mask (1=land including sea-ice ; 2=ocean)"/>
 
                 <!-- diagnostic fields that we get from first-guess data, and which we want to have at model initial output time -->
-                <var name="u10"                               type="real"     dimensions="nCells Time"/>
-                <var name="v10"                               type="real"     dimensions="nCells Time"/>
-                <var name="q2"                                type="real"     dimensions="nCells Time"/>
-                <var name="rh2"                               type="real"     dimensions="nCells Time"/>
-                <var name="t2m"                               type="real"     dimensions="nCells Time"/>
+                <var name="u10" type="real" dimensions="nCells Time" units="m s^{-1}"
+                     description="10-meter zonal wind"/>
+
+                <var name="v10" type="real" dimensions="nCells Time" units="m s^{-1}"
+                     description="10-meter meridional wind"/>
+
+                <var name="q2" type="real" dimensions="nCells Time" units="kg kg^{-1}"
+                     description="2-meter specific humidity"/>
+
+                <var name="rh2" type="real" dimensions="nCells Time" units="percent"
+                     description="2-meter relative humidity"/>
+
+                <var name="t2m" type="real" dimensions="nCells Time" units="K"
+                     description="2-meter temperature"/>
+
         </var_struct>
 
         <var_struct name="diag" time_levs="1">
-                <var name="pressure_p"                        type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="rho"                               type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="theta"                             type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="v"                                 type="real"     dimensions="nVertLevels nEdges Time"/>
-                <var name="relhum"                            type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="spechum"                           type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="uReconstructX"                     type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="uReconstructY"                     type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="uReconstructZ"                     type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="uReconstructZonal"                 type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="uReconstructMeridional"            type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="exner"                             type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="exner_base"                        type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="rtheta_base"                       type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="pressure"                          type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="pressure_base"                     type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="rho_base"                          type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="theta_base"                        type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="cqw"                               type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="surface_pressure"                  type="real"     dimensions="nCells Time"/>
+                <var name="pressure_p" type="real" dimensions="nVertLevels nCells Time" units="Pa"
+                     description="Perturbation pressure"/>
+
+                <var name="rho" type="real" dimensions="nVertLevels nCells Time" units="kg m^{-3}"
+                     description="Dry air density"/>
+
+                <var name="theta" type="real" dimensions="nVertLevels nCells Time" units="K"
+                     description="Potential temperature"/>
+
+                <var name="v" type="real" dimensions="nVertLevels nEdges Time" units="m s^{-1}"
+                     description="Horizontal tangential velocity at edges"/>
+
+                <var name="relhum" type="real" dimensions="nVertLevels nCells Time" units="percent"
+                     description="Relative humidity"/>
+
+                <var name="spechum" type="real" dimensions="nVertLevels nCells Time" units="kg kg^{-1}"
+                     description="Specific humidity"/>
+
+                <!-- reconstructed horizontal velocity vectors at cell centers -->
+                <var name="uReconstructX" type="real" dimensions="nVertLevels nCells Time" units="m s^{-1}"
+                     description="Cartesian x-component of reconstructed horizontal velocity at cell centers"/>
+
+                <var name="uReconstructY" type="real" dimensions="nVertLevels nCells Time" units="m s^{-1}"
+                     description="Cartesian y-component of reconstructed horizontal velocity at cell centers"/>
+
+                <var name="uReconstructZ" type="real" dimensions="nVertLevels nCells Time" units="m s^{-1}"
+                     description="Cartesian z-component of reconstructed horizontal velocity at cell centers"/>
+
+                <var name="uReconstructZonal" type="real" dimensions="nVertLevels nCells Time" units="m s^{-1}"
+                     description="Zonal component of reconstructed horizontal velocity at cell centers"/>
+
+                <var name="uReconstructMeridional" type="real" dimensions="nVertLevels nCells Time" units="m s^{-1}"
+                     description="Meridional component of reconstructed horizontal velocity at cell centers"/>
+
+                <var name="exner" type="real" dimensions="nVertLevels nCells Time" units="unitless"
+                     description="Exner function"/>
+
+                <var name="exner_base" type="real" dimensions="nVertLevels nCells Time" units="unitless"
+                     description="Base-state Exner function"/>
+
+                <var name="rtheta_base" type="real" dimensions="nVertLevels nCells Time" units="kg K m^{-3}"
+                     description="reference state rho*theta/zz"/>
+
+                <var name="pressure" type="real" dimensions="nVertLevels nCells Time" units="Pa"
+                     description="Pressure"/>
+
+                <var name="pressure_base" type="real" dimensions="nVertLevels nCells Time" units="Pa"
+                     description="Base state pressure"/>
+
+                <var name="rho_base" type="real" dimensions="nVertLevels nCells Time" units="kg m^{-3}"
+                     description="Base state dry air density"/>
+
+                <var name="theta_base" type="real" dimensions="nVertLevels nCells Time" units="K"
+                     description="Base state potential temperature"/>
+
+                <var name="cqw" type="real" dimensions="nVertLevels nCells Time" units="unitless"
+                     description="rho_d/rho_m at w points"/>
+
+                <var name="surface_pressure" type="real" dimensions="nCells Time" units="Pa"
+                     description="Diagnosed surface pressure"/>
 
                 <!-- coupled variables needed by the solver, but not output -->
-                <var name="ru"                                type="real"     dimensions="nVertLevels nEdges Time"/>
-                <var name="rw"                                type="real"     dimensions="nVertLevelsP1 nCells Time"/>
-                <var name="rtheta_p"                          type="real"     dimensions="nVertLevels nCells Time"/>
-                <var name="rho_p"                             type="real"     dimensions="nVertLevels nCells Time"/>
+                <var name="ru" type="real" dimensions="nVertLevels nEdges Time" units="kg m^{-2} s^{-1}"
+                     description="horizontal momentum at cell edge (rho*u/zz)"/>
+
+                <var name="rw" type="real" dimensions="nVertLevelsP1 nCells Time" units="kg m^{-2} s^{-1}"
+                     description="rho*omega/zz carried at w points"/>
+
+                <var name="rtheta_p" type="real" dimensions="nVertLevels nCells Time" units="kg K m^{-3}"
+                     description="rho*theta_m/zz perturbation from the reference state value"/>
+
+                <var name="rho_p" type="real" dimensions="nVertLevels nCells Time" units="kg m^{-3}"
+                     description="rho/zz perturbation from the reference state value, advanced over acoustic steps"/>
         </var_struct>
 
         <var_struct name="diag_physics" time_levs="1">
-                <var name="precipw"                           type="real"     dimensions="nCells Time"/>
+                <var name="precipw" type="real" dimensions="nCells Time" units="kg m^{-2}"
+                     description="precipitable water"/>
         </var_struct>
 </registry>
diff --git a/src/core_init_atmosphere/mpas_init_atm_cases.F b/src/core_init_atmosphere/mpas_init_atm_cases.F
index 25b2b9719d..e08d55e48e 100644
--- a/src/core_init_atmosphere/mpas_init_atm_cases.F
+++ b/src/core_init_atmosphere/mpas_init_atm_cases.F
@@ -60,43 +60,37 @@ subroutine init_atm_setup_case(domain, stream_manager)
       type (mpas_pool_type), pointer :: state
       type (mpas_pool_type), pointer :: diag
       type (mpas_pool_type), pointer :: diag_physics
+      type (mpas_pool_type), pointer :: lbc_state
 
       integer, pointer :: config_init_case
       logical, pointer :: config_static_interp
       logical, pointer :: config_native_gwd_static
       logical, pointer :: config_met_interp
+      logical, pointer :: config_blend_bdy_terrain
+      character (len=StrKIND), pointer :: config_start_time
+      character (len=StrKIND), pointer :: config_met_prefix
 
       character(len=StrKIND), pointer :: mminlu
+      character(len=StrKIND), pointer :: xtime
+
+      type (MPAS_Time_type)  :: curr_time, stop_time
+      type (MPAS_TimeInterval_type)  :: clock_interval, lbc_stream_interval
+      character(len=StrKIND) :: timeString
 
       integer, pointer :: nCells
       integer, pointer :: nEdges
       integer, pointer :: nVertLevels
 
-
-      call mpas_pool_get_config(domain % blocklist % configs, 'config_init_case', config_init_case)
-
-      !
-      ! Do some quick checks to make sure compile options are compatible with the chosen test case
-      !
-      if (config_init_case == 6) then
-#ifndef ROTATED_GRID
-         call mpas_log_write('*****************************************************************',  messageType=MPAS_LOG_ERR)
-         call mpas_log_write('To initialize and run the mountain wave test case (case 6),',        messageType=MPAS_LOG_ERR)
-         call mpas_log_write('   please clean and re-compile init_atmosphere with -DROTATED_GRID', messageType=MPAS_LOG_ERR)
-         call mpas_log_write('   added to the specification of MODEL_FORMULATION',                 messageType=MPAS_LOG_ERR)
-         call mpas_log_write('   at the top of the Makefile.',                                     messageType=MPAS_LOG_ERR)
-         call mpas_log_write('*****************************************************************',  messageType=MPAS_LOG_CRIT)
-#endif
-      else
-#ifdef ROTATED_GRID
-         call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_ERR)
-         call mpas_log_write('Only test case 6 should use code compiled with -DROTATED_GRID',     messageType=MPAS_LOG_ERR)
-         call mpas_log_write('   specified in the Makefile.',                                     messageType=MPAS_LOG_ERR)
-         call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_CRIT)
-#endif
-      end if
+      ! The next four variables are needed in the argument list for blend_bdy_terrain
+      ! with the dryrun argument set to true; accordingly, we never actually need to
+      ! set these pointers to fields
+      real (kind=RKIND), dimension(:), pointer :: latCell
+      real (kind=RKIND), dimension(:), pointer :: lonCell
+      real (kind=RKIND), dimension(:), pointer :: ter
+      integer, dimension(:), pointer :: bdyMaskCell
 
 
+      call mpas_pool_get_config(domain % blocklist % configs, 'config_init_case', config_init_case)
 
       if ((config_init_case == 1) .or. (config_init_case == 2) .or. (config_init_case == 3)) then
 
@@ -177,6 +171,7 @@ subroutine init_atm_setup_case(domain, stream_manager)
             call mpas_pool_get_config(block_ptr % configs, 'config_static_interp', config_static_interp)
             call mpas_pool_get_config(block_ptr % configs, 'config_native_gwd_static', config_native_gwd_static)
             call mpas_pool_get_config(block_ptr % configs, 'config_met_interp', config_met_interp)
+            call mpas_pool_get_config(block_ptr % configs, 'config_blend_bdy_terrain', config_blend_bdy_terrain)
 
             call mpas_pool_get_subpool(block_ptr % structs, 'mesh', mesh)
             call mpas_pool_get_subpool(block_ptr % structs, 'fg', fg)
@@ -188,6 +183,29 @@ subroutine init_atm_setup_case(domain, stream_manager)
             call mpas_pool_get_dimension(block_ptr % dimensions, 'nEdges', nEdges)
             call mpas_pool_get_dimension(block_ptr % dimensions, 'nVertLevels', nVertLevels)
 
+            !
+            ! Before proceeding with any other processing that takes non-trivial time (e.g., static field interpolation),
+            ! check that the intermediate file with terrain information exists if config_blend_bdy_terrain = true.
+            !
+            ! NB: When calling blend_bdy_terrain(...) with the 'dryrun' argument set, the nCells, latCell, lonCell,
+            !     bdyMaskCell, and ter arguments are not used -- only the config_met_prefix and config_start_time
+            !     arguments are used.
+            !
+            if (config_blend_bdy_terrain) then
+                call mpas_pool_get_config(block_ptr % configs, 'config_start_time', config_start_time)
+                call mpas_pool_get_config(block_ptr % configs, 'config_met_prefix', config_met_prefix)
+
+                call blend_bdy_terrain(config_met_prefix, config_start_time, &
+                                       nCells, latCell, lonCell, bdyMaskCell, ter, .true., ierr)
+                if (ierr /= 0) then
+                    call mpas_log_write('*************************************************************', messageType=MPAS_LOG_ERR)
+                    call mpas_log_write('Blending of terrain along domain boundaries would fail, and', messageType=MPAS_LOG_ERR)
+                    call mpas_log_write('config_blend_bdy_terrain = true in the namelist.init_atmosphere file.', &
+                                        messageType=MPAS_LOG_ERR)
+                    call mpas_log_write('*************************************************************', messageType=MPAS_LOG_CRIT)
+                end if
+            end if
+
             if (config_static_interp) then
 
                !  
@@ -204,7 +222,6 @@ subroutine init_atm_setup_case(domain, stream_manager)
                end if
 
                call init_atm_static(mesh, block_ptr % dimensions, block_ptr % configs)
-               call init_atm_static_orogwd(mesh, block_ptr % dimensions, block_ptr % configs)
             end if
 
             if (config_native_gwd_static) then
@@ -258,10 +275,72 @@ subroutine init_atm_setup_case(domain, stream_manager)
             block_ptr => block_ptr % next
          end do
 
+      else if (config_init_case == 9 ) then
+
+         call mpas_log_write('Lateral boundary conditions case')
+
+         !
+         ! Check that the first-guess interval (which is the same as the clock timestep)
+         ! matches the output interval of the 'lbc' stream
+         !
+         clock_interval = mpas_get_clock_timestep(domain % clock, ierr=ierr)
+         lbc_stream_interval = MPAS_stream_mgr_get_stream_interval(stream_manager, 'lbc', MPAS_STREAM_OUTPUT, ierr)
+         if (clock_interval /= lbc_stream_interval) then
+            call mpas_log_write('****************************************************************',   messageType=MPAS_LOG_ERR)
+            call mpas_log_write('The intermediate file interval specified by ''config_fg_interval''', messageType=MPAS_LOG_ERR)
+            call mpas_log_write('does not match the output_interval for the ''lbc'' stream.',         messageType=MPAS_LOG_ERR)
+            call mpas_log_write('Please correct the namelist.init_atmosphere and/or',                 messageType=MPAS_LOG_ERR)
+            call mpas_log_write('streams.init_atmosphere files.',                                     messageType=MPAS_LOG_ERR)
+            call mpas_log_write('****************************************************************',   messageType=MPAS_LOG_CRIT)
+         end if
+
+         curr_time = mpas_get_clock_time(domain % clock, MPAS_NOW)
+         stop_time = mpas_get_clock_time(domain % clock, MPAS_STOP_TIME)
+
+         do while (curr_time <= stop_time)
+
+            block_ptr => domain % blocklist
+            do while (associated(block_ptr))
+               call mpas_pool_get_subpool(block_ptr % structs, 'mesh', mesh)
+               call mpas_pool_get_subpool(block_ptr % structs, 'fg', fg)
+               call mpas_pool_get_subpool(block_ptr % structs, 'state', state)
+               call mpas_pool_get_subpool(block_ptr % structs, 'diag', diag)
+               call mpas_pool_get_subpool(block_ptr % structs, 'lbc_state', lbc_state)
+
+               call mpas_pool_get_array(state, 'xtime', xtime)
+
+               call mpas_pool_get_dimension(block_ptr % dimensions, 'nCells', nCells)
+               call mpas_pool_get_dimension(block_ptr % dimensions, 'nEdges', nEdges)
+               call mpas_pool_get_dimension(block_ptr % dimensions, 'nVertLevels', nVertLevels)
+
+               call mpas_get_time(curr_time, dateTimeString=timeString)
+               xtime = timeString   ! Set field valid time, xtime, to the current time in the time loop
+
+               call init_atm_case_lbc(timeString, block_ptr, mesh, nCells, nEdges, nVertLevels, fg, state, &
+                                      diag, lbc_state, block_ptr % dimensions, block_ptr % configs)
+
+               block_ptr => block_ptr % next
+            end do
+
+            call mpas_stream_mgr_write(stream_manager, streamID='lbc', ierr=ierr)
+            call mpas_stream_mgr_reset_alarms(stream_manager, streamID='lbc', direction=MPAS_STREAM_OUTPUT, ierr=ierr)
+
+            call mpas_advance_clock(domain % clock)
+            curr_time = mpas_get_clock_time(domain % clock, MPAS_NOW)
+
+         end do
+
+         !
+         ! Ensure that no output alarms are still ringing for the 'lbc' stream after
+         ! we exit the time loop above; the main run routine may write out all other
+         ! output streams with ringing alarms.
+         !
+         call mpas_stream_mgr_reset_alarms(stream_manager, streamID='lbc', direction=MPAS_STREAM_OUTPUT, ierr=ierr)
+
       else
 
          call mpas_log_write(' ****************************************************', messageType=MPAS_LOG_ERR)
-         call mpas_log_write(' Only test cases 1 through 8 are currently supported.', messageType=MPAS_LOG_ERR)
+         call mpas_log_write(' Only test cases 1 through 9 are currently supported.', messageType=MPAS_LOG_ERR)
          call mpas_log_write(' ****************************************************', messageType=MPAS_LOG_CRIT)
 
       end if
@@ -967,16 +1046,19 @@ subroutine init_atm_case_jw(mesh, nCells, nVertLevels, state, diag, configs, tes
          cell1 = cellsOnEdge(1,iEdge)
          cell2 = cellsOnEdge(2,iEdge)
 
-         do k = 1, nVertLevels
+         
+         ! Avoid a potential divide by zero below if areaCell(nCells+1) is used in the denominator
+         if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve ) then
+            do k = 1, nVertLevels
 
-            if (config_theta_adv_order == 2) then
+               if (config_theta_adv_order == 2) then
 
-               z_edge = (zgrid(k,cell1)+zgrid(k,cell2))/2.
+                  z_edge = (zgrid(k,cell1)+zgrid(k,cell2))/2.
 
-            else if (config_theta_adv_order == 3 .or. config_theta_adv_order ==4) then !theta_adv_order == 3 or 4 
+               else if (config_theta_adv_order == 3 .or. config_theta_adv_order ==4) then !theta_adv_order == 3 or 4 
 
-               d2fdx2_cell1 = deriv_two(1,1,iEdge) * zgrid(k,cell1)
-               d2fdx2_cell2 = deriv_two(1,2,iEdge) * zgrid(k,cell2)
+                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * zgrid(k,cell1)
+                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * zgrid(k,cell2)
 
 !  WCS fix 20120711
 
@@ -989,23 +1071,24 @@ subroutine init_atm_case_jw(mesh, nCells, nVertLevels, state, diag, configs, tes
                      d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * zgrid(k,cellsOnCell(i,cell2))
                   end do             
 
-               z_edge =  0.5*(zgrid(k,cell1) + zgrid(k,cell2))         &
-                             - (dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.
+                  z_edge =  0.5*(zgrid(k,cell1) + zgrid(k,cell2))         &
+                                - (dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.
+
+                  if (config_theta_adv_order == 3) then
+                     z_edge3 =  - (dcEdge(iEdge) **2) * (d2fdx2_cell1 - d2fdx2_cell2) / 12.
+                  else
+                     z_edge3 = 0.
+                  end if
 
-               if (config_theta_adv_order == 3) then
-                  z_edge3 =  - (dcEdge(iEdge) **2) * (d2fdx2_cell1 - d2fdx2_cell2) / 12.
-               else
-                  z_edge3 = 0.
                end if
 
-            end if
-
                zb(k,1,iEdge) = (z_edge-zgrid(k,cell1))*dvEdge(iEdge)/areaCell(cell1)
                zb(k,2,iEdge) = (z_edge-zgrid(k,cell2))*dvEdge(iEdge)/areaCell(cell2)
                zb3(k,1,iEdge)=  z_edge3*dvEdge(iEdge)/areaCell(cell1)
                zb3(k,2,iEdge)=  z_edge3*dvEdge(iEdge)/areaCell(cell2)
 
-         end do
+            end do
+         end if
 
       end do
 
@@ -1857,7 +1940,7 @@ subroutine init_atm_case_mtn_wave(dminfo, mesh, nCells, nVertLevels, state, diag
       real (kind=RKIND), dimension(nVertLevels ) :: zu, dzw, rdzwp, rdzwm
 
       real (kind=RKIND) :: d1, d2, d3, cof1, cof2
-      real (kind=RKIND) :: um, us,  rcp, rcv
+      real (kind=RKIND) :: um, vm,rcp, rcv
       real (kind=RKIND) :: xmid, temp, pres, a_scale
 
       real (kind=RKIND) :: xi, xa, xc, xla, zinv, xn2, xn2m, xn2l, sm, dzh, dzht, dzmin, z_edge, z_edge3 
@@ -1879,7 +1962,7 @@ subroutine init_atm_case_mtn_wave(dminfo, mesh, nCells, nVertLevels, state, diag
       real (kind=RKIND), pointer :: cf1, cf2, cf3
 
       real (kind=RKIND), dimension(:,:), pointer :: t_init, w, rw, v, rho, theta
-      real (kind=RKIND), dimension(:), pointer :: u_init, angleEdge, fEdge, fVertex
+      real (kind=RKIND), dimension(:), pointer :: u_init, v_init, angleEdge, fEdge, fVertex
 
 
       call mpas_pool_get_array(mesh, 'xCell', xCell)
@@ -1912,6 +1995,7 @@ subroutine init_atm_case_mtn_wave(dminfo, mesh, nCells, nVertLevels, state, diag
       call mpas_pool_get_array(mesh, 'deriv_two', deriv_two)
       call mpas_pool_get_array(mesh, 't_init', t_init)
       call mpas_pool_get_array(mesh, 'u_init', u_init)
+      call mpas_pool_get_array(mesh, 'v_init', v_init)
       call mpas_pool_get_array(mesh, 'angleEdge', angleEdge)
       call mpas_pool_get_array(mesh, 'fEdge', fEdge)
       call mpas_pool_get_array(mesh, 'fVertex', fVertex)
@@ -2160,8 +2244,13 @@ subroutine init_atm_case_mtn_wave(dminfo, mesh, nCells, nVertLevels, state, diag
          xn2m = 0.0000
          xn2l = 0.0001
 
-         um = 10.
-         us = 0.
+         vm = 10.
+         um = 0.
+
+         do k=1,nz1
+           v_init(k) = vm
+           u_init(k) = um
+         end do
 
          do i=1,nCells
             do k=1,nz1
@@ -2185,13 +2274,7 @@ subroutine init_atm_case_mtn_wave(dminfo, mesh, nCells, nVertLevels, state, diag
             do k=1,nz1
                ztemp = .25*( zgrid(k,cell1 )+zgrid(k+1,cell1 )  &
                             +zgrid(k,cell2)+zgrid(k+1,cell2))
-               u(k,i) = um
-               if(i == 1 ) u_init(k) = u(k,i) - us
-#ifdef ROTATED_GRID
-               u(k,i) = sin(angleEdge(i)) * (u(k,i) - us)
-#else
-               u(k,i) = cos(angleEdge(i)) * (u(k,i) - us)
-#endif
+               u(k,i) =   vm*sin(angleEdge(i)) + um*cos(angleEdge(i))
             end do
             end if
          end do
@@ -2518,6 +2601,7 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state
       real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell 
       real (kind=RKIND), dimension(:,:), pointer :: v
       real (kind=RKIND), dimension(:,:), pointer :: sorted_arr
+      integer, dimension(:), pointer :: bdyMaskCell
 
       type (field1DReal), pointer :: tempField
       type (field1DReal), pointer :: ter_field
@@ -2557,6 +2641,7 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state
       real (kind=RKIND), dimension(nVertLevels + 1) :: hyai, hybi, znu, znw, znwc, znwv, hyam, hybm
       real (kind=RKIND), dimension(nVertLevels + 1) :: znuc, znuv, bn, divh, dpn
 
+      real (kind=RKIND), dimension(:), pointer :: specified_zw
       real (kind=RKIND), dimension(nVertLevels + 1) :: sh, zw, ah
       real (kind=RKIND), dimension(nVertLevels) :: zu, dzw, rdzwp, rdzwm
       real (kind=RKIND), dimension(nVertLevels) :: eta, etav, teta, ppi, tt
@@ -2587,12 +2672,14 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state
       real (kind=RKIND), pointer :: config_dzmin
       real (kind=RKIND), pointer :: config_ztop
       logical, pointer :: config_tc_vertical_grid
+      character (len=StrKIND), pointer :: config_specified_zeta_levels
       logical, pointer :: config_use_spechumd
       integer, pointer :: config_nfglevels
       integer, pointer :: config_nfgsoillevels
       logical, pointer :: config_smooth_surfaces
       integer, pointer :: config_theta_adv_order
       real (kind=RKIND), pointer :: config_coef_3rd_order
+      logical, pointer :: config_blend_bdy_terrain
 
       character (len=StrKIND), pointer :: config_extrap_airtemp
       integer :: extrap_airtemp
@@ -2662,12 +2749,14 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state
       call mpas_pool_get_config(configs, 'config_dzmin', config_dzmin)
       call mpas_pool_get_config(configs, 'config_ztop', config_ztop)
       call mpas_pool_get_config(configs, 'config_tc_vertical_grid', config_tc_vertical_grid)
+      call mpas_pool_get_config(configs, 'config_specified_zeta_levels', config_specified_zeta_levels)
       call mpas_pool_get_config(configs, 'config_use_spechumd', config_use_spechumd)
       call mpas_pool_get_config(configs, 'config_nfglevels', config_nfglevels)
       call mpas_pool_get_config(configs, 'config_nfgsoillevels', config_nfgsoillevels)
       call mpas_pool_get_config(configs, 'config_smooth_surfaces', config_smooth_surfaces)
       call mpas_pool_get_config(configs, 'config_theta_adv_order', config_theta_adv_order)
       call mpas_pool_get_config(configs, 'config_coef_3rd_order', config_coef_3rd_order)
+      call mpas_pool_get_config(configs, 'config_blend_bdy_terrain', config_blend_bdy_terrain)
       
       call mpas_pool_get_config(configs, 'config_extrap_airtemp', config_extrap_airtemp)
       if (trim(config_extrap_airtemp) == 'constant') then
@@ -2790,100 +2879,23 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state
 
       scalars(:,:,:) = 0.
 
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! BEGIN ADOPT GFS TERRAIN HEIGHT
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-#if 0
-      call read_met_init(trim(config_met_prefix), .false., config_start_time(1:13), istatus)
-
-      if (istatus /= 0) then
-         call mpas_log_write('********************************************************************************', messageType=MPAS_LOG_ERR)
-         call mpas_log_write('Error opening initial meteorological data file ' &
-                                      //trim(config_met_prefix)//':'//config_start_time(1:13),                   messageType=MPAS_LOG_ERR)
-         call mpas_log_write('********************************************************************************', messageType=MPAS_LOG_CRIT)
-      end if
-
-      call read_next_met_field(field, istatus)
-      do while (istatus == 0)
-         if (trim(field % field) == 'SOILHGT') then
-
-
-            call mpas_log_write('USING ECMWF TERRAIN...')
-
-            interp_list(1) = FOUR_POINT
-            interp_list(2) = SEARCH
-            interp_list(3) = 0
-
-            !
-            ! Set up projection
-            !
-            call map_init(proj)
-          
-            if (field % iproj == PROJ_LATLON) then
-               call map_set(PROJ_LATLON, proj, &
-                            latinc = real(field % deltalat,RKIND), &
-                            loninc = real(field % deltalon,RKIND), &
-                            knowni = 1.0_RKIND, &
-                            knownj = 1.0_RKIND, &
-                            lat1 = real(field % startlat,RKIND), &
-                            lon1 = real(field % startlon,RKIND))
-            end if
-
-
-            if (trim(field % field) == 'SOILHGT') then
-               nInterpPoints = nCells
-               latPoints => latCell
-               lonPoints => lonCell
-               destField1d => ter
-               ndims = 1
-            end if
-
-            allocate(rslab(-2:field % nx+3, field % ny))
-            rslab(1:field % nx, 1:field % ny) = field % slab(1:field % nx, 1:field % ny)
-            rslab(0, 1:field % ny)  = field % slab(field % nx, 1:field % ny)
-            rslab(-1, 1:field % ny) = field % slab(field % nx-1, 1:field % ny)
-            rslab(-2, 1:field % ny) = field % slab(field % nx-2, 1:field % ny)
-            rslab(field % nx+1, 1:field % ny) = field % slab(1, 1:field % ny)
-            rslab(field % nx+2, 1:field % ny) = field % slab(2, 1:field % ny)
-            rslab(field % nx+3, 1:field % ny) = field % slab(3, 1:field % ny)
-
-            do i=1,nInterpPoints
-               lat = latPoints(i)*DEG_PER_RAD
-               lon = lonPoints(i)*DEG_PER_RAD
-               call latlon_to_ij(proj, lat, lon, x, y)
-               if (x < 0.5) then
-                  lon = lon + 360.0
-                  call latlon_to_ij(proj, lat, lon, x, y)
-               else if (x >= real(field%nx)+0.5) then
-                  lon = lon - 360.0
-                  call latlon_to_ij(proj, lat, lon, x, y)
-               end if
-               if (y < 0.5) then
-                  y = 1.0
-               else if (y >= real(field%ny)+0.5) then
-                  y = real(field%ny)
-               end if
-               if (ndims == 1) then
-                  destField1d(i) = interp_sequence(x, y, 1, rslab, -2, field % nx + 3, 1, field % ny, 1, 1, -1.e30_RKIND, interp_list, 1)
-               else if (ndims == 2) then
-                  destField2d(k,i) = interp_sequence(x, y, 1, rslab, -2, field % nx + 3, 1, field % ny, 1, 1, -1.e30_RKIND, interp_list, 1)
-               end if
-            end do
 
-            deallocate(rslab)
+      !
+      ! If requested, blend the terrain along the domain boundaries with terrain from
+      ! an intermediate file. For global domains, this routine will have no effect even
+      ! if called, since terrain is only blended for cells with bdyMaskCell > 0.
+      !
+      if (config_blend_bdy_terrain) then
+         call mpas_pool_get_array(mesh, 'bdyMaskCell', bdyMaskCell)
+         call mpas_pool_get_array(mesh, 'ter', ter)
+
+         call blend_bdy_terrain(config_met_prefix, config_start_time, nCells, latCell, lonCell, bdyMaskCell, ter, .false., istatus)
+         if (istatus /= 0) then
+             call mpas_log_write('*************************************************************', messageType=MPAS_LOG_ERR)
+             call mpas_log_write('* Blending of terrain along domain boundaries failed!       *', messageType=MPAS_LOG_ERR)
+             call mpas_log_write('*************************************************************', messageType=MPAS_LOG_CRIT)
          end if
-   
-         deallocate(field % slab)
-         call read_next_met_field(field, istatus)
-      end do
-
-      call read_met_close()
-#endif
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! END ADOPT GFS TERRAIN HEIGHT
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      end if
 
 
       if (config_vertical_grid) then
@@ -2904,6 +2916,14 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state
             hs(iCell) = 0.
             if(ter(iCell) .ne. 0.) then
                do j = 1,nEdgesOnCell(iCell)
+
+                  ! For smoothing at cells along the boundary of the mesh, set the terrain value
+                  ! for non-existent neighbors, which map to the "garbage cell", to the same as
+                  ! the terrain in the cell being smoothed
+                  if (cellsOnCell(j,iCell) == nCells+1) then
+                     ter(nCells+1) = ter(iCell)
+                  end if
+
                   hs(iCell) = hs(iCell) + dvEdge(edgesOnCell(j,iCell))    &
                                         / dcEdge(edgesOnCell(j,iCell))    &
                                         * (ter(cellsOnCell(j,iCell))-ter(iCell))
@@ -2916,6 +2936,14 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state
             ter(iCell) = 0.
             if(hs(iCell) .ne. 0.) then
                do j = 1,nEdgesOnCell(iCell)
+
+                  ! For smoothing at cells along the boundary of the mesh, set the terrain value
+                  ! for non-existent neighbors, which map to the "garbage cell", to the same as
+                  ! the terrain in the cell being smoothed
+                  if (cellsOnCell(j,iCell) == nCells+1) then
+                     hs(nCells+1) = hs(iCell)
+                  end if
+
                   ter(iCell) = ter(iCell) + dvEdge(edgesOnCell(j,iCell))    &
                                           / dcEdge(edgesOnCell(j,iCell))    &
                                           * (hs(cellsOnCell(j,iCell))-hs(iCell))
@@ -2940,7 +2968,37 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state
 
 !     Metrics for hybrid coordinate and vertical stretching
 
-      if (config_tc_vertical_grid) then
+      !
+      ! If a the name of a file with vertical coordinate values has been specified,
+      ! use those values to setup the vertical grid
+      !
+      if (len_trim(config_specified_zeta_levels) > 0) then
+
+         call mpas_log_write('Setting up vertical grid using levels from '''//trim(config_specified_zeta_levels)//'''')
+
+         if (read_text_array(dminfo, trim(config_specified_zeta_levels), specified_zw) /= 0) then
+            call mpas_log_write('Failed to read vertical levels from '''//trim(config_specified_zeta_levels)//'''', &
+                                 messageType=MPAS_LOG_CRIT)
+         end if
+
+         if (size(specified_zw) /= nz) then
+            call mpas_log_write('In the namelist.init_atmosphere file, config_nvertlevels = $i, but ', intArgs=(/nz1/), &
+                                 messageType=MPAS_LOG_ERR)
+            call mpas_log_write('but '''//trim(config_specified_zeta_levels)//''' has $i values.', intArgs=(/size(specified_zw)/), &
+                                 messageType=MPAS_LOG_ERR)
+            call mpas_log_write(''''//trim(config_specified_zeta_levels)//''' must contain nVertLevels+1 ($i) values.', intArgs=(/nz/), &
+                                 messageType=MPAS_LOG_CRIT)
+         end if
+
+         zw(:) = specified_zw(:)
+         zt = zw(nz)
+
+         deallocate(specified_zw)
+
+      !
+      ! Otherwise, see if the user has requested to set up the vertical grid as in the MPAS TC configuration
+      !
+      else if (config_tc_vertical_grid) then
 
          call mpas_log_write('Setting up vertical levels as in 2014 TC experiments')
 
@@ -2986,6 +3044,9 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state
             if (k > 1) dzw(k-1) = zw(k)-zw(k-1)
          end do
 
+      !
+      ! Otherwise, use the vertical level configuration from MPAS v2.0
+      !
       else
 
          call mpas_log_write('Setting up vertical levels as in MPAS 2.0 and earlier')
@@ -3069,8 +3130,6 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state
 !      cf3 = d1*d2*(d2-d1)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
 
 
-      call mpas_log_write(' cf1, cf2, cf3 = ', realArgs=(/cf1,cf2,cf3/))
-
 !     Smoothing algorithm for coordinate surfaces 
 
       smooth = config_smooth_surfaces
@@ -3102,19 +3161,18 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state
                   hs1(iCell) = 0.
                   do j = 1,nEdgesOnCell(iCell)
 
+                     ! For smoothing at cells along the boundary of the mesh, set the hx value
+                     ! for non-existent neighbors, which map to the "garbage cell", to the same as
+                     ! the hx in the cell being smoothed
+                     if (cellsOnCell(j,iCell) == nCells+1) then
+                        hx(k,nCells+1) = hx(k,iCell)
+                     end if
+
                      hs1(iCell) = hs1(iCell) + dvEdge(edgesOnCell(j,iCell))    &
                                            / dcEdge(edgesOnCell(j,iCell))    &
                                            *  (hx(k,cellsOnCell(j,iCell))-hx(k,iCell))
                   end do
-                  hs1(iCell) = hx(k,iCell) + sm*hs1(iCell)
-
-                  hs(iCell) = 0.
-              !    do j = 1,nEdgesOnCell(iCell)
-              !       hs(iCell) = hs(iCell) + dvEdge(edgesOnCell(j,iCell))    &
-              !                             / dcEdge(edgesOnCell(j,iCell))    &
-              !                             *  (hs1(cellsOnCell(j,iCell))-hs1(iCell))
-              !    end do
-                  hs(iCell) = hs1(iCell) - 0.*hs(iCell)
+                  hs(iCell) = hx(k,iCell) + sm*hs1(iCell)
 
                end do
 
@@ -3196,6 +3254,15 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state
       do iEdge = 1,nEdges
          cell1 = cellsOnEdge(1,iEdge)
          cell2 = cellsOnEdge(2,iEdge)
+
+         ! Avoid referencing the garbage cell for exterior edges
+         if (cell1 == nCells+1) then
+            cell1 = cell2
+         end if
+         if (cell2 == nCells+1) then
+            cell2 = cell1
+         end if
+
          if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve ) then
 
             do k = 1, nVertLevels
@@ -4662,6 +4729,14 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state
          enddo
       endif
 
+      !
+      ! After RH has been used to compute qv (unless config_use_spechumd = T and a valid spechum field
+      ! is available), modify the RH field to be with respect to ice for temperatures below freezing.
+      ! NB: Here we pass in 1:nCells explicitly, since computations involving the "garbage cell" could
+      ! trigger FPEs.
+      !
+      call convert_relhum_wrt_ice(t(:,1:nCells), relhum(:,1:nCells))
+
       !
       ! Diagnose fields needed in initial conditions file (u, w, rho, theta)
       ! NB: At this point, "rho_zz" is simple dry density, and "theta_m" is regular potential temperature
@@ -4848,76 +4923,877 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state
    end subroutine init_atm_case_gfs
 
 
-   integer function nearest_edge(target_lat, target_lon, &
-                                 start_edge, &
-                                 nCells, nEdges, maxEdges, nEdgesOnCell, edgesOnCell, cellsOnEdge, latCell, lonCell, latEdge, lonEdge)
+   !-----------------------------------------------------------------------
+   !  routine init_atm_case_lbc
+   !
+   !> \brief Computes lbc_{rho,theta,u,w,qx} fields for lateral boundary conditions
+   !> \author Michael Duda
+   !> \date   22 April 2019
+   !> \details
+   !>  This routine is similar to the init_atm_case_gfs routine in that it reads
+   !>  atmospheric fields from "intermediate" files and horizontally and vertically
+   !>  interpolates them to an MPAS mesh. However, rather than producing model
+   !>  initial conditions, this routine is responsible for producing only those
+   !>  fields that are needed as model lateral boundary conditions.
+   !
+   !-----------------------------------------------------------------------
+   subroutine init_atm_case_lbc(timestamp, block, mesh, nCells, nEdges, nVertLevels, fg, state, diag, lbc_state, dims, configs)
 
-      implicit none
+      use mpas_dmpar, only : mpas_dmpar_min_real, mpas_dmpar_max_real
+      use init_atm_read_met, only : met_data, read_met_init, read_met_close, read_next_met_field
+      use init_atm_llxy, only : proj_info, map_init, map_set, latlon_to_ij, PROJ_LATLON, PROJ_GAUSS, DEG_PER_RAD
+      use init_atm_hinterp, only : interp_sequence, FOUR_POINT, SIXTEEN_POINT, W_AVERAGE4, SEARCH
+      use mpas_hash, only : hashtable, mpas_hash_init, mpas_hash_destroy, mpas_hash_search, mpas_hash_size, mpas_hash_insert
 
-      real (kind=RKIND), intent(in) :: target_lat, target_lon
-      integer, intent(in) :: start_edge
-      integer, intent(in) :: nCells, nEdges, maxEdges
-      integer, dimension(nCells), intent(in) :: nEdgesOnCell
-      integer, dimension(maxEdges,nCells), intent(in) :: edgesOnCell
-      integer, dimension(2,nEdges), intent(in) :: cellsOnEdge
-      real (kind=RKIND), dimension(nCells), intent(in) :: latCell, lonCell
-      real (kind=RKIND), dimension(nEdges), intent(in) :: latEdge, lonEdge
+      implicit none
 
-      integer :: i, cell1, cell2, iCell
-      integer :: iEdge
-      integer :: current_edge
-      real (kind=RKIND) :: cell1_dist, cell2_dist
-      real (kind=RKIND) :: current_distance, d
-      real (kind=RKIND) :: nearest_distance
+      character(len=*), intent(in) :: timestamp
+      type (block_type), intent(inout), target :: block
+      type (mpas_pool_type), intent(inout) :: mesh
+      integer, intent(in) :: nCells
+      integer, intent(in) :: nEdges
+      integer, intent(in) :: nVertLevels
+      type (mpas_pool_type), intent(inout) :: fg
+      type (mpas_pool_type), intent(inout) :: state
+      type (mpas_pool_type), intent(inout) :: diag
+      type (mpas_pool_type), intent(inout) :: lbc_state
+      type (mpas_pool_type), intent(inout):: dims
+      type (mpas_pool_type), intent(inout):: configs
 
-      nearest_edge = start_edge
-      current_edge = -1
+      type (dm_info), pointer :: dminfo
 
-      do while (nearest_edge /= current_edge)
-         current_edge = nearest_edge
-         current_distance = sphere_distance(latEdge(current_edge), lonEdge(current_edge), target_lat, target_lon, 1.0_RKIND)
-         nearest_edge = current_edge
-         nearest_distance = current_distance
-         cell1 = cellsOnEdge(1,current_edge)
-         cell2 = cellsOnEdge(2,current_edge)
-         cell1_dist = sphere_distance(latCell(cell1), lonCell(cell1), target_lat, target_lon, 1.0_RKIND)
-         cell2_dist = sphere_distance(latCell(cell2), lonCell(cell2), target_lat, target_lon, 1.0_RKIND)
-         if (cell1_dist < cell2_dist) then
-            iCell = cell1
-         else
-            iCell = cell2
-         end if
-         do i = 1, nEdgesOnCell(iCell)
-            iEdge = edgesOnCell(i,iCell)
-            if (iEdge <= nEdges) then
-               d = sphere_distance(latEdge(iEdge), lonEdge(iEdge), target_lat, target_lon, 1.0_RKIND)
-               if (d < nearest_distance) then
-                  nearest_edge = iEdge
-                  nearest_distance = d
-               end if
-            end if
-         end do
-      end do
+      real (kind=RKIND), parameter :: t0b = 250.0
 
-   end function nearest_edge
+      type (met_data) :: field
+      type (proj_info) :: proj
 
+      real (kind=RKIND), dimension(:), pointer :: dzu, fzm, fzp
+      real (kind=RKIND), dimension(:), pointer :: vert_level, latPoints, lonPoints
+      real (kind=RKIND), dimension(:,:), pointer :: zgrid, zz
+      real (kind=RKIND), dimension(:,:), pointer :: pressure, ppb, pb, rho_zz, rb, rr, tb, rtb, p, pp, t, rt
+      real (kind=RKIND), dimension(:), pointer :: destField1d
+      real (kind=RKIND), dimension(:,:), pointer :: destField2d
+      real (kind=RKIND), dimension(:,:,:), pointer :: zb, zb3
+      real (kind=RKIND), dimension(:,:,:), pointer :: scalars
 
-   real (kind=RKIND) function vertical_interp(target_z, nz, zf, order, extrap, surface_val, sealev_val, ierr)
+      real (kind=RKIND) :: target_z
+      integer :: iCell, iEdge, i, k, nVertLevelsP1
+      integer, pointer :: nCellsSolve
+      integer :: nInterpPoints, ndims
 
-      implicit none
+      integer :: nfglevels_actual
+      integer, pointer :: index_qv
 
-      real (kind=RKIND), intent(in) :: target_z
-      integer, intent(in) :: nz 
-      real (kind=RKIND), dimension(2,nz), intent(in) :: zf      ! zf(1,:) is column of vertical coordinate values, zf(2,:) is column of field values
-      integer, intent(in), optional :: order
-      integer, intent(in), optional :: extrap                   ! can take values 0 = constant, 1 = linear (default), 2 = lapse-rate
-      real (kind=RKIND), intent(in), optional :: surface_val
-      real (kind=RKIND), intent(in), optional :: sealev_val
-      integer, intent(out), optional :: ierr
-      
-      integer :: k, lm, lp
-      real (kind=RKIND) :: wm, wp
-      real (kind=RKIND) :: slope
+      integer, dimension(5) :: interp_list
+      real (kind=RKIND) :: msgval
+
+      integer, dimension(:), pointer :: nEdgesOnCell
+      integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell
+      real (kind=RKIND), dimension(:,:), pointer :: sorted_arr
+
+      integer :: sfc_k
+
+      integer :: it
+      real (kind=RKIND) :: p_check
+
+      integer :: istatus
+
+      real (kind=RKIND), allocatable, dimension(:,:) :: rslab
+
+      real (kind=RKIND) :: flux
+      real (kind=RKIND) :: lat, lon, x, y
+
+      real (kind=RKIND) :: p0
+
+      real (kind=RKIND) :: etavs, ztemp
+
+      real (kind=RKIND) :: rs, rcv
+
+      real (kind=RKIND), dimension(nVertLevels + 1) :: sh
+
+      !  calculation of the water vapor mixing ratio:
+      real (kind=RKIND) :: sh_max,sh_min,global_sh_max,global_sh_min
+
+      character (len=StrKIND), pointer :: config_met_prefix
+      logical, pointer :: config_use_spechumd
+      integer, pointer :: config_nfglevels
+      integer, pointer :: config_theta_adv_order
+      real (kind=RKIND), pointer :: config_coef_3rd_order
+
+      character (len=StrKIND), pointer :: config_extrap_airtemp
+      integer :: extrap_airtemp
+
+      real (kind=RKIND), dimension(:), pointer :: latCell, lonCell
+      real (kind=RKIND), dimension(:), pointer :: latEdge, lonEdge
+      real (kind=RKIND), dimension(:), pointer :: angleEdge
+
+      real (kind=RKIND), dimension(:,:), pointer :: u
+      real (kind=RKIND), dimension(:,:), pointer :: w
+      real (kind=RKIND), dimension(:,:), pointer :: theta
+      real (kind=RKIND), dimension(:,:), pointer :: rho
+      real (kind=RKIND), dimension(:,:), pointer :: relhum
+      real (kind=RKIND), dimension(:,:), pointer :: spechum
+      real (kind=RKIND), dimension(:,:), pointer :: ru
+      real (kind=RKIND), dimension(:,:), pointer :: rw
+
+      real (kind=RKIND), dimension(:,:), pointer :: u_fg
+      real (kind=RKIND), dimension(:,:), pointer :: v_fg
+      real (kind=RKIND), dimension(:,:), pointer :: z_fg
+      real (kind=RKIND), dimension(:,:), pointer :: t_fg
+      real (kind=RKIND), dimension(:,:), pointer :: rh_fg
+      real (kind=RKIND), dimension(:,:), pointer :: sh_fg
+      real (kind=RKIND), dimension(:,:), pointer :: p_fg
+      real (kind=RKIND), dimension(:), pointer :: soilz
+
+      type (hashtable) :: level_hash
+      logical :: too_many_fg_levs
+      integer :: level_value
+
+      character (len=StrKIND) :: errstring
+
+      real (kind=RKIND) :: max_zgrid_local, max_zgrid_global
+
+
+      call mpas_log_write('Interpolating LBCs at time '//trim(timestamp))
+
+      call mpas_pool_get_config(configs, 'config_met_prefix', config_met_prefix)
+      call mpas_pool_get_config(configs, 'config_use_spechumd', config_use_spechumd)
+      call mpas_pool_get_config(configs, 'config_nfglevels', config_nfglevels)
+      call mpas_pool_get_config(configs, 'config_theta_adv_order', config_theta_adv_order)
+      call mpas_pool_get_config(configs, 'config_coef_3rd_order', config_coef_3rd_order)
+
+      call mpas_pool_get_config(configs, 'config_extrap_airtemp', config_extrap_airtemp)
+      if (trim(config_extrap_airtemp) == 'constant') then
+         extrap_airtemp = 0
+      else if (trim(config_extrap_airtemp) == 'linear') then
+         extrap_airtemp = 1
+      else if (trim(config_extrap_airtemp) == 'lapse-rate') then
+         extrap_airtemp = 2
+      else
+          call mpas_log_write('*************************************************************', messageType=MPAS_LOG_ERR)
+          call mpas_log_write('* Invalid value for namelist variable config_extrap_airtemp *', messageType=MPAS_LOG_ERR)
+          call mpas_log_write('*************************************************************', messageType=MPAS_LOG_CRIT)
+      end if
+      call mpas_log_write("Using option '" // trim(config_extrap_airtemp) // "' for vertical extrapolation of temperature")
+
+      dminfo => block % domain % dminfo
+
+      call mpas_pool_get_array(mesh, 'nEdgesOnCell', nEdgesOnCell)
+      call mpas_pool_get_array(mesh, 'edgesOnCell', edgesOnCell)
+      call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge)
+      call mpas_pool_get_array(mesh, 'angleEdge', angleEdge)
+
+      call mpas_pool_get_array(mesh, 'zb', zb)
+      call mpas_pool_get_array(mesh, 'zb3', zb3)
+
+      call mpas_pool_get_array(mesh, 'zgrid', zgrid)
+      call mpas_pool_get_array(mesh, 'dzu', dzu)
+      call mpas_pool_get_array(mesh, 'fzm', fzm)
+      call mpas_pool_get_array(mesh, 'fzp', fzp)
+      call mpas_pool_get_array(mesh, 'zz', zz)
+
+      call mpas_pool_get_array(diag, 'exner_base', pb)
+      call mpas_pool_get_array(diag, 'rho_base', rb)
+      call mpas_pool_get_array(diag, 'theta_base', tb)
+      call mpas_pool_get_array(diag, 'rtheta_base', rtb)
+      call mpas_pool_get_array(diag, 'exner', p)
+      call mpas_pool_get_array(diag, 'pressure_base', ppb)
+      call mpas_pool_get_array(diag, 'pressure_p', pp)
+      call mpas_pool_get_array(diag, 'pressure', pressure)
+      call mpas_pool_get_array(diag, 'relhum', relhum)
+      call mpas_pool_get_array(diag, 'spechum', spechum)
+      call mpas_pool_get_array(diag, 'ru', ru)
+      call mpas_pool_get_array(diag, 'rw', rw)
+
+      call mpas_pool_get_array(state, 'rho_zz', rho_zz)
+      call mpas_pool_get_array(diag, 'rho_p', rr)
+      call mpas_pool_get_array(state, 'theta_m', t)
+      call mpas_pool_get_array(diag, 'rtheta_p', rt)
+      call mpas_pool_get_array(lbc_state, 'lbc_scalars', scalars)
+      call mpas_pool_get_array(lbc_state, 'lbc_u', u)
+      call mpas_pool_get_array(lbc_state, 'lbc_w', w)
+      call mpas_pool_get_array(lbc_state, 'lbc_theta', theta)
+      call mpas_pool_get_array(lbc_state, 'lbc_rho', rho)
+
+      call mpas_pool_get_array(mesh, 'latCell', latCell)
+      call mpas_pool_get_array(mesh, 'lonCell', lonCell)
+      call mpas_pool_get_array(mesh, 'latEdge', latEdge)
+      call mpas_pool_get_array(mesh, 'lonEdge', lonEdge)
+
+      call mpas_pool_get_array(fg, 'u', u_fg)
+      call mpas_pool_get_array(fg, 'v', v_fg)
+      call mpas_pool_get_array(fg, 'z', z_fg)
+      call mpas_pool_get_array(fg, 't', t_fg)
+      call mpas_pool_get_array(fg, 'rh', rh_fg)
+      call mpas_pool_get_array(fg, 'sh', sh_fg)
+      call mpas_pool_get_array(fg, 'p', p_fg)
+
+      call mpas_pool_get_dimension(dims, 'nCellsSolve', nCellsSolve)
+      nVertLevelsP1 = nVertLevels + 1
+
+      call mpas_pool_get_dimension(state, 'index_qv', index_qv)
+
+      etavs = (1.0_RKIND - 0.252_RKIND) * pii / 2.0_RKIND
+      rcv = rgas / (cp - rgas)
+      p0 = 1.0e+05_RKIND
+
+      scalars(:,:,:) = 0.0_RKIND
+
+      !
+      ! Check that we have what looks like a valid zgrid field. If the max value for zgrid is zero,
+      ! the input file likely does not contain vertical grid information.
+      !
+      max_zgrid_local = maxval(zgrid(:,1:nCellsSolve))
+      call mpas_dmpar_max_real(dminfo, max_zgrid_local, max_zgrid_global)
+      if (max_zgrid_global == 0.0_RKIND) then
+         call mpas_log_write('********************************************************************************', &
+                             messageType=MPAS_LOG_ERR)
+         call mpas_log_write('The maximum value of the zgrid field is 0. Please ensure that the ''input'' stream ', &
+                             messageType=MPAS_LOG_ERR)
+         call mpas_log_write('contains valid vertical grid information.', &
+                             messageType=MPAS_LOG_ERR)
+         call mpas_log_write('********************************************************************************', &
+                             messageType=MPAS_LOG_CRIT)
+      end if
+
+
+      !
+      ! Horizontally interpolate meteorological data
+      !
+      allocate(vert_level(config_nfglevels))
+      vert_level(:) = -1.0
+
+      ! TODO: We should check that timestamp is actually of length >= 13
+      call read_met_init(trim(config_met_prefix), .false., timestamp(1:13), istatus)
+
+      if (istatus /= 0) then
+         call mpas_log_write('********************************************************************************', &
+                             messageType=MPAS_LOG_ERR)
+         call mpas_log_write('Error opening initial meteorological data file '//trim(config_met_prefix)//':'//timestamp(1:13), &
+                             messageType=MPAS_LOG_ERR)
+         call mpas_log_write('********************************************************************************', &
+                             messageType=MPAS_LOG_CRIT)
+      end if
+
+      call mpas_hash_init(level_hash)
+      too_many_fg_levs = .false.
+
+      call read_next_met_field(field, istatus)
+
+      do while (istatus == 0)
+
+         interp_list(1) = FOUR_POINT
+         interp_list(2) = SEARCH
+         interp_list(3) = 0
+
+         msgval = -1.e30
+
+         if (trim(field % field) == 'UU' .or. &
+             trim(field % field) == 'VV' .or. &
+             trim(field % field) == 'TT' .or. &
+             trim(field % field) == 'RH' .or. &
+             trim(field % field) == 'SPECHUMD' .or. &
+             trim(field % field) == 'GHT' .or. &
+             trim(field % field) == 'SOILHGT' .or. &
+             trim(field % field) == 'PRES' .or. &
+             trim(field % field) == 'PRESSURE') then
+
+            if (trim(field % field) /= 'SOILHGT') then
+
+               ! Since the hash table can only store integers, transfer the bit pattern from
+               ! the real-valued xlvl into an integer; that the result is not an integer version
+               ! of the level is not important, since we only want to test uniqueness of levels
+               level_value = transfer(field % xlvl, level_value)
+               if (.not. mpas_hash_search(level_hash, level_value)) then
+                  call mpas_hash_insert(level_hash, level_value)
+                  if (mpas_hash_size(level_hash) > config_nfglevels) then
+                     too_many_fg_levs = .true.
+                  end if
+               end if
+
+               !
+               ! In case we have more than config_nfglevels levels, just keep cycling through
+               ! the remaining fields in the intermediate file for the purpose of counting how
+               ! many unique levels are found using the code above
+               !
+               if (too_many_fg_levs) then
+                  call read_next_met_field(field, istatus)
+                  cycle
+               end if
+
+               do k=1,config_nfglevels
+                  if (vert_level(k) == field % xlvl .or. vert_level(k) == -1.0) exit
+               end do
+               if (vert_level(k) == -1.0) vert_level(k) = field % xlvl
+            else
+               k = 1
+            end if
+
+            !
+            ! Set up projection
+            !
+            call map_init(proj)
+
+            if (field % iproj == PROJ_LATLON) then
+               call map_set(PROJ_LATLON, proj, &
+                            latinc = real(field % deltalat,RKIND), &
+                            loninc = real(field % deltalon,RKIND), &
+                            knowni = 1.0_RKIND, &
+                            knownj = 1.0_RKIND, &
+                            lat1 = real(field % startlat,RKIND), &
+                            lon1 = real(field % startlon,RKIND))
+            else if (field % iproj == PROJ_GAUSS) then
+               call map_set(PROJ_GAUSS, proj, &
+                            nlat = nint(field % deltalat), &
+                            loninc = 360.0_RKIND / real(field % nx,RKIND), &
+                            lat1 = real(field % startlat,RKIND), &
+                            lon1 = real(field % startlon,RKIND))
+            end if
+
+
+            !
+            ! Horizontally interpolate the field at level k
+            !
+            if (trim(field % field) == 'UU') then
+               call mpas_log_write('Interpolating U at $i $r', intArgs=(/k/), realArgs=(/vert_level(k)/))
+               nInterpPoints = nEdges
+               latPoints => latEdge
+               lonPoints => lonEdge
+               call mpas_pool_get_array(fg, 'u', destField2d)
+               ndims = 2
+            else if (trim(field % field) == 'VV') then
+               call mpas_log_write('Interpolating V at $i $r', intArgs=(/k/), realArgs=(/vert_level(k)/))
+               nInterpPoints = nEdges
+               latPoints => latEdge
+               lonPoints => lonEdge
+               call mpas_pool_get_array(fg, 'v', destField2d)
+               ndims = 2
+            else if (trim(field % field) == 'TT') then
+               call mpas_log_write('Interpolating TT at $i $r', intArgs=(/k/), realArgs=(/vert_level(k)/))
+               nInterpPoints = nCells
+               latPoints => latCell
+               lonPoints => lonCell
+               call mpas_pool_get_array(fg, 't', destField2d)
+               ndims = 2
+            else if (trim(field % field) == 'RH') then
+               call mpas_log_write('Interpolating RH at $i $r', intArgs=(/k/), realArgs=(/vert_level(k)/))
+               nInterpPoints = nCells
+               latPoints => latCell
+               lonPoints => lonCell
+               call mpas_pool_get_array(fg, 'rh', destField2d)
+               ndims = 2
+            else if (trim(field % field) == 'SPECHUMD') then
+               call mpas_log_write('Interpolating SPECHUMD at $i $r', intArgs=(/k/), realArgs=(/vert_level(k)/))
+               nInterpPoints = nCells
+               latPoints => latCell
+               lonPoints => lonCell
+               call mpas_pool_get_array(fg, 'sh', destField2d)
+               ndims = 2
+            else if (trim(field % field) == 'GHT') then
+               call mpas_log_write('Interpolating GHT at $i $r', intArgs=(/k/), realArgs=(/vert_level(k)/))
+               nInterpPoints = nCells
+               latPoints => latCell
+               lonPoints => lonCell
+               call mpas_pool_get_array(fg, 'z', destField2d)
+               ndims = 2
+            else if (trim(field % field) == 'PRES') then
+               call mpas_log_write('Interpolating PRES at $i $r', intArgs=(/k/), realArgs=(/vert_level(k)/))
+               nInterpPoints = nCells
+               latPoints => latCell
+               lonPoints => lonCell
+               call mpas_pool_get_array(fg, 'p', destField2d)
+               ndims = 2
+            else if (trim(field % field) == 'PRESSURE') then
+               call mpas_log_write('Interpolating PRESSURE at $i $r', intArgs=(/k/), realArgs=(/vert_level(k)/))
+               nInterpPoints = nCells
+               latPoints => latCell
+               lonPoints => lonCell
+               call mpas_pool_get_array(fg, 'p', destField2d)
+               ndims = 2
+            else if (trim(field % field) == 'SOILHGT') then
+               call mpas_log_write('Interpolating SOILHGT')
+               nInterpPoints = nCells
+               latPoints => latCell
+               lonPoints => lonCell
+               call mpas_pool_get_array(fg, 'soilz', destField1d)
+               ndims = 1
+            end if
+
+            allocate(rslab(-2:field % nx+3, field % ny))
+            rslab(1:field % nx, 1:field % ny) = field % slab(1:field % nx, 1:field % ny)
+            rslab(0, 1:field % ny)  = field % slab(field % nx, 1:field % ny)
+            rslab(-1, 1:field % ny) = field % slab(field % nx-1, 1:field % ny)
+            rslab(-2, 1:field % ny) = field % slab(field % nx-2, 1:field % ny)
+            rslab(field % nx+1, 1:field % ny) = field % slab(1, 1:field % ny)
+            rslab(field % nx+2, 1:field % ny) = field % slab(2, 1:field % ny)
+            rslab(field % nx+3, 1:field % ny) = field % slab(3, 1:field % ny)
+
+            do i=1,nInterpPoints
+               lat = latPoints(i)*DEG_PER_RAD
+               lon = lonPoints(i)*DEG_PER_RAD
+               call latlon_to_ij(proj, lat, lon, x, y)
+               if (x < 0.5) then
+                  lon = lon + 360.0
+                  call latlon_to_ij(proj, lat, lon, x, y)
+               else if (x >= real(field%nx)+0.5) then
+                  lon = lon - 360.0
+                  call latlon_to_ij(proj, lat, lon, x, y)
+               end if
+               if (y < 0.5) then
+                  y = 1.0
+               else if (y >= real(field%ny)+0.5) then
+                  y = real(field%ny)
+               end if
+               if (ndims == 1) then
+                  destField1d(i) = interp_sequence(x, y, 1, rslab, -2, field%nx + 3, 1, field%ny, 1, 1, msgval, interp_list, 1)
+               else if (ndims == 2) then
+                  destField2d(k,i) = interp_sequence(x, y, 1, rslab, -2, field%nx + 3, 1, field%ny, 1, 1, msgval, interp_list, 1)
+               end if
+            end do
+
+            deallocate(rslab)
+
+         end if
+
+         deallocate(field % slab)
+         call read_next_met_field(field, istatus)
+      end do
+
+      call read_met_close()
+      level_value = mpas_hash_size(level_hash)
+      call mpas_hash_destroy(level_hash)
+
+      if (too_many_fg_levs) then
+         write(errstring,'(a,i4)') '       Please increase config_nfglevels to at least ', level_value
+         call mpas_log_write('*******************************************************************', messageType=MPAS_LOG_ERR)
+         call mpas_log_write('Error: The meteorological data file has more than config_nfglevels.', messageType=MPAS_LOG_ERR)
+         call mpas_log_write(trim(errstring),                                                       messageType=MPAS_LOG_ERR)
+         call mpas_log_write('       in the namelist and re-run.',                                  messageType=MPAS_LOG_ERR)
+         call mpas_log_write('*******************************************************************', messageType=MPAS_LOG_CRIT)
+      end if
+
+
+      !
+      ! Check how many distinct levels we actually found in the meteorological data
+      !
+      do k=1,config_nfglevels
+         if (vert_level(k) == -1.0) exit
+      end do
+      nfglevels_actual = k-1
+      call mpas_log_write('*************************************************')
+      call mpas_log_write('Found $i levels in the first-guess data', intArgs=(/nfglevels_actual/))
+      call mpas_log_write('*************************************************')
+
+
+      !
+      ! For isobaric data, fill in the 3-d pressure field; otherwise, ensure
+      ! that the surface pressure and height fields are filled in
+      !
+      if (minval(p_fg(1:nfglevels_actual,1:nCellsSolve)) == 0.0 .and. &
+          maxval(p_fg(1:nfglevels_actual,1:nCellsSolve)) == 0.0) then
+         call mpas_log_write('Setting pressure field for isobaric data')
+         do k=1,config_nfglevels
+            if (vert_level(k) /= 200100.0) then
+               p_fg(k,:) = vert_level(k)
+            end if
+         end do
+      else
+         call mpas_pool_get_array(fg, 'z', z_fg)
+         call mpas_pool_get_array(fg, 'soilz', soilz)
+         call mpas_log_write('Assuming model-level input data')
+         do k=1,config_nfglevels
+            if (vert_level(k) == 200100.0) then
+               z_fg(k,:) = soilz(:)
+            end if
+         end do
+      end if
+
+
+      !
+      ! Compute normal wind component and store in fg % u
+      !
+      do iEdge=1,nEdges
+         do k=1,nfglevels_actual
+            u_fg(k,iEdge) = cos(angleEdge(iEdge)) * u_fg(k,iEdge) &
+                          + sin(angleEdge(iEdge)) * v_fg(k,iEdge)
+         end do
+      end do
+
+      !
+      ! Vertically interpolate meteorological data
+      !
+      allocate(sorted_arr(2,nfglevels_actual))
+
+      do iCell=1,nCells
+
+         ! T
+         sorted_arr(:,:) = -999.0
+         do k = 1, nfglevels_actual
+            sorted_arr(1,k) = z_fg(k,iCell)
+            if (vert_level(k) == 200100.0) sorted_arr(1,k) = 99999.0
+            sorted_arr(2,k) = t_fg(k,iCell)
+         end do
+         call mpas_quicksort(nfglevels_actual, sorted_arr)
+         do k = 1, nVertLevels
+            target_z = 0.5 * (zgrid(k,iCell) + zgrid(k+1,iCell))
+            t(k,iCell) = vertical_interp(target_z, nfglevels_actual-1, &
+                                         sorted_arr(:,1:nfglevels_actual-1), order=1, &
+                                         extrap=extrap_airtemp, ierr=istatus)
+            if (istatus /= 0) then
+               write(errstring,'(a,i4,a,i10)') 'Error in interpolation of t(k,iCell) for k=', k, ', iCell=', iCell
+               call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_ERR)
+               call mpas_log_write(trim(errstring),                                                     messageType=MPAS_LOG_ERR)
+               call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_CRIT)
+            end if
+         end do
+
+
+         ! RH
+         sorted_arr(:,:) = -999.0
+         relhum(:,iCell) = 0._RKIND
+         do k = 1, nfglevels_actual
+            sorted_arr(1,k) = z_fg(k,iCell)
+            if (vert_level(k) == 200100.0) sorted_arr(1,k) = 99999.0
+            sorted_arr(2,k) = rh_fg(k,iCell)
+         end do
+         call mpas_quicksort(nfglevels_actual, sorted_arr)
+         do k = nVertLevels, 1, -1
+            target_z = 0.5 * (zgrid(k,iCell) + zgrid(k+1,iCell))
+            relhum(k,iCell) = vertical_interp(target_z, nfglevels_actual-1, &
+                                       sorted_arr(:,1:nfglevels_actual-1), order=1, extrap=0)
+            if (target_z < z_fg(1,iCell) .and. k < nVertLevels) relhum(k,iCell) = relhum(k+1,iCell)
+         end do
+
+
+         ! SPECHUM: if first-guess values are negative, set those values to zero before
+         ! vertical interpolation.
+         sorted_arr(:,:) = -999.0
+         spechum(:,iCell) = 0._RKIND
+         do k = 1, nfglevels_actual
+            sorted_arr(1,k) = z_fg(k,iCell)
+            if (vert_level(k) == 200100.0) sorted_arr(1,k) = 99999.0
+            sorted_arr(2,k) = max(0._RKIND,sh_fg(k,iCell))
+         end do
+         call mpas_quicksort(nfglevels_actual, sorted_arr)
+         do k = nVertLevels, 1, -1
+            target_z = 0.5 * (zgrid(k,iCell) + zgrid(k+1,iCell))
+            spechum(k,iCell) = vertical_interp(target_z, nfglevels_actual-1, &
+                                        sorted_arr(:,1:nfglevels_actual-1), order=1, extrap=0)
+            if (target_z < z_fg(1,iCell) .and. k < nVertLevels) spechum(k,iCell) = spechum(k+1,iCell)
+         end do
+
+
+         ! PRESSURE
+         sorted_arr(:,:) = -999.0
+         do k = 1, nfglevels_actual
+            sorted_arr(1,k) = z_fg(k,iCell)
+            if (vert_level(k) == 200100.0) then
+               sorted_arr(1,k) = 99999.0
+               sfc_k = k
+               p_fg(k,iCell) = 1.0   ! Any value that has valid log is fine...
+            end if
+            sorted_arr(2,k) = log(p_fg(k,iCell))
+         end do
+         call mpas_quicksort(nfglevels_actual, sorted_arr)
+         do k = 1, nVertLevels
+            target_z = 0.5 * (zgrid(k,iCell) + zgrid(k+1,iCell))
+            pressure(k,iCell) = exp(vertical_interp(target_z, nfglevels_actual-1, &
+                                    sorted_arr(:,1:nfglevels_actual-1), order=1, extrap=1))
+         end do
+
+      end do
+
+
+      do iEdge=1,nEdges
+
+         ! U
+         sorted_arr(:,:) = -999.0
+         do k=1,nfglevels_actual
+            sorted_arr(1,k) = 0.5 * (z_fg(k,cellsOnEdge(1,iEdge)) + z_fg(k,cellsOnEdge(2,iEdge)))
+            if (vert_level(k) == 200100.0) sorted_arr(1,k) = 99999.0
+            sorted_arr(2,k) = u_fg(k,iEdge)
+         end do
+         call mpas_quicksort(nfglevels_actual, sorted_arr)
+         do k=1,nVertLevels
+            target_z = 0.25 * (zgrid(k,cellsOnEdge(1,iEdge)) + zgrid(k+1,cellsOnEdge(1,iEdge)) &
+                             + zgrid(k,cellsOnEdge(2,iEdge)) + zgrid(k+1,cellsOnEdge(2,iEdge)))
+            u(k,iEdge) = vertical_interp(target_z, nfglevels_actual-1, sorted_arr(:,1:nfglevels_actual-1), order=1, extrap=1)
+         end do
+
+      end do
+
+      deallocate(sorted_arr)
+
+
+      ! Diagnose the water vapor mixing ratios:
+      global_sh_min = 0._RKIND
+      global_sh_max = 0._RKIND
+      if(config_use_spechumd) then
+         sh_min = minval(spechum(:,1:nCellsSolve))
+         sh_max = maxval(spechum(:,1:nCellsSolve))
+         call mpas_dmpar_min_real(dminfo,sh_min,global_sh_min)
+         call mpas_dmpar_max_real(dminfo,sh_max,global_sh_max)
+      endif
+      call mpas_log_write('')
+      call mpas_log_write('--- global_sh_min = $r', realArgs=(/global_sh_min/))
+      call mpas_log_write('--- global_sh_max = $r', realArgs=(/global_sh_max/))
+      call mpas_log_write('')
+
+      call mpas_log_write('--- config_use_spechumd = $l', logicArgs=(/config_use_spechumd/))
+      if(.not. config_use_spechumd .or. (global_sh_min==0._RKIND .and. global_sh_max==0._RKIND)) then
+         !--- calculate the saturation mixing ratio and interpolated first-guess relative humidity:
+         if (config_use_spechumd) then
+            call mpas_log_write('config_use_spechumd=T, but specific humidity was not found in ' &
+                                //trim(config_met_prefix)//':'//timestamp(1:13), messageType=MPAS_LOG_WARN)
+         end if
+         call mpas_log_write(' *** initializing water vapor mixing ratio using first-guess relative humidity')
+         call mpas_log_write('')
+
+         do k = 1, nVertLevels
+            do iCell = 1, nCells
+               !
+               ! Note: the RH field provided by ungrib should always be with respect to liquid water,
+               !       hence, we can always call rslf; see the routine fix_gfs_rh in WPS/ungrib/src/rrpr.F .
+               !
+               rs = rslf(pressure(k,iCell),t(k,iCell))
+               scalars(index_qv,k,iCell) = 0.01_RKIND*rs*relhum(k,iCell)
+             enddo
+         enddo
+      else
+         !--- use the interpolated first-guess specific humidity:
+         call mpas_log_write(' *** initializing water vapor mixing ratio using first-guess specific humidity')
+         call mpas_log_write('')
+         do k = 1, nVertLevels
+            do iCell = 1, nCells
+               scalars(index_qv,k,iCell) = spechum(k,iCell)/(1._RKIND-spechum(k,iCell))
+            enddo
+         enddo
+      endif
+
+      !
+      ! Diagnose fields needed in initial conditions file (u, w, rho, theta)
+      ! NB: At this point, "rho_zz" is simple dry density, and "theta_m" is regular potential temperature
+      !
+      do iCell=1,nCells
+
+         do k=1,nVertLevels
+            ! PI
+            p(k,iCell) = (pressure(k,iCell) / p0) ** (rgas / cp)
+
+            ! THETA - can compute this using PI instead
+            t(k,iCell) = t(k,iCell) * (p0 / pressure(k,iCell)) ** (rgas / cp)
+
+            ! RHO_ZZ
+            rho_zz(k,iCell) = pressure(k,iCell) / rgas / (p(k,iCell) * t(k,iCell))
+            rho_zz(k,iCell) = rho_zz(k,iCell) / (1.0 + scalars(index_qv,k,iCell))
+         end do
+      end do
+
+
+      !
+      ! Reference state based on a dry isothermal atmosphere
+      !
+      do iCell=1,nCells
+         do k=1,nVertLevels
+            ztemp    = 0.5*(zgrid(k+1,iCell)+zgrid(k,iCell))
+            ppb(k,iCell) = p0*exp(-gravity*ztemp/(rgas*t0b))      ! pressure_base
+            pb (k,iCell) = (ppb(k,iCell)/p0)**(rgas/cp)           ! exner_base
+            rb (k,iCell) = ppb(k,iCell)/(rgas*t0b)                ! rho_base
+            tb (k,iCell) = t0b/pb(k,iCell)                        ! theta_base
+            rtb(k,iCell) = rb(k,iCell)*tb(k,iCell)                ! rtheta_base
+            p  (k,iCell) = pb(k,iCell)                            ! exner
+            pp (k,iCell) = 0.                                     ! pressure_p
+            rr (k,iCell) = 0.                                     ! rho_p
+         end do
+      end do
+
+      do iCell=1,nCells
+         do k=1,nVertLevels
+
+            ! couple with vertical metric
+            rb(k,iCell) = rb(k,iCell) / zz(k,iCell)
+            rho_zz(k,iCell) = rho_zz(k,iCell) / zz(k,iCell)
+
+            pp(k,iCell) = pressure(k,iCell) - ppb(k,iCell)
+            rr(k,iCell) = rho_zz(k,iCell) - rb(k,iCell)
+
+         end do
+      end do
+
+      do iCell=1,nCells
+         k = 1
+
+         ! couple with vertical metric, note: rr is coupled here
+         rho_zz(k,iCell) = ((pressure(k,iCell) / p0)**(cv / cp)) * (p0 / rgas) &
+                            / (t(k,iCell)*(1.0 + 1.61*scalars(index_qv,k,iCell))) / zz(k,iCell)
+         rr(k,iCell) = rho_zz(k,iCell) - rb(k,iCell)
+
+         do k=2,nVertLevels
+            it = 0
+            p_check = 2.0 * 0.0001
+            do while ( (it < 30) .and. (p_check > 0.0001) )
+
+               p_check = pp(k,iCell)
+
+               ! MPAS hydrostatic relation
+               pp(k,iCell) = pp(k-1,iCell) - (fzm(k)*rr(k,iCell) + fzp(k)*rr(k-1,iCell))*gravity*dzu(k) &
+                                           - (fzm(k)*rho_zz(k,iCell)*scalars(index_qv,k,iCell) &
+                                                  + fzp(k)*rho_zz(k-1,iCell)*scalars(index_qv,k-1,iCell))*gravity*dzu(k)
+               pressure(k,iCell) = pp(k,iCell) + ppb(k,iCell)
+               p(k,iCell) = (pressure(k,iCell) / p0) ** (rgas / cp)
+
+               ! couple with vertical metric
+               rho_zz(k,iCell) = pressure(k,iCell) / rgas &
+                     / (p(k,iCell)*t(k,iCell)*(1.0 + 1.61*scalars(index_qv,k,iCell)))/zz(k,iCell)
+               rr(k,iCell) = rho_zz(k,iCell) - rb(k,iCell)
+
+               p_check = abs(p_check - pp(k,iCell))
+
+               it = it + 1
+            end do
+         end do
+      end do
+
+      ! Compute theta_m and rho-tilde
+      do iCell=1,nCells
+         do k=1,nVertLevels
+            t(k,iCell) = t(k,iCell) * (1.0 + 1.61*scalars(index_qv,k,iCell))
+            rr(k,iCell) = rr(k,iCell)*zz(k,iCell)
+         end do
+      end do
+
+      do iEdge=1,nEdges
+         do k=1,nVertLevels
+            ru(k,iEdge) = u(k,iEdge) * 0.5*(rho_zz(k,cellsOnEdge(1,iEdge)) + rho_zz(k,cellsOnEdge(2,iEdge)))
+         end do
+      end do
+
+
+      rw(:,:) = 0.0
+
+      do iCell=1,nCellsSolve
+
+         do i=1,nEdgesOnCell(iCell)
+            iEdge=edgesOnCell(i,iCell)
+
+            do k = 2, nVertLevels
+               flux =  (fzm(k)*ru(k,iEdge)+fzp(k)*ru(k-1,iEdge))
+               if (iCell == cellsOnEdge(1,iEdge)) then
+                  rw(k,iCell) = rw(k,iCell) - (fzm(k)*zz(k,iCell)+fzp(k)*zz(k-1,iCell))*zb(k,1,iEdge)*flux
+               else
+                  rw(k,iCell) = rw(k,iCell) + (fzm(k)*zz(k,iCell)+fzp(k)*zz(k-1,iCell))*zb(k,2,iEdge)*flux
+               end if
+
+               if (config_theta_adv_order ==3) then
+                  if (iCell == cellsOnEdge(1,iEdge)) then
+                     rw(k,iCell) = rw(k,iCell)    &
+                                  + sign(1.0_RKIND,ru(k,iEdge))*config_coef_3rd_order* &
+                                    (fzm(k)*zz(k,iCell)+fzp(k)*zz(k-1,iCell))*zb3(k,1,iEdge)*flux
+                  else
+                     rw(k,iCell) = rw(k,iCell)    &
+                                  - sign(1.0_RKIND,ru(k,iEdge))*config_coef_3rd_order* &
+                                    (fzm(k)*zz(k,iCell)+fzp(k)*zz(k-1,iCell))*zb3(k,2,iEdge)*flux
+                  end if
+               end if
+
+            end do
+
+         end do
+
+      end do
+
+
+      ! Compute w from rho_zz and rw
+      do iCell=1,nCellsSolve
+         do k=2,nVertLevels
+            w(k,iCell) = rw(k,iCell) / (fzp(k) * rho_zz(k-1,iCell) + fzm(k) * rho_zz(k,iCell))
+         end do
+      end do
+
+      deallocate(vert_level)
+
+
+      ! Compute rho and theta from rho_zz and theta_m
+      do iCell=1,nCells
+         do k=1,nVertLevels
+            rho(k,iCell) = rho_zz(k,iCell) * zz(k,iCell)
+            theta(k,iCell) = t(k,iCell) / (1.0 + 1.61 * scalars(index_qv,k,iCell))
+         end do
+      end do
+
+   end subroutine init_atm_case_lbc
+
+
+   integer function nearest_edge(target_lat, target_lon, &
+                                 start_edge, &
+                                 nCells, nEdges, maxEdges, nEdgesOnCell, edgesOnCell, cellsOnEdge, latCell, lonCell, latEdge, lonEdge)
+
+      implicit none
+
+      real (kind=RKIND), intent(in) :: target_lat, target_lon
+      integer, intent(in) :: start_edge
+      integer, intent(in) :: nCells, nEdges, maxEdges
+      integer, dimension(nCells), intent(in) :: nEdgesOnCell
+      integer, dimension(maxEdges,nCells), intent(in) :: edgesOnCell
+      integer, dimension(2,nEdges), intent(in) :: cellsOnEdge
+      real (kind=RKIND), dimension(nCells), intent(in) :: latCell, lonCell
+      real (kind=RKIND), dimension(nEdges), intent(in) :: latEdge, lonEdge
+
+      integer :: i, cell1, cell2, iCell
+      integer :: iEdge
+      integer :: current_edge
+      real (kind=RKIND) :: cell1_dist, cell2_dist
+      real (kind=RKIND) :: current_distance, d
+      real (kind=RKIND) :: nearest_distance
+
+      nearest_edge = start_edge
+      current_edge = -1
+
+      do while (nearest_edge /= current_edge)
+         current_edge = nearest_edge
+         current_distance = sphere_distance(latEdge(current_edge), lonEdge(current_edge), target_lat, target_lon, 1.0_RKIND)
+         nearest_edge = current_edge
+         nearest_distance = current_distance
+         cell1 = cellsOnEdge(1,current_edge)
+         cell2 = cellsOnEdge(2,current_edge)
+         cell1_dist = sphere_distance(latCell(cell1), lonCell(cell1), target_lat, target_lon, 1.0_RKIND)
+         cell2_dist = sphere_distance(latCell(cell2), lonCell(cell2), target_lat, target_lon, 1.0_RKIND)
+         if (cell1_dist < cell2_dist) then
+            iCell = cell1
+         else
+            iCell = cell2
+         end if
+         do i = 1, nEdgesOnCell(iCell)
+            iEdge = edgesOnCell(i,iCell)
+            if (iEdge <= nEdges) then
+               d = sphere_distance(latEdge(iEdge), lonEdge(iEdge), target_lat, target_lon, 1.0_RKIND)
+               if (d < nearest_distance) then
+                  nearest_edge = iEdge
+                  nearest_distance = d
+               end if
+            end if
+         end do
+      end do
+
+   end function nearest_edge
+
+
+   real (kind=RKIND) function vertical_interp(target_z, nz, zf, order, extrap, surface_val, sealev_val, ierr)
+
+      implicit none
+
+      real (kind=RKIND), intent(in) :: target_z
+      integer, intent(in) :: nz 
+      real (kind=RKIND), dimension(2,nz), intent(in) :: zf      ! zf(1,:) is column of vertical coordinate values, zf(2,:) is column of field values
+      integer, intent(in), optional :: order
+      integer, intent(in), optional :: extrap                   ! can take values 0 = constant, 1 = linear (default), 2 = lapse-rate
+      real (kind=RKIND), intent(in), optional :: surface_val
+      real (kind=RKIND), intent(in), optional :: sealev_val
+      integer, intent(out), optional :: ierr
+      
+      integer :: k, lm, lp
+      real (kind=RKIND) :: wm, wp
+      real (kind=RKIND) :: slope
 
       integer :: interp_order, extrap_type
       real (kind=RKIND) :: surface, sealevel
@@ -5192,4 +6068,381 @@ subroutine decouple_variables(mesh, nCells, nVertLevels, state, diag)
 
    end subroutine decouple_variables
 
+
+   !-----------------------------------------------------------------------
+   !  routine blend_bdy_terrain
+   !
+   !> \brief Combines first-guess terrain with static terrain along regional domain boundaries
+   !> \author Michael Duda
+   !> \date   25 April 2019
+   !> \details
+   !>  This routine combines terrain from the first-guess dataset provided in an intermediate
+   !>  file with the terrain field produced by the init_atmosphere core's "static interpolation"
+   !>  stage in the boundary cells of a regional mesh. Specifically, where the value of
+   !>  the bdyMaskCell field is nBdyLayers or nBdyLayers-1, the terrain field, ter, is interpolated
+   !>  directly from the first-guess terrain; where the value of bdy MaskCell is between nBdyLayers-2
+   !>  and 1, the terrain field is a combination of the first-guess terrain and the high-resolution
+   !>  "static" terrain field.
+   !>
+   !>  When dryrun=true, the nCells, latCell, lonCell, bdyMaskCell, and ter arguments are not used
+   !>   -- only the config_met_prefix and config_start_time arguments are used. The dryrun argument
+   !>  allows calling code to determine if blend_bdy_terrain will succeed without actually blending
+   !>  the boundary terrain.
+   !>
+   !>  For global meshes, where bdyMaskCell == 0 everywhere, this routine will have no impact
+   !>  on the model terrain field.
+   !
+   !-----------------------------------------------------------------------
+   subroutine blend_bdy_terrain(config_met_prefix, config_start_time, nCells, latCell, lonCell, bdyMaskCell, ter, dryrun, ierr)
+
+      use init_atm_read_met, only : read_met_init, read_met_close, read_next_met_field, met_data
+      use init_atm_llxy, only : map_init, map_set, proj_info, latlon_to_ij, PROJ_LATLON, PROJ_GAUSS, DEG_PER_RAD
+      use init_atm_hinterp, only : interp_sequence, FOUR_POINT
+
+      implicit none
+
+      character(len=*), intent(in) :: config_met_prefix
+      character(len=*), intent(in) :: config_start_time
+      integer, intent(in) :: nCells
+      real (kind=RKIND), dimension(:), intent(in) :: latCell  ! These four variables (latCell, lonCell, bdyMaskCell, and ter)
+      real (kind=RKIND), dimension(:), intent(in) :: lonCell  ! may actually have more than nCells elements, for example,
+      integer, dimension(:), intent(in) :: bdyMaskCell        ! if the arrays include a "garbage cell".
+      real (kind=RKIND), dimension(:), intent(inout) :: ter   ! 
+      logical, intent(in) :: dryrun
+      integer, intent(out) :: ierr
+
+      integer, parameter :: nBdyLayers = 7   ! The number of relaxation layers plus the number of specified layers
+      integer, parameter :: nSpecLayers = 2  ! The number of specified layers
+
+      integer :: i
+      integer :: istatus
+      integer, dimension(2) :: interp_list
+      real (kind=RKIND) :: weight
+      real (kind=RKIND) :: lat, lon
+      real (kind=RKIND) :: x, y
+      real (kind=RKIND), allocatable, dimension(:,:) :: rslab
+      type (met_data) :: field
+      type (proj_info) :: proj
+
+
+      ierr = 0
+
+      if (.not. dryrun) then
+         call mpas_log_write('Blending first-guess terrain field along domain boundary')
+      end if
+
+      call read_met_init(trim(config_met_prefix), .false., config_start_time(1:13), istatus)
+
+      if (istatus /= 0) then
+         call mpas_log_write('********************************************************************************', &
+                             messageType=MPAS_LOG_ERR)
+         call mpas_log_write('Error opening file with terrain field, '//trim(config_met_prefix)//':'//config_start_time(1:13), &
+                             messageType=MPAS_LOG_ERR)
+         call mpas_log_write('********************************************************************************', &
+                             messageType=MPAS_LOG_ERR)
+         ierr = 1
+         return
+      end if
+
+      !
+      ! Loop over fields in the intermediate file looking for the SOILHGT field
+      !
+      call read_next_met_field(field, istatus)
+      do while (istatus == 0)
+         if (trim(field % field) == 'SOILHGT') then
+
+            if (.not. dryrun) then
+               interp_list(1) = FOUR_POINT
+               interp_list(2) = 0
+
+               !
+               ! Set up map projection - currently, only the regular lat-lon projection is handled
+               !
+               call map_init(proj)
+          
+               if (field % iproj == PROJ_LATLON) then
+                  call map_set(PROJ_LATLON, proj, &
+                               latinc = real(field % deltalat,RKIND), &
+                               loninc = real(field % deltalon,RKIND), &
+                               knowni = 1.0_RKIND, &
+                               knownj = 1.0_RKIND, &
+                               lat1 = real(field % startlat,RKIND), &
+                               lon1 = real(field % startlon,RKIND))
+               else if (field % iproj == PROJ_GAUSS) then
+                  call map_set(PROJ_GAUSS, proj, &
+                               nlat = nint(field % deltalat), &
+                               loninc = 360.0_RKIND / real(field % nx,RKIND), &
+                               lat1 = real(field % startlat,RKIND), &
+                               lon1 = real(field % startlon,RKIND))
+               end if
+
+               !
+               ! Copy the first-guess terrain field into an array that includes some periodic points
+               !
+               allocate(rslab(-2:field % nx+3, field % ny))
+               rslab(1:field % nx, 1:field % ny) = field % slab(1:field % nx, 1:field % ny)
+               rslab(0, 1:field % ny)  = field % slab(field % nx, 1:field % ny)
+               rslab(-1, 1:field % ny) = field % slab(field % nx-1, 1:field % ny)
+               rslab(-2, 1:field % ny) = field % slab(field % nx-2, 1:field % ny)
+               rslab(field % nx+1, 1:field % ny) = field % slab(1, 1:field % ny)
+               rslab(field % nx+2, 1:field % ny) = field % slab(2, 1:field % ny)
+               rslab(field % nx+3, 1:field % ny) = field % slab(3, 1:field % ny)
+
+               !
+               ! For each cell in the MPAS mesh, perform terrain blending if the cell is a boundary cell
+               !
+               do i=1,nCells
+                  if (bdyMaskCell(i) > 0) then
+                     lat = latCell(i)*DEG_PER_RAD
+                     lon = lonCell(i)*DEG_PER_RAD
+                     call latlon_to_ij(proj, lat, lon, x, y)
+                     if (x < 0.5) then
+                        lon = lon + 360.0
+                        call latlon_to_ij(proj, lat, lon, x, y)
+                     else if (x >= real(field%nx)+0.5) then
+                        lon = lon - 360.0
+                        call latlon_to_ij(proj, lat, lon, x, y)
+                     end if
+                     if (y < 0.5) then
+                        y = 1.0
+                     else if (y >= real(field%ny)+0.5) then
+                        y = real(field%ny)
+                     end if
+
+                     !
+                     ! Is this a specified cell?
+                     !
+                     if (bdyMaskCell(i) > (nBdyLayers - nSpecLayers)) then
+                        ter(i) = interp_sequence(x, y, 1, rslab, -2, field%nx + 3, 1, field%ny, &
+                                                 1, 1, -1.0E30_RKIND, interp_list, 1)
+
+                     !
+                     ! Or a relaxation cell?
+                     !
+                     else
+                        weight = real(bdyMaskCell(i),kind=RKIND) / real(nBdyLayers - nSpecLayers,kind=RKIND)
+                        ter(i) = weight * interp_sequence(x, y, 1, rslab, -2, field%nx + 3, 1, field%ny, &
+                                                          1, 1, -1.0E30_RKIND, interp_list, 1) &
+                               + (1.0_RKIND - weight) * ter(i)
+
+                     end if
+                  end if
+               end do
+
+               deallocate(rslab)
+            end if
+
+            !
+            ! At this point, we have found and processed the first-guess terrain field, so we can return
+            !
+            deallocate(field % slab)
+            call read_met_close()
+            return
+
+         end if
+   
+         deallocate(field % slab)
+         call read_next_met_field(field, istatus)
+      end do
+
+      call read_met_close()
+
+      !
+      ! If we have reached this point, no first-guess terrain field was found...
+      !
+      ierr = 1
+      call mpas_log_write('********************************************************************************', &
+                          messageType=MPAS_LOG_ERR)
+      call mpas_log_write('SOILHGT field not found in intermediate file ' &
+                                     //trim(config_met_prefix)//':'//config_start_time(1:13)                , &
+                          messageType=MPAS_LOG_ERR)
+      call mpas_log_write('********************************************************************************', &
+                          messageType=MPAS_LOG_ERR)
+
+   end subroutine blend_bdy_terrain
+
+
+   !-----------------------------------------------------------------------
+   !  routine convert_relhum_wrt_ice
+   !
+   !> \brief Converts an RH field given w.r.t. liquid water to RH w.r.t. ice below freezing
+   !> \author Wei Wang
+   !> \date   11 May 2019
+   !> \details
+   !>  This routine takes as input a temperature field (in K) and an RH field (in percent),
+   !>  which is assumed to be with respect to liquid water everywhere. Upon return, the
+   !>  relative humidity for temperatures below 253.15 K has been modified to be with
+   !>  respect to ice. For temperatures in the range (253.15, 273.15] the relative humidity
+   !>  uses a blend of the saturation mixing ratios for liquid water and ice.
+   !>
+   !>  This routine uses the formula from the WPS ungrib program to re-compute RH with
+   !>  respect to ice in an attempt to re-construct RH that is more like the ungrib input.
+   !
+   !-----------------------------------------------------------------------
+   subroutine convert_relhum_wrt_ice(t, relhum)
+
+      implicit none
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: t
+      real (kind=RKIND), dimension(:,:), intent(inout) :: relhum
+
+      integer :: iCell, k
+      integer :: nVertLevels
+      integer :: nCells
+      real (kind=RKIND) :: eis, ews, r1
+
+
+      nVertLevels = size(t, dim=1)
+      nCells = size(t, dim=2)
+
+      call mpas_log_write('')
+      call mpas_log_write('Recomputing RH w.r.t. ice below freezing')
+      call mpas_log_write('')
+
+      do iCell = 1, nCells
+         do k = 1, nVertLevels
+            if ( t(k,iCell) <= 273.15_RKIND ) then
+
+               ! use formula in ungrib to reconstruct RH 
+               eis = 0.01_RKIND * exp (9.550426_RKIND - (5723.265_RKIND / t(k,iCell)) + (3.53068_RKIND * log(t(k,iCell))) &
+                   - (0.00728332_RKIND * t(k,iCell)))
+               ews = 6.112_RKIND * exp(17.67_RKIND * (t(k,iCell)-273.15_RKIND) / ((t(k,iCell)-273.15_RKIND)+243.5_RKIND))
+
+               ! A linear approximation to the GFS blending region ( -20 C > T < 0 C )
+               if ( t(k,iCell) > 253.15_RKIND ) then
+                  r1 = ((273.15_RKIND - t(k,iCell)) / 20.0_RKIND)
+                  r1 = (r1 * eis) + ((1.0_RKIND-r1)*ews)
+               else
+                  r1 = eis
+               end if
+               r1 = max(r1, 1.0e-12_RKIND)
+               ews = max(ews, 0.0_RKIND)
+               relhum(k,iCell) = ews / r1 * relhum(k,iCell)
+               relhum(k,iCell) = min(relhum(k,iCell), 100.0_RKIND)
+               relhum(k,iCell) = max(relhum(k,iCell), 0.0_RKIND)
+            end if
+         end do
+      end do
+
+   end subroutine convert_relhum_wrt_ice
+
+
+   !-----------------------------------------------------------------------
+   !  routine read_text_array
+   !
+   !> \brief Reads a real-valued array from a text file and broadcasts to all tasks
+   !> \author Michael Duda
+   !> \date   11 May 2019
+   !> \details
+   !>  This routine reads a list of real values from the specified text file on
+   !>  the IO_NODE task and broadcasts the values to all other MPI tasks. Upon
+   !>  successful return, the array pointer xarray will have been allocated with
+   !>  a size equal to the number of lines in the text file, the array will be filled
+   !>  with the values from the file, and a value of 0 will be returned.
+   !>
+   !>  This routine will print an error message and return a non-zero value if
+   !>  any of the following conditions occur:
+   !>
+   !>  1) The text file does not exist
+   !>  2) The text file cannot be opened for reading
+   !>  3) The text does not contain readable real values
+   !>
+   !>  If the return value of this function is non-zero, the xarray pointer
+   !>  will be unassociated.
+   !
+   !-----------------------------------------------------------------------
+   function read_text_array(dminfo, filename, xarray) result(ierr)
+
+      use mpas_io_units, only : mpas_new_unit, mpas_release_unit
+      use mpas_log, only : mpas_log_write
+      use mpas_derived_types, only : MPAS_LOG_ERR
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      character(len=*), intent(in) :: filename
+      real (kind=RKIND), dimension(:), pointer :: xarray
+
+      integer :: ierr
+
+      integer :: i
+      integer :: nlines
+      integer :: iunit
+      integer :: iexists
+      logical :: exists
+      real (kind=RKIND) :: rtemp
+
+
+      ierr = 1
+      nullify(xarray)
+
+      !
+      ! Check whether the file exists
+      !
+      if (dminfo % my_proc_id == IO_NODE) then
+         inquire(file=filename, exist=exists)
+         if (exists) then
+            iexists = 1
+         else
+            iexists = 0
+         end if
+      end if
+      call mpas_dmpar_bcast_int(dminfo, iexists)
+
+      if (iexists == 0) then
+         call mpas_log_write('Text file '''//filename//''' does not exist.', messageType=MPAS_LOG_ERR)
+         return
+      end if
+
+      !
+      ! Count the number of lines in the file
+      !
+      if (dminfo % my_proc_id == IO_NODE) then
+         call mpas_new_unit(iunit)
+         open(unit=iunit, file=filename, form='formatted', status='old', iostat=ierr)
+         if (ierr /= 0) then
+            nlines = -1
+         else
+            nlines = 0
+            read(unit=iunit, fmt=*, iostat=ierr) rtemp
+            do while (ierr == 0)
+               nlines = nlines + 1
+               read(unit=iunit, fmt=*, iostat=ierr) rtemp
+            end do
+         end if
+         close(unit=iunit)
+         call mpas_release_unit(iunit)
+      end if
+      call mpas_dmpar_bcast_int(dminfo, nlines)
+
+      if (nlines <= 0) then
+         if (nlines < 0) then
+            call mpas_log_write('Text file '''//filename//''' could not be opened for reading.', messageType=MPAS_LOG_ERR)
+         else
+            call mpas_log_write('Text file '''//filename//''' contains no readable real values.', messageType=MPAS_LOG_ERR)
+         end if
+         ierr = 1
+         return
+      end if
+
+      !
+      ! Allocate output array, read, and broadcast
+      !
+      allocate(xarray(nlines))
+      if (dminfo % my_proc_id == IO_NODE) then
+         call mpas_new_unit(iunit)
+         open(unit=iunit, file=filename, form='formatted', status='old', iostat=ierr)
+         do i=1,nlines
+            read(unit=iunit, fmt=*, iostat=ierr) xarray(i)
+         end do
+         close(unit=iunit)
+         call mpas_release_unit(iunit)
+      end if
+
+      call mpas_dmpar_bcast_reals(dminfo, nlines, xarray)
+      ierr = 0
+
+   end function read_text_array
+
+
 end module init_atm_cases
diff --git a/src/core_init_atmosphere/mpas_init_atm_core_interface.F b/src/core_init_atmosphere/mpas_init_atm_core_interface.F
index 588dacdcb2..7f478b5ad9 100644
--- a/src/core_init_atmosphere/mpas_init_atm_core_interface.F
+++ b/src/core_init_atmosphere/mpas_init_atm_core_interface.F
@@ -56,7 +56,7 @@ subroutine init_atm_setup_core(core)
       core % Conventions = 'MPAS'
       core % source = 'MPAS'
 
-#include "inc/core_variables.inc"
+#include "core_variables.inc"
 
    end subroutine init_atm_setup_core
 
@@ -81,7 +81,7 @@ subroutine init_atm_setup_domain(domain)
 
       type (domain_type), pointer :: domain
 
-#include "inc/domain_variables.inc"
+#include "domain_variables.inc"
 
    end subroutine init_atm_setup_domain
 
@@ -112,8 +112,8 @@ function init_atm_setup_packages(configs, packages, iocontext) result(ierr)
       type (mpas_io_context_type), intent(inout) :: iocontext
       integer :: ierr
 
-      logical, pointer :: initial_conds, sfc_update
-      logical, pointer :: gwd_stage_in, vertical_stage_in, vertical_stage_out, met_stage_in, met_stage_out
+      logical, pointer :: initial_conds, sfc_update, lbcs
+      logical, pointer :: gwd_stage_in, gwd_stage_out, vertical_stage_in, vertical_stage_out, met_stage_in, met_stage_out
       logical, pointer :: config_native_gwd_static, config_static_interp, config_vertical_grid, config_met_interp
       integer, pointer :: config_init_case
 
@@ -132,9 +132,15 @@ function init_atm_setup_packages(configs, packages, iocontext) result(ierr)
       nullify(sfc_update)
       call mpas_pool_get_package(packages, 'sfc_updateActive', sfc_update)
 
+      nullify(lbcs)
+      call mpas_pool_get_package(packages, 'lbcsActive', lbcs)
+
       nullify(gwd_stage_in)
       call mpas_pool_get_package(packages, 'gwd_stage_inActive', gwd_stage_in)
 
+      nullify(gwd_stage_out)
+      call mpas_pool_get_package(packages, 'gwd_stage_outActive', gwd_stage_out)
+
       nullify(vertical_stage_in)
       call mpas_pool_get_package(packages, 'vertical_stage_inActive', vertical_stage_in)
 
@@ -150,6 +156,7 @@ function init_atm_setup_packages(configs, packages, iocontext) result(ierr)
       if (.not. associated(initial_conds) .or. &
           .not. associated(sfc_update) .or. &
           .not. associated(gwd_stage_in) .or. &
+          .not. associated(gwd_stage_out) .or. &
           .not. associated(vertical_stage_in) .or. &
           .not. associated(vertical_stage_out) .or. &
           .not. associated(met_stage_in) .or. &
@@ -169,20 +176,57 @@ function init_atm_setup_packages(configs, packages, iocontext) result(ierr)
          sfc_update = .false.
       end if
 
+      if (config_init_case == 9) then
+         lbcs = .true.
+      else
+         lbcs = .false.
+      end if
+
       if (config_init_case == 7) then
-         gwd_stage_in = (config_native_gwd_static .and. .not. config_static_interp)
-         vertical_stage_in = (config_vertical_grid .and. .not. config_static_interp)
-         vertical_stage_out = (config_vertical_grid .and. .not. config_met_interp)
-         met_stage_in = (config_met_interp .and. .not. config_vertical_grid)
+
+         !
+         ! The logic here is a little convoluted
+         ! For input, we want to read in fields from all earlier stages, except if those earlier stages are being run now
+         ! For output, we want to output the fields that were computed in a stage and all of those from earlier stages
+         !
+         gwd_stage_in = config_native_gwd_static .and. &
+                        (.not. config_static_interp)
+         gwd_stage_out = config_native_gwd_static
+         vertical_stage_in = config_vertical_grid .and. &
+                             (.not. config_native_gwd_static) .and. &
+                             (.not. config_static_interp)
+         vertical_stage_out = config_vertical_grid
+         met_stage_in = config_met_interp .and. &
+                        (.not. config_native_gwd_static) .and. &
+                        (.not. config_static_interp) .and. &
+                        (.not. config_vertical_grid)
          met_stage_out = config_met_interp
+
       else if (config_init_case == 8) then
          gwd_stage_in = .false.
+         gwd_stage_out = .false.
          vertical_stage_in = .true.
          vertical_stage_out = .false.
          met_stage_in = .false.
          met_stage_out = .false.
+
+      !
+      ! When interpolating LBC fields, we need all inputs that would be needed for the interpolation
+      ! of ICs, so met_stage_in = .true.
+      !
+      else if (config_init_case == 9) then
+         gwd_stage_in = .false.
+         gwd_stage_out = .false.
+         vertical_stage_in = .false.
+         vertical_stage_out = .false.
+         met_stage_in = .true.
+         met_stage_out = .true.
+
+         initial_conds = .false.   ! Also, turn off the initial_conds package to avoid writing the IC "output" stream
+
       else
          gwd_stage_in = .false.
+         gwd_stage_out = .false.
          vertical_stage_in = .false.
          vertical_stage_out = .false.
          met_stage_in = .false.
@@ -396,16 +440,16 @@ function init_atm_setup_block(block) result(ierr)
    end function init_atm_setup_block
 
 
-#include "inc/setup_immutable_streams.inc"
+#include "setup_immutable_streams.inc"
 
-#include "inc/block_dimension_routines.inc"
+#include "block_dimension_routines.inc"
 
-#include "inc/define_packages.inc"
+#include "define_packages.inc"
 
-#include "inc/structs_and_variables.inc"
+#include "structs_and_variables.inc"
 
-#include "inc/namelist_call.inc"
+#include "namelist_call.inc"
 
-#include "inc/namelist_defines.inc"
+#include "namelist_defines.inc"
 
 end module init_atm_core_interface
diff --git a/src/core_init_atmosphere/mpas_init_atm_gwd.F b/src/core_init_atmosphere/mpas_init_atm_gwd.F
index 3bc260c3c2..6d1632f9b2 100644
--- a/src/core_init_atmosphere/mpas_init_atm_gwd.F
+++ b/src/core_init_atmosphere/mpas_init_atm_gwd.F
@@ -7,15 +7,35 @@
 !
 module mpas_init_atm_gwd
 
+   use iso_c_binding, only : c_char, c_int, c_float, c_ptr, c_loc
+
    use mpas_derived_types, only : MPAS_LOG_ERR
    use mpas_framework
    use mpas_timekeeping
    use mpas_log, only : mpas_log_write
+   use mpas_c_interfacing, only : mpas_f_to_c_string
 
    public :: compute_gwd_fields
 
    private
 
+   interface
+      subroutine read_geogrid(fname, rarray, nx, ny, nz, isigned, endian, &
+                              scalefactor, wordsize, status) bind(C)
+         use iso_c_binding, only : c_char, c_int, c_float, c_ptr
+         character (c_char), dimension(*), intent(in) :: fname
+         type (c_ptr), value :: rarray
+         integer (c_int), intent(in), value :: nx
+         integer (c_int), intent(in), value :: ny
+         integer (c_int), intent(in), value :: nz
+         integer (c_int), intent(in), value :: isigned
+         integer (c_int), intent(in), value :: endian
+         real (c_float), intent(in), value :: scalefactor
+         integer (c_int), intent(in), value :: wordsize
+         integer (c_int), intent(inout) :: status
+      end subroutine read_geogrid
+   end interface
+
    integer, parameter :: I1KIND = selected_int_kind(2)
 
    real (kind=RKIND), parameter :: Re = 6371229.0_RKIND        ! Earth radius in MPAS-Atmosphere
@@ -314,14 +334,17 @@ function read_global_30s_topo(path, sub_path) result(iErr)
       integer, parameter :: tile_y = 1200       ! y-dimension of each tile of global 30-arc-second topography
       integer, parameter :: tile_bdr = 3        ! number of layers of border/halo points surrounding each tile
 
-      integer :: istatus
+      integer (c_int) :: istatus
       integer :: ix, iy, ishift, ix_shift
-      integer :: isigned, endian, wordsize, nx, ny, nz
-      real (kind=R4KIND) :: scalefactor
-      real (kind=R4KIND), dimension(:,:,:), allocatable :: tile
+      integer (c_int) :: isigned, endian, wordsize, nx, ny, nz
+      real (c_float) :: scalefactor
+      real (c_float), dimension(:,:,:), pointer, contiguous :: tile
+      type (c_ptr) :: tile_ptr
       character(len=StrKIND) :: filename
+      character(kind=c_char), dimension(StrKIND+1) :: c_filename
 
       allocate(tile(tile_x+2*tile_bdr,tile_y+2*tile_bdr,1))
+      tile_ptr = c_loc(tile)
 
       isigned  = 1
       endian   = 0
@@ -345,7 +368,8 @@ function read_global_30s_topo(path, sub_path) result(iErr)
       do ix=1,topo_x,tile_x
          write(filename,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(path)//trim(sub_path), ix, '-', (ix+tile_x-1), '.', &
                                                                                       iy, '-', (iy+tile_y-1)
-         call read_geogrid(filename, len_trim(filename), tile, nx, ny, nz, isigned, endian, &
+         call mpas_f_to_c_string(filename, c_filename)
+         call read_geogrid(c_filename, tile_ptr, nx, ny, nz, isigned, endian, &
                            scalefactor, wordsize, istatus)
          if (istatus /= 0) then
             call mpas_log_write('Error reading topography tile '//trim(filename), messageType=MPAS_LOG_ERR)
@@ -389,14 +413,17 @@ function read_global_30s_landuse(path) result(iErr)
       integer, parameter :: tile_x = 1200       ! x-dimension of each tile of global 30-arc-second landuse
       integer, parameter :: tile_y = 1200       ! y-dimension of each tile of global 30-arc-second landuse
 
-      integer :: istatus
+      integer (c_int) :: istatus
       integer :: ix, iy
-      integer :: isigned, endian, wordsize, nx, ny, nz
-      real (kind=R4KIND) :: scalefactor
-      real (kind=R4KIND), dimension(:,:,:), allocatable :: tile
+      integer (c_int) :: isigned, endian, wordsize, nx, ny, nz
+      real (c_float) :: scalefactor
+      real (c_float), dimension(:,:,:), pointer, contiguous :: tile
+      type (c_ptr) :: tile_ptr
       character(len=StrKIND) :: filename
+      character(kind=c_char), dimension(StrKIND+1) :: c_filename
 
       allocate(tile(tile_x,tile_y,1))
+      tile_ptr = c_loc(tile)
 
       isigned  = 1
       endian   = 0
@@ -410,7 +437,8 @@ function read_global_30s_landuse(path) result(iErr)
       do ix=1,topo_x,tile_x
          write(filename,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(path)//'/landuse_30s/', ix, '-', (ix+tile_x-1), '.', &
                                                                                       iy, '-', (iy+tile_y-1)
-         call read_geogrid(filename, len_trim(filename), tile, nx, ny, nz, isigned, endian, &
+         call mpas_f_to_c_string(filename, c_filename)
+         call read_geogrid(c_filename, tile_ptr, nx, ny, nz, isigned, endian, &
                            scalefactor, wordsize, istatus)
          if (istatus /= 0) then
             call mpas_log_write('Error reading landuse tile '//trim(filename))
diff --git a/src/core_init_atmosphere/mpas_init_atm_static.F b/src/core_init_atmosphere/mpas_init_atm_static.F
index 253d681f94..e72dca987f 100644
--- a/src/core_init_atmosphere/mpas_init_atm_static.F
+++ b/src/core_init_atmosphere/mpas_init_atm_static.F
@@ -15,17 +15,36 @@ module mpas_init_atm_static
  use mpas_log, only : mpas_log_write
  use init_atm_hinterp
  use init_atm_llxy
+ use mpas_c_interfacing, only : mpas_f_to_c_string
 
  use mpas_atmphys_utilities
 
+ use iso_c_binding, only : c_char, c_int, c_float, c_loc, c_ptr
+
  implicit none
  private
  public:: init_atm_static,           &
-          init_atm_static_orogwd,    &
           init_atm_check_read_error, &
           nearest_cell,              &
           sphere_distance
 
+ interface
+    subroutine read_geogrid(fname, rarray, nx, ny, nz, isigned, endian, &
+                            scalefactor, wordsize, status) bind(C)
+       use iso_c_binding, only : c_char, c_int, c_float, c_ptr
+       character (c_char), dimension(*), intent(in) :: fname
+       type (c_ptr), value :: rarray
+       integer (c_int), intent(in), value :: nx
+       integer (c_int), intent(in), value :: ny
+       integer (c_int), intent(in), value :: nz
+       integer (c_int), intent(in), value :: isigned
+       integer (c_int), intent(in), value :: endian
+       real (c_float), intent(in), value :: scalefactor
+       integer (c_int), intent(in), value :: wordsize
+       integer (c_int), intent(inout) :: status
+    end subroutine read_geogrid
+ end interface
+
  contains
 
 !==================================================================================================
@@ -37,44 +56,59 @@ subroutine init_atm_static(mesh, dims, configs)
  type (mpas_pool_type), intent(in) :: dims
  type (mpas_pool_type), intent(in) :: configs
 
+!constants
+ integer, parameter :: nBdyLayers = 7   ! The number of relaxation layers plus the number of specified layers
+                                        ! This value is used in determining whether extra checks are needed
+                                        ! in the remapping of terrain, land use, and soil category pixels
+
 !local variables:
  type(proj_info):: proj
 
  character(len=StrKIND) :: fname
+ character(kind=c_char), dimension(StrKIND+1) :: c_fname
  character(len=StrKIND), pointer :: config_geog_data_path
  character(len=StrKIND), pointer :: config_landuse_data
  character(len=StrKIND), pointer :: config_topo_data
+ character(len=StrKIND), pointer :: config_vegfrac_data
+ character(len=StrKIND), pointer :: config_albedo_data
+ character(len=StrKIND), pointer :: config_maxsnowalbedo_data
  character(len=StrKIND+1) :: geog_data_path      ! same as config_geog_data_path, but guaranteed to have a trailing slash
  character(len=StrKIND+1) :: geog_sub_path       ! subdirectory names in config_geog_data_path, with trailing slash
 
- integer:: isice_lu,iswater_lu,ismax_lu
+ integer:: ismax_lu
 
- integer:: nx,ny,nz
- integer:: endian,isigned,istatus,wordsize
+ integer(c_int):: nx,ny,nz
+ integer(c_int):: endian,isigned,istatus,wordsize
  integer:: i,j,k
+ integer :: ii, jj
  integer:: iCell,iEdge,iVtx,iPoint,iTileStart,iTileEnd,jTileStart,jTileEnd
  integer,dimension(5) :: interp_list
  integer,dimension(:),allocatable  :: nhs
  integer,dimension(:,:),allocatable:: ncat
       
- real(kind=4):: scalefactor
- real(kind=4),dimension(:,:,:),allocatable:: rarray
+ real(kind=c_float):: scalefactor
+ real(kind=c_float),dimension(:,:,:),pointer,contiguous :: rarray
+ type(c_ptr) :: rarray_ptr
 
  real(kind=RKIND):: start_lat
  real(kind=RKIND):: start_lon
 
- real(kind=RKIND):: lat,lon,x,y
+ integer, pointer :: supersample_fac
+
+ real(kind=RKIND):: lat,lon,x,y,z
  real(kind=RKIND):: lat_pt,lon_pt
  real(kind=RKIND),dimension(:,:),allocatable  :: soiltemp_1deg
  real(kind=RKIND),dimension(:,:),allocatable  :: maxsnowalb
  real(kind=RKIND),dimension(:,:,:),allocatable:: vegfra
 
+ integer, pointer :: isice_lu, iswater_lu
  integer, pointer :: nCells, nEdges, nVertices, maxEdges
  logical, pointer :: on_a_sphere
  real (kind=RKIND), pointer :: sphere_radius
  
  integer, dimension(:), pointer :: nEdgesOnCell
  integer, dimension(:,:), pointer :: cellsOnCell
+ integer, dimension(:,:), pointer :: verticesOnCell
  real (kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell
  real (kind=RKIND), dimension(:), pointer :: xVertex, yVertex, zVertex
  real (kind=RKIND), dimension(:), pointer :: xEdge, yEdge, zEdge
@@ -92,11 +126,15 @@ subroutine init_atm_static(mesh, dims, configs)
  real (kind=RKIND), dimension(:), pointer :: shdmin, shdmax
  real (kind=RKIND), dimension(:,:), pointer :: greenfrac
  real (kind=RKIND), dimension(:,:), pointer :: albedo12m
+ real (kind=RKIND) :: msgval, fillval
  integer, dimension(:), pointer :: lu_index
  integer, dimension(:), pointer :: soilcat_top
  integer, dimension(:), pointer :: landmask
+ integer, dimension(:), pointer :: bdyMaskCell
  character(len=StrKIND), pointer :: mminlu
 
+ real (kind=RKIND) :: xPixel, yPixel, zPixel
+
 !--------------------------------------------------------------------------------------------------
 
 
@@ -106,6 +144,10 @@ subroutine init_atm_static(mesh, dims, configs)
  call mpas_pool_get_config(configs, 'config_geog_data_path', config_geog_data_path)
  call mpas_pool_get_config(configs, 'config_landuse_data', config_landuse_data)
  call mpas_pool_get_config(configs, 'config_topo_data', config_topo_data)
+ call mpas_pool_get_config(configs, 'config_vegfrac_data', config_vegfrac_data)
+ call mpas_pool_get_config(configs, 'config_albedo_data', config_albedo_data)
+ call mpas_pool_get_config(configs, 'config_maxsnowalbedo_data', config_maxsnowalbedo_data)
+ call mpas_pool_get_config(configs, 'config_supersample_factor', supersample_fac)
 
  write(geog_data_path, '(a)') config_geog_data_path
  i = len_trim(geog_data_path)
@@ -140,13 +182,17 @@ subroutine init_atm_static(mesh, dims, configs)
  call mpas_pool_get_array(mesh, 'lonVertex', lonVertex)
  call mpas_pool_get_array(mesh, 'fEdge', fEdge)
  call mpas_pool_get_array(mesh, 'fVertex', fVertex)
+ call mpas_pool_get_array(mesh, 'bdyMaskCell', bdyMaskCell)
  
  call mpas_pool_get_array(mesh, 'nEdgesOnCell', nEdgesOnCell)
  call mpas_pool_get_array(mesh, 'cellsOnCell', cellsOnCell)
+ call mpas_pool_get_array(mesh, 'verticesOnCell', verticesOnCell)
 
  call mpas_pool_get_array(mesh, 'ter', ter)
  call mpas_pool_get_array(mesh, 'lu_index', lu_index)
  call mpas_pool_get_array(mesh, 'mminlu', mminlu)
+ call mpas_pool_get_array(mesh, 'isice_lu', isice_lu)
+ call mpas_pool_get_array(mesh, 'iswater_lu', iswater_lu)
  call mpas_pool_get_array(mesh, 'soilcat_top', soilcat_top)
  call mpas_pool_get_array(mesh, 'landmask', landmask)
  call mpas_pool_get_array(mesh, 'soiltemp', soiltemp)
@@ -239,6 +285,8 @@ subroutine init_atm_static(mesh, dims, configs)
  nhs(:) = 0
  ter(:) = 0.0
 
+ rarray_ptr = c_loc(rarray)
+
  start_lat = -89.99583
  select case(trim(config_topo_data))
     case('GTOPO30')
@@ -266,8 +314,9 @@ subroutine init_atm_static(mesh, dims, configs)
        write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)//trim(geog_sub_path), &
                     iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
        call mpas_log_write(trim(fname))
+       call mpas_f_to_c_string(fname, c_fname)
 
-       call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+       call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, &
                          scalefactor,wordsize,istatus)
        call init_atm_check_read_error(istatus, fname)
 
@@ -282,8 +331,30 @@ subroutine init_atm_static(mesh, dims, configs)
           iPoint = nearest_cell(lat_pt,lon_pt,iPoint,nCells,maxEdges, &
                                 nEdgesOnCell,cellsOnCell, &
                                 latCell,lonCell)
-          ter(iPoint) = ter(iPoint) + rarray(i,j,1)
-          nhs(iPoint) = nhs(iPoint) + 1
+
+          !
+          ! For all but the outermost boundary cells, we can safely assume that the nearest
+          ! model grid cell contains the pixel (else, a different cell would be nearest)
+          !
+          if (bdyMaskCell(iPoint) < nBdyLayers) then
+             ter(iPoint) = ter(iPoint) + rarray(i,j,1)
+             nhs(iPoint) = nhs(iPoint) + 1
+
+          ! For outermost boundary cells, additional work is needed to verify that the pixel
+          ! actually lies within the nearest cell
+          else
+             zPixel = sphere_radius * sin(lat_pt)                  ! Model cell coordinates assume a "full" sphere radius
+             xPixel = sphere_radius * cos(lon_pt) * cos(lat_pt)    ! at this point, so we need to ues the same radius
+             yPixel = sphere_radius * sin(lon_pt) * cos(lat_pt)    ! for source pixel coordinates
+
+             if (in_cell(xPixel, yPixel, zPixel, xCell(iPoint), yCell(iPoint), zCell(iPoint), &
+                         nEdgesOnCell(iPoint), verticesOnCell(:,iPoint), xVertex, yVertex, zVertex)) then
+
+                ter(iPoint) = ter(iPoint) + rarray(i,j,1)
+                nhs(iPoint) = nhs(iPoint) + 1
+
+             end if
+          end if
        end do
        end do
 
@@ -303,8 +374,10 @@ subroutine init_atm_static(mesh, dims, configs)
 !
  surface_input_select1: select case(trim(config_landuse_data))
     case('USGS')
+       call mpas_log_write('Using 24-class USGS 30-arc-second land cover dataset')
        geog_sub_path = 'landuse_30s/'
     case('MODIFIED_IGBP_MODIS_NOAH')
+       call mpas_log_write('Using 20-class MODIS 30-arc-second land cover dataset')
        geog_sub_path = 'modis_landuse_20class_30s/'
     case default
        call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_ERR)
@@ -326,6 +399,8 @@ subroutine init_atm_static(mesh, dims, configs)
  ncat(:,:) = 0
  lu_index(:) = 0.0
 
+ rarray_ptr = c_loc(rarray)
+
  do jTileStart = 1,20401,ny
     jTileEnd = jTileStart + ny - 1
 
@@ -334,8 +409,9 @@ subroutine init_atm_static(mesh, dims, configs)
        write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// &
              trim(geog_sub_path),iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
        call mpas_log_write(trim(fname))
+       call mpas_f_to_c_string(fname, c_fname)
 
-       call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+       call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, &
                          scalefactor,wordsize,istatus)
        call init_atm_check_read_error(istatus, fname)
 
@@ -355,7 +431,28 @@ subroutine init_atm_static(mesh, dims, configs)
           iPoint = nearest_cell(lat_pt,lon_pt,iPoint,nCells,maxEdges, &
                                 nEdgesOnCell,cellsOnCell, &
                                 latCell,lonCell)
-          ncat(int(rarray(i,j,1)),iPoint) = ncat(int(rarray(i,j,1)),iPoint) + 1
+
+          !
+          ! For all but the outermost boundary cells, we can safely assume that the nearest
+          ! model grid cell contains the pixel (else, a different cell would be nearest)
+          !
+          if (bdyMaskCell(iPoint) < nBdyLayers) then
+             ncat(int(rarray(i,j,1)),iPoint) = ncat(int(rarray(i,j,1)),iPoint) + 1
+
+          ! For outermost boundary cells, additional work is needed to verify that the pixel
+          ! actually lies within the nearest cell
+          else
+             zPixel = sphere_radius * sin(lat_pt)                  ! Model cell coordinates assume a "full" sphere radius
+             xPixel = sphere_radius * cos(lon_pt) * cos(lat_pt)    ! at this point, so we need to ues the same radius
+             yPixel = sphere_radius * sin(lon_pt) * cos(lat_pt)    ! for source pixel coordinates
+
+             if (in_cell(xPixel, yPixel, zPixel, xCell(iPoint), yCell(iPoint), zCell(iPoint), &
+                         nEdgesOnCell(iPoint), verticesOnCell(:,iPoint), xVertex, yVertex, zVertex)) then
+
+                ncat(int(rarray(i,j,1)),iPoint) = ncat(int(rarray(i,j,1)),iPoint) + 1
+
+             end if
+          end if
        end do
        end do
 
@@ -390,6 +487,8 @@ subroutine init_atm_static(mesh, dims, configs)
  ncat(:,:) = 0
  soilcat_top(:) = 0.0
 
+ rarray_ptr = c_loc(rarray)
+
  do jTileStart = 1,20401,ny
     jTileEnd = jTileStart + ny - 1
 
@@ -398,8 +497,9 @@ subroutine init_atm_static(mesh, dims, configs)
        write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// &
              'soiltype_top_30s/',iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
        call mpas_log_write(trim(fname))
+       call mpas_f_to_c_string(fname, c_fname)
 
-       call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+       call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, &
                          scalefactor,wordsize,istatus)
        call init_atm_check_read_error(istatus, fname)
 
@@ -414,7 +514,28 @@ subroutine init_atm_static(mesh, dims, configs)
           iPoint = nearest_cell(lat_pt,lon_pt,iPoint,nCells,maxEdges, &
                                 nEdgesOnCell,cellsOnCell, &
                                 latCell,lonCell)
-          ncat(int(rarray(i,j,1)),iPoint) = ncat(int(rarray(i,j,1)),iPoint) + 1
+
+          !
+          ! For all but the outermost boundary cells, we can safely assume that the nearest
+          ! model grid cell contains the pixel (else, a different cell would be nearest)
+          !
+          if (bdyMaskCell(iPoint) < nBdyLayers) then
+             ncat(int(rarray(i,j,1)),iPoint) = ncat(int(rarray(i,j,1)),iPoint) + 1
+
+          ! For outermost boundary cells, additional work is needed to verify that the pixel
+          ! actually lies within the nearest cell
+          else
+             zPixel = sphere_radius * sin(lat_pt)                  ! Model cell coordinates assume a "full" sphere radius
+             xPixel = sphere_radius * cos(lon_pt) * cos(lat_pt)    ! at this point, so we need to ues the same radius
+             yPixel = sphere_radius * sin(lon_pt) * cos(lat_pt)    ! for source pixel coordinates
+
+             if (in_cell(xPixel, yPixel, zPixel, xCell(iPoint), yCell(iPoint), zCell(iPoint), &
+                         nEdgesOnCell(iPoint), verticesOnCell(:,iPoint), xVertex, yVertex, zVertex)) then
+
+                ncat(int(rarray(i,j,1)),iPoint) = ncat(int(rarray(i,j,1)),iPoint) + 1
+
+             end if
+          end if
        end do
        end do
 
@@ -481,6 +602,8 @@ subroutine init_atm_static(mesh, dims, configs)
  allocate(soiltemp_1deg(-2:363,-2:183))
  soiltemp(:) = 0.0
 
+ rarray_ptr = c_loc(rarray)
+
  call map_set(PROJ_LATLON, proj,  &
               latinc = 1.0_RKIND, &
               loninc = 1.0_RKIND, &
@@ -492,8 +615,9 @@ subroutine init_atm_static(mesh, dims, configs)
  write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// &
        'soiltemp_1deg/',1,'-',180,'.',1,'-',180
  call mpas_log_write(trim(fname))
+ call mpas_f_to_c_string(fname, c_fname)
 
- call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned, endian, &
+ call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned, endian, &
                    scalefactor,wordsize,istatus)
  call init_atm_check_read_error(istatus, fname)
  soiltemp_1deg(-2:180,-2:183) = rarray(1:183,1:186,1)
@@ -501,8 +625,9 @@ subroutine init_atm_static(mesh, dims, configs)
  write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// &
             'soiltemp_1deg/',181,'-',360,'.',1,'-',180
  call mpas_log_write(trim(fname))
+ call mpas_f_to_c_string(fname, c_fname)
 
- call read_geogrid(fname, len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
+ call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, &
                         scalefactor,wordsize,istatus)
  call init_atm_check_read_error(istatus,fname)
  soiltemp_1deg(181:363,-2:183) = rarray(4:186,1:186,1)
@@ -543,1430 +668,591 @@ subroutine init_atm_static(mesh, dims, configs)
 !
 ! Interpolate SNOALB
 !
- nx = 186
- ny = 186
- nz = 1
- isigned     = 0
- endian      = 0
- wordsize    = 1
- scalefactor = 1.0
- allocate(rarray(nx,ny,nz))
- allocate(maxsnowalb(-2:363,-2:183))
- snoalb(:) = 0.0
+ if (trim(config_maxsnowalbedo_data) == 'MODIS') then
 
- call map_set(PROJ_LATLON, proj,  &
-              latinc = 1.0_RKIND, &
-              loninc = 1.0_RKIND, &
-              knowni = 1.0_RKIND, &
-              knownj = 1.0_RKIND, &
-              lat1 = -89.5_RKIND, &
-              lon1 = -179.5_RKIND)
+    call mpas_log_write('Using MODIS 0.05-deg data for maximum snow albedo')
+    if (supersample_fac > 1) then
+       call mpas_log_write('   Dataset will be supersampled by a factor of $i', intArgs=(/supersample_fac/))
+    end if
 
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// &
-       'maxsnowalb/',1,'-',180,'.',1,'-',180
- call mpas_log_write(trim(fname))
+    nx = 1206
+    ny = 1206
+    nz = 1
+    isigned  = 1
+    endian   = 0
+    wordsize = 2
+    scalefactor = 0.01
+    msgval = real(-999.0,kind=R4KIND)*real(0.01,kind=R4KIND)
+    fillval = 0.0
+    allocate(rarray(nx,ny,nz))
+    allocate(nhs(nCells))
+    nhs(:) = 0
+    snoalb(:) = 0.0
+
+    rarray_ptr = c_loc(rarray)
+
+    start_lat = 90.0 - 0.05 * 0.5 / supersample_fac
+    start_lon = -180.0 + 0.05 * 0.5 / supersample_fac
+    geog_sub_path = 'maxsnowalb_modis/'
+
+    do jTileStart = 1,02401,ny-6
+       jTileEnd = jTileStart + ny - 1 - 6
+
+       do iTileStart=1,06001,nx-6
+          iTileEnd = iTileStart + nx - 1 - 6
+          write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)//trim(geog_sub_path), &
+                       iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
+          call mpas_log_write(trim(fname))
+          call mpas_f_to_c_string(fname, c_fname)
+
+          call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, &
+                            scalefactor,wordsize,istatus)
+          call init_atm_check_read_error(istatus, fname)
+
+          iPoint = 1
+          do j=supersample_fac * 3 + 1, supersample_fac * (ny-3)
+          do i=supersample_fac * 3 + 1, supersample_fac * (nx-3)
+             ii = (i - 1) / supersample_fac + 1
+             jj = (j - 1) / supersample_fac + 1
+
+             lat_pt = start_lat - (supersample_fac*(jTileStart-1) + j - (supersample_fac*3+1)) * 0.05 / supersample_fac
+             lon_pt = start_lon + (supersample_fac*(iTileStart-1) + i - (supersample_fac*3+1)) * 0.05 / supersample_fac
+             lat_pt = lat_pt * PI / 180.0
+             lon_pt = lon_pt * PI / 180.0
+
+             iPoint = nearest_cell(lat_pt,lon_pt,iPoint,nCells,maxEdges, &
+                                   nEdgesOnCell,cellsOnCell, &
+                                   latCell,lonCell)
+             if (rarray(ii,jj,1) /= msgval) then
+
+                !
+                ! This field only matters for land cells, and for all but the outermost boundary cells,
+                ! we can safely assume that the nearest model grid cell contains the pixel (else, a different
+                ! cell would be nearest)
+                !
+                if (landmask(iPoint) == 1 .and. bdyMaskCell(iPoint) < nBdyLayers) then
+                   snoalb(iPoint) = snoalb(iPoint) + rarray(ii,jj,1)
+                   nhs(iPoint) = nhs(iPoint) + 1
+
+                ! For outermost land cells, additional work is needed to verify that the pixel
+                ! actually lies within the nearest cell
+                else if (landmask(iPoint) == 1) then
+                   zPixel = sphere_radius * sin(lat_pt)                  ! Model cell coordinates assume a "full" sphere radius
+                   xPixel = sphere_radius * cos(lon_pt) * cos(lat_pt)    ! at this point, so we need to ues the same radius
+                   yPixel = sphere_radius * sin(lon_pt) * cos(lat_pt)    ! for source pixel coordinates
+
+                   if (in_cell(xPixel, yPixel, zPixel, xCell(iPoint), yCell(iPoint), zCell(iPoint), &
+                               nEdgesOnCell(iPoint), verticesOnCell(:,iPoint), xVertex, yVertex, zVertex)) then
+                      snoalb(iPoint) = snoalb(iPoint) + rarray(ii,jj,1)
+                      nhs(iPoint) = nhs(iPoint) + 1
+                   end if
+                end if
+             end if
+          end do
+          end do
 
- call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & 
-                   scalefactor,wordsize,istatus)
- call init_atm_check_read_error(istatus,fname)
- maxsnowalb(-2:180,-2:183) = rarray(1:183,1:186,1)
+       end do
+    end do
 
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// &
-       'maxsnowalb/',181,'-',360,'.',1,'-',180
- call mpas_log_write(trim(fname))
+    do iCell = 1,nCells
+       !
+       ! Mismatches in land mask can lead to MPAS land points with no maximum snow albedo.
+       ! Ideally, we would perform a search for nearby valid albedos, but for now using
+       ! the fill value will at least allow the model to run. In general, the number of cells
+       ! to be treated in this way tends to be a very small fraction of the total number of cells.
+       !
+       if (nhs(iCell) == 0) then
+          snoalb(iCell) = fillval
+       else
+          snoalb(iCell) = snoalb(iCell) / real(nhs(iCell))
+       end if
+       snoalb(iCell) = 0.01_RKIND * snoalb(iCell)        ! Convert from percent to fraction
+    end do
+    deallocate(rarray)
+    deallocate(nhs)
+
+ else if (trim(config_maxsnowalbedo_data) == 'NCEP') then
+
+    call mpas_log_write('Using NCEP 1.0-deg data for maximum snow albedo')
+
+    nx = 186
+    ny = 186
+    nz = 1
+    isigned     = 0
+    endian      = 0
+    wordsize    = 1
+    scalefactor = 1.0
+    allocate(rarray(nx,ny,nz))
+    allocate(maxsnowalb(-2:363,-2:183))
+    snoalb(:) = 0.0
+
+    rarray_ptr = c_loc(rarray)
+
+    call map_set(PROJ_LATLON, proj,  &
+                 latinc = 1.0_RKIND, &
+                 loninc = 1.0_RKIND, &
+                 knowni = 1.0_RKIND, &
+                 knownj = 1.0_RKIND, &
+                 lat1 = -89.5_RKIND, &
+                 lon1 = -179.5_RKIND)
+
+    write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// &
+          'maxsnowalb/',1,'-',180,'.',1,'-',180
+    call mpas_log_write(trim(fname))
+    call mpas_f_to_c_string(fname, c_fname)
+
+    call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, &
+                      scalefactor,wordsize,istatus)
+    call init_atm_check_read_error(istatus,fname)
+    maxsnowalb(-2:180,-2:183) = rarray(1:183,1:186,1)
+
+    write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// &
+          'maxsnowalb/',181,'-',360,'.',1,'-',180
+    call mpas_log_write(trim(fname))
+    call mpas_f_to_c_string(fname, c_fname)
+
+    call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, &
+                      scalefactor,wordsize,istatus)
+    call init_atm_check_read_error(istatus, fname)
+    maxsnowalb(181:363,-2:183) = rarray(4:186,1:186,1)
+
+    interp_list(1) = FOUR_POINT
+    interp_list(2) = W_AVERAGE4
+    interp_list(3) = W_AVERAGE16
+    interp_list(4) = SEARCH
+    interp_list(5) = 0
+
+    do iCell = 1,nCells
+
+       if(landmask(iCell) == 1) then
+          lat = latCell(iCell) * DEG_PER_RAD
+          lon = lonCell(iCell) * DEG_PER_RAD
+          call latlon_to_ij(proj, lat, lon, x, y)
+          if(x < 0.5) then
+             lon = lon + 360.0
+             call latlon_to_ij(proj, lat, lon, x, y)
+          else if (x >= 360.5) then
+             lon = lon - 360.0
+             call latlon_to_ij(proj, lat, lon, x, y)
+          end if
+          if (y < 1.0) y = 1.0
+          if (y > 179.0) y = 179.0
+          snoalb(iCell) = interp_sequence(x,y,1,maxsnowalb,-2,363,-2,183, &
+                                            1,1,0.0_RKIND,interp_list,1)
+       else
+          snoalb(iCell) = 0.0
+       end if
 
- call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
-                   scalefactor,wordsize,istatus)
- call init_atm_check_read_error(istatus, fname)
- maxsnowalb(181:363,-2:183) = rarray(4:186,1:186,1)
+    end do
+    snoalb(:) = snoalb(:) / 100.0
+    deallocate(rarray)
+    deallocate(maxsnowalb)
 
- interp_list(1) = FOUR_POINT
- interp_list(2) = W_AVERAGE4
- interp_list(3) = W_AVERAGE16
- interp_list(4) = SEARCH
- interp_list(5) = 0
+ else
 
- do iCell = 1,nCells
-  
-    if(landmask(iCell) == 1) then
-       lat = latCell(iCell) * DEG_PER_RAD
-       lon = lonCell(iCell) * DEG_PER_RAD
-       call latlon_to_ij(proj, lat, lon, x, y)
-       if(x < 0.5) then
-          lon = lon + 360.0
-          call latlon_to_ij(proj, lat, lon, x, y)
-       else if (x >= 360.5) then
-          lon = lon - 360.0
-          call latlon_to_ij(proj, lat, lon, x, y)
-       end if
-       if (y < 1.0) y = 1.0
-       if (y > 179.0) y = 179.0
-       snoalb(iCell) = interp_sequence(x,y,1,maxsnowalb,-2,363,-2,183, &
-                                         1,1,0.0_RKIND,interp_list,1)
-    else
-       snoalb(iCell) = 0.0
-    end if
+    call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_ERR)
+    call mpas_log_write('Invalid maximum snow albedo dataset '''//trim(config_maxsnowalbedo_data) &
+                                  //''' selected for config_maxsnowalbedo_data',             messageType=MPAS_LOG_ERR)
+    call mpas_log_write('   Possible options are: ''MODIS'', ''NCEP''',                      messageType=MPAS_LOG_ERR)
+    call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_ERR)
+    call mpas_log_write('Please correct the namelist.', messageType=MPAS_LOG_CRIT)
+
+ end if
 
- end do
- snoalb(:) = snoalb(:) / 100.0
- deallocate(rarray)
- deallocate(maxsnowalb)
  call mpas_log_write('--- end interpolate SNOALB')
 
 
 !
 ! Interpolate GREENFRAC
 !
- nx = 1256
- ny = 1256
- nz = 12
- isigned     = 0
- endian      = 0
- wordsize    = 1
- scalefactor = 1.0
- allocate(rarray(nx,ny,nz))
- allocate(vegfra(-2:2503,-2:1253,12))
- greenfrac(:,:) = 0.0
+ if (trim(config_vegfrac_data) == 'MODIS') then
+
+    call mpas_log_write('Using MODIS FPAR 30-arc-second data for climatological monthly vegetation fraction')
+
+    nx = 1200
+    ny = 1200
+    nz = 12
+    isigned  = 0
+    endian   = 0
+    wordsize = 1
+    scalefactor = 1.0
+    msgval = 200.0
+    fillval = 0.0
+    allocate(rarray(nx,ny,nz))
+    allocate(nhs(nCells))
+    nhs(:) = 0
+    greenfrac(:,:) = 0.0
+
+    rarray_ptr = c_loc(rarray)
+
+    start_lat = -89.99583
+    start_lon = -179.99583
+    geog_sub_path = 'greenfrac_fpar_modis/'
+
+    do jTileStart = 1,20401,ny
+       jTileEnd = jTileStart + ny - 1
+
+       do iTileStart=1,42001,nx
+          iTileEnd = iTileStart + nx - 1
+          write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)//trim(geog_sub_path), &
+                       iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
+          call mpas_log_write(trim(fname))
+          call mpas_f_to_c_string(fname, c_fname)
+
+          call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, &
+                            scalefactor,wordsize,istatus)
+          call init_atm_check_read_error(istatus, fname)
+
+          iPoint = 1
+          do j=1,ny
+          do i=1,nx
+             lat_pt = start_lat + (jTileStart + j - 2) * 0.0083333333
+             lon_pt = start_lon + (iTileStart + i - 2) * 0.0083333333
+             lat_pt = lat_pt * PI / 180.0
+             lon_pt = lon_pt * PI / 180.0
+
+             iPoint = nearest_cell(lat_pt,lon_pt,iPoint,nCells,maxEdges, &
+                                   nEdgesOnCell,cellsOnCell, &
+                                   latCell,lonCell)
+
+             !
+             ! This field only matters for land cells, and for all but the outermost boundary cells,
+             ! we can safely assume that the nearest model grid cell contains the pixel (else, a different
+             ! cell would be nearest)
+             !
+             if (landmask(iPoint) == 1 .and. bdyMaskCell(iPoint) < nBdyLayers) then
+                do k=1,nz
+                   if (rarray(i,j,k) == msgval) then
+                      rarray(i,j,k) = fillval
+                   end if
+                   greenfrac(k,iPoint) = greenfrac(k,iPoint) + rarray(i,j,k)
+                end do
+                nhs(iPoint) = nhs(iPoint) + 1
+
+             ! For outermost land cells, additional work is needed to verify that the pixel
+             ! actually lies within the nearest cell
+             else if (landmask(iPoint) == 1) then
+                zPixel = sphere_radius * sin(lat_pt)                  ! Model cell coordinates assume a "full" sphere radius
+                xPixel = sphere_radius * cos(lon_pt) * cos(lat_pt)    ! at this point, so we need to ues the same radius
+                yPixel = sphere_radius * sin(lon_pt) * cos(lat_pt)    ! for source pixel coordinates
+
+                if (in_cell(xPixel, yPixel, zPixel, xCell(iPoint), yCell(iPoint), zCell(iPoint), &
+                            nEdgesOnCell(iPoint), verticesOnCell(:,iPoint), xVertex, yVertex, zVertex)) then
+                   do k=1,nz
+                      if (rarray(i,j,k) == msgval) then
+                         rarray(i,j,k) = fillval
+                      end if
+                      greenfrac(k,iPoint) = greenfrac(k,iPoint) + rarray(i,j,k)
+                   end do
+                   nhs(iPoint) = nhs(iPoint) + 1
+                end if
+             end if
+          end do
+          end do
 
- call map_set(PROJ_LATLON, proj,    &
-              latinc = 0.144_RKIND, &
-              loninc = 0.144_RKIND, &
-              knowni = 1.0_RKIND,   &
-              knownj = 1.0_RKIND,   &
-              lat1 = -89.928_RKIND, &
-              lon1 = -179.928_RKIND)
+       end do
+    end do
 
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// &
-       'greenfrac/',1,'-',1250,'.',1,'-',1250
- call mpas_log_write(trim(fname))
+    do iCell = 1,nCells
+       ! For land points that have no overlap with valid data, and for water points,
+       ! just use the fill value...
+       if (nhs(iCell) == 0) then
+          greenfrac(:,iCell) = fillval
+       else
+          greenfrac(:,iCell) = greenfrac(:,iCell) / real(nhs(iCell))
+       end if
+       shdmin(iCell) = minval(greenfrac(:,iCell))
+       shdmax(iCell) = maxval(greenfrac(:,iCell))
+    end do
+    deallocate(rarray)
+    deallocate(nhs)
+
+ else if (trim(config_vegfrac_data) == 'NCEP') then
+
+    call mpas_log_write('Using NCEP 0.144-deg data for climatological monthly vegetation fraction')
+
+    nx = 1256
+    ny = 1256
+    nz = 12
+    isigned     = 0
+    endian      = 0
+    wordsize    = 1
+    scalefactor = 1.0
+    allocate(rarray(nx,ny,nz))
+    allocate(vegfra(-2:2503,-2:1253,12))
+    greenfrac(:,:) = 0.0
+
+    rarray_ptr = c_loc(rarray)
+
+    call map_set(PROJ_LATLON, proj,    &
+                 latinc = 0.144_RKIND, &
+                 loninc = 0.144_RKIND, &
+                 knowni = 1.0_RKIND,   &
+                 knownj = 1.0_RKIND,   &
+                 lat1 = -89.928_RKIND, &
+                 lon1 = -179.928_RKIND)
+
+    write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// &
+          'greenfrac/',1,'-',1250,'.',1,'-',1250
+    call mpas_log_write(trim(fname))
+    call mpas_f_to_c_string(fname, c_fname)
+
+    call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, &
+                      scalefactor,wordsize,istatus)
+    call init_atm_check_read_error(istatus,fname)
+    vegfra(-2:1250,-2:1253,1:12) = rarray(1:1253,1:1256,1:12)
+
+    write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// &
+          'greenfrac/',1251,'-',2500,'.',1,'-',1250
+    call mpas_log_write(trim(fname))
+    call mpas_f_to_c_string(fname, c_fname)
+
+    call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, &
+                      scalefactor,wordsize,istatus)
+    call init_atm_check_read_error(istatus,fname)
+    vegfra(1251:2503,-2:1253,1:12) = rarray(4:1256,1:1256,1:12)
+
+    do iCell = 1,nCells
+
+       if (landmask(iCell) == 1) then
+          lat = latCell(iCell) * DEG_PER_RAD
+          lon = lonCell(iCell) * DEG_PER_RAD
+          call latlon_to_ij(proj, lat, lon, x, y)
+          if(x < 0.5) then
+             lon = lon + 360.0
+             call latlon_to_ij(proj, lat, lon, x, y)
+          else if(x >= 2500.5) then
+             lon = lon - 360.0
+             call latlon_to_ij(proj, lat, lon, x, y)
+          end if
+          if (y < 1.0) y = 1.0
+          if (y > 1249.0) y = 1249.0
+          do k = 1,12
+             greenfrac(k,iCell) = interp_sequence(x,y,k,vegfra,-2,2503,-2,1253, &
+                                                    1,12,-1.e30_RKIND,interp_list,1)
+          end do
+       else
+          greenfrac(:,iCell) = 0.0
+       end if
+       shdmin(iCell) = minval(greenfrac(:,iCell))
+       shdmax(iCell) = maxval(greenfrac(:,iCell))
 
- call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & 
-                   scalefactor,wordsize,istatus)
- call init_atm_check_read_error(istatus,fname)
- vegfra(-2:1250,-2:1253,1:12) = rarray(1:1253,1:1256,1:12)
+    end do
+    deallocate(rarray)
+    deallocate(vegfra)
 
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// &
-       'greenfrac/',1251,'-',2500,'.',1,'-',1250
- call mpas_log_write(trim(fname))
+ else
 
- call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
-                   scalefactor,wordsize,istatus)
- call init_atm_check_read_error(istatus,fname)
- vegfra(1251:2503,-2:1253,1:12) = rarray(4:1256,1:1256,1:12)
+    call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_ERR)
+    call mpas_log_write('Invalid monthly vegetation fraction dataset '''//trim(config_vegfrac_data) &
+                                  //''' selected for config_vegfrac_data',                   messageType=MPAS_LOG_ERR)
+    call mpas_log_write('   Possible options are: ''MODIS'', ''NCEP''',                      messageType=MPAS_LOG_ERR)
+    call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_ERR)
+    call mpas_log_write('Please correct the namelist.', messageType=MPAS_LOG_CRIT)
 
- do iCell = 1,nCells
+ end if
 
-    if (landmask(iCell) == 1) then
-       lat = latCell(iCell) * DEG_PER_RAD
-       lon = lonCell(iCell) * DEG_PER_RAD
-       call latlon_to_ij(proj, lat, lon, x, y)
-       if(x < 0.5) then
-          lon = lon + 360.0
-          call latlon_to_ij(proj, lat, lon, x, y)
-       else if(x >= 2500.5) then
-          lon = lon - 360.0
-          call latlon_to_ij(proj, lat, lon, x, y)
-       end if
-       if (y < 1.0) y = 1.0
-       if (y > 1249.0) y = 1249.0
-       do k = 1,12
-          greenfrac(k,iCell) = interp_sequence(x,y,k,vegfra,-2,2503,-2,1253, &
-                                                 1,12,-1.e30_RKIND,interp_list,1)
-       end do
-    else
-       greenfrac(:,iCell) = 0.0
-    end if
-    shdmin(iCell) = minval(greenfrac(:,iCell))
-    shdmax(iCell) = maxval(greenfrac(:,iCell))
-      
- end do
- deallocate(rarray)
- deallocate(vegfra)
  call mpas_log_write('--- end interpolate GREENFRAC')
 
 
 !
 ! Interpolate ALBEDO12M
 !
- nx = 1256
- ny = 1256
- nz = 12
- isigned     = 0
- endian      = 0
- wordsize    = 1
- scalefactor = 1.0
- allocate(rarray(nx,ny,nz))
- allocate(vegfra(-2:2503,-2:1253,12))
- albedo12m(:,:) = 0.0
-
- call map_set(PROJ_LATLON, proj,    &
-              latinc = 0.144_RKIND, &
-              loninc = 0.144_RKIND, &
-              knowni = 1.0_RKIND,   &
-              knownj = 1.0_RKIND,   &
-              lat1 = -89.928_RKIND, &
-              lon1 = -179.928_RKIND)
+ if (trim(config_albedo_data) == 'MODIS') then
 
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// &
-       'albedo_ncep/',1,'-',1250,'.',1,'-',1250
- call mpas_log_write(trim(fname))
-
- call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
-                   scalefactor, wordsize, istatus)
- call init_atm_check_read_error(istatus,fname)
- vegfra(-2:1250,-2:1253,1:12) = rarray(1:1253,1:1256,1:12)
+    call mpas_log_write('Using MODIS 0.05-deg data for climatological monthly albedo')
+    if (supersample_fac > 1) then
+       call mpas_log_write('   Dataset will be supersampled by a factor of $i', intArgs=(/supersample_fac/))
+    end if
 
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// &
-       'albedo_ncep/',1251,'-',2500,'.',1,'-',1250
- call mpas_log_write(trim(fname))
+    nx = 1206
+    ny = 1206
+    nz = 12
+    isigned  = 1
+    endian   = 0
+    wordsize = 2
+    scalefactor = 0.01
+    msgval = real(-999.0,kind=R4KIND)*real(0.01,kind=R4KIND)
+    fillval = 8.0
+    allocate(rarray(nx,ny,nz))
+    allocate(nhs(nCells))
+    nhs(:) = 0
+    albedo12m(:,:) = 0.0
+
+    rarray_ptr = c_loc(rarray)
+
+    start_lat = 90.0 - 0.05 * 0.5 / supersample_fac
+    start_lon = -180.0 + 0.05 * 0.5 / supersample_fac
+    geog_sub_path = 'albedo_modis/'
+
+    do jTileStart = 1,02401,ny-6
+       jTileEnd = jTileStart + ny - 1 - 6
+
+       do iTileStart=1,06001,nx-6
+          iTileEnd = iTileStart + nx - 1 - 6
+          write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)//trim(geog_sub_path), &
+                       iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
+          call mpas_log_write(trim(fname))
+          call mpas_f_to_c_string(fname, c_fname)
+
+          call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, &
+                            scalefactor,wordsize,istatus)
+          call init_atm_check_read_error(istatus, fname)
+
+          iPoint = 1
+          do j=supersample_fac * 3 + 1, supersample_fac * (ny-3)
+          do i=supersample_fac * 3 + 1, supersample_fac * (nx-3)
+             ii = (i - 1) / supersample_fac + 1
+             jj = (j - 1) / supersample_fac + 1
+
+             lat_pt = start_lat - (supersample_fac*(jTileStart-1) + j - (supersample_fac*3+1)) * 0.05 / supersample_fac
+             lon_pt = start_lon + (supersample_fac*(iTileStart-1) + i - (supersample_fac*3+1)) * 0.05 / supersample_fac
+             lat_pt = lat_pt * PI / 180.0
+             lon_pt = lon_pt * PI / 180.0
+
+             iPoint = nearest_cell(lat_pt,lon_pt,iPoint,nCells,maxEdges, &
+                                   nEdgesOnCell,cellsOnCell, &
+                                   latCell,lonCell)
+
+             !
+             ! This field only matters for land cells, and for all but the outermost boundary cells,
+             ! we can safely assume that the nearest model grid cell contains the pixel (else, a different
+             ! cell would be nearest)
+             !
+             if (landmask(iPoint) == 1 .and. bdyMaskCell(iPoint) < nBdyLayers) then
+                do k=1,nz
+                   if (rarray(ii,jj,k) == msgval) then
+                      rarray(ii,jj,k) = fillval
+                   end if
+                   albedo12m(k,iPoint) = albedo12m(k,iPoint) + rarray(ii,jj,k)
+                end do
+                nhs(iPoint) = nhs(iPoint) + 1
+
+             ! For outermost land cells, additional work is needed to verify that the pixel
+             ! actually lies within the nearest cell
+             else if (landmask(iPoint) == 1) then
+                zPixel = sphere_radius * sin(lat_pt)                  ! Model cell coordinates assume a "full" sphere radius
+                xPixel = sphere_radius * cos(lon_pt) * cos(lat_pt)    ! at this point, so we need to ues the same radius
+                yPixel = sphere_radius * sin(lon_pt) * cos(lat_pt)    ! for source pixel coordinates
+
+                if (in_cell(xPixel, yPixel, zPixel, xCell(iPoint), yCell(iPoint), zCell(iPoint), &
+                            nEdgesOnCell(iPoint), verticesOnCell(:,iPoint), xVertex, yVertex, zVertex)) then
+                   do k=1,nz
+                      if (rarray(ii,jj,k) == msgval) then
+                         rarray(ii,jj,k) = fillval
+                      end if
+                      albedo12m(k,iPoint) = albedo12m(k,iPoint) + rarray(ii,jj,k)
+                   end do
+                   nhs(iPoint) = nhs(iPoint) + 1
+                end if
+             end if
+          end do
+          end do
 
- call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & 
-                   scalefactor,wordsize,istatus)
- call init_atm_check_read_error(istatus,fname)
- vegfra(1251:2503,-2:1253,1:12) = rarray(4:1256,1:1256,1:12)
-
- do iCell = 1,nCells
+       end do
+    end do
 
-    if (landmask(iCell) == 1) then
-       lat = latCell(iCell) * DEG_PER_RAD
-       lon = lonCell(iCell) * DEG_PER_RAD
-       call latlon_to_ij(proj, lat, lon, x, y)
-       if(x < 0.5) then
-          lon = lon + 360.0
-          call latlon_to_ij(proj, lat, lon, x, y)
-       else if(x >= 2500.5) then
-          lon = lon - 360.0
+    do iCell = 1,nCells
+       ! For land points that have no overlap with valid data, and for water points,
+       ! just use the fill value...
+       if (nhs(iCell) == 0) then
+          albedo12m(:,iCell) = fillval
+       else
+          albedo12m(:,iCell) = albedo12m(:,iCell) / real(nhs(iCell))
+       end if
+       if (lu_index(iCell) == isice_lu) then
+          albedo12m(:,iCell) = 70.0
+       end if
+    end do
+    deallocate(rarray)
+    deallocate(nhs)
+
+ else if (trim(config_albedo_data) == 'NCEP') then
+
+    call mpas_log_write('Using NCEP 0.144-deg data for climatological monthly albedo')
+
+    nx = 1256
+    ny = 1256
+    nz = 12
+    isigned     = 0
+    endian      = 0
+    wordsize    = 1
+    scalefactor = 1.0
+    allocate(rarray(nx,ny,nz))
+    allocate(vegfra(-2:2503,-2:1253,12))
+    albedo12m(:,:) = 0.0
+
+    rarray_ptr = c_loc(rarray)
+
+    call map_set(PROJ_LATLON, proj,    &
+                 latinc = 0.144_RKIND, &
+                 loninc = 0.144_RKIND, &
+                 knowni = 1.0_RKIND,   &
+                 knownj = 1.0_RKIND,   &
+                 lat1 = -89.928_RKIND, &
+                 lon1 = -179.928_RKIND)
+
+    write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// &
+          'albedo_ncep/',1,'-',1250,'.',1,'-',1250
+    call mpas_log_write(trim(fname))
+    call mpas_f_to_c_string(fname, c_fname)
+
+    call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, &
+                      scalefactor, wordsize, istatus)
+    call init_atm_check_read_error(istatus,fname)
+    vegfra(-2:1250,-2:1253,1:12) = rarray(1:1253,1:1256,1:12)
+
+    write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// &
+          'albedo_ncep/',1251,'-',2500,'.',1,'-',1250
+    call mpas_log_write(trim(fname))
+    call mpas_f_to_c_string(fname, c_fname)
+
+    call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, &
+                      scalefactor,wordsize,istatus)
+    call init_atm_check_read_error(istatus,fname)
+    vegfra(1251:2503,-2:1253,1:12) = rarray(4:1256,1:1256,1:12)
+
+    do iCell = 1,nCells
+
+       if (landmask(iCell) == 1) then
+          lat = latCell(iCell) * DEG_PER_RAD
+          lon = lonCell(iCell) * DEG_PER_RAD
           call latlon_to_ij(proj, lat, lon, x, y)
+          if(x < 0.5) then
+             lon = lon + 360.0
+             call latlon_to_ij(proj, lat, lon, x, y)
+          else if(x >= 2500.5) then
+             lon = lon - 360.0
+             call latlon_to_ij(proj, lat, lon, x, y)
+          end if
+          if (y < 1.0) y = 1.0
+          if (y > 1249.0) y = 1249.0
+          do k = 1,12
+             albedo12m(k,iCell) = interp_sequence(x,y,k,vegfra,-2,2503,-2,1253, &
+                                                    1,12,0.0_RKIND,interp_list,1)
+          end do
+       else
+          albedo12m(:,iCell) = 8.0
        end if
-       if (y < 1.0) y = 1.0
-       if (y > 1249.0) y = 1249.0
-       do k = 1,12
-          albedo12m(k,iCell) = interp_sequence(x,y,k,vegfra,-2,2503,-2,1253, &
-                                                 1,12,0.0_RKIND,interp_list,1)
-       end do
-    else
-       albedo12m(:,iCell) = 8.0
-    end if
- end do
- deallocate(rarray)
- deallocate(vegfra)
- call mpas_log_write('--- end interpolate ALBEDO12M')
-
-
- end subroutine init_atm_static
-
-!==================================================================================================
- subroutine init_atm_static_orogwd(mesh, dims, configs)
-!==================================================================================================
-
-!inout arguments:
- type (mpas_pool_type), intent(inout) :: mesh
- type (mpas_pool_type), intent(in) :: dims
- type (mpas_pool_type), intent(in) :: configs
-
-!local variables:
- type(proj_info):: proj
-
- character(len=StrKIND) :: mess
- character(len=StrKIND) :: fname
- character(len=StrKIND) :: dir_gwdo
- character(len=StrKIND), pointer :: config_geog_data_path
- character(len=StrKIND+1) :: geog_data_path      ! same as config_geog_data_path, but guaranteed to have a trailing slash
-
- integer, pointer :: nCells, nEdges, maxEdges
-
- integer, dimension(:), pointer :: nEdgesOnCell
- integer, dimension(:,:), pointer :: cellsOnCell
- integer, dimension(:), pointer :: landmask
-
- integer:: nx,ny,nz
- integer:: endian,isigned,istatus,wordsize
- integer:: i,j
- integer:: iCell,iPoint,iTileStart,iTileEnd,jTileStart,jTileEnd
- integer,dimension(5) :: interp_list
- integer,dimension(:),allocatable:: nhs
-
- real(kind=4):: scalefactor
- real(kind=4),dimension(:,:,:),allocatable:: rarray
-
- real(kind=RKIND):: lat,lon,x,y
- real(kind=RKIND):: lat_pt,lon_pt
- real(kind=RKIND):: dx,dy,known_lat,known_lon,known_x,known_y
- real(kind=RKIND):: minMeshD,maxMeshD
- real(kind=RKIND):: mindcEdge,maxdcEdge
- real(kind=RKIND),dimension(:,:),allocatable:: xarray
-
- real(kind=RKIND), dimension(:), pointer :: latCell, lonCell
- real(kind=RKIND), dimension(:), pointer :: meshDensity
- real(kind=RKIND), dimension(:), pointer :: dcEdge
- real(kind=RKIND), dimension(:), pointer :: varsso
- real(kind=RKIND), dimension(:), pointer :: con, oa1, oa2, oa3, oa4, ol1, ol2, ol3, ol4, var2d
-
-
- call mpas_pool_get_dimension(dims, 'nCells', nCells)
- call mpas_pool_get_dimension(dims, 'nEdges', nEdges)
- call mpas_pool_get_dimension(dims, 'maxEdges', maxEdges)
-
- call mpas_pool_get_array(mesh, 'nEdgesOnCell', nEdgesOnCell)
- call mpas_pool_get_array(mesh, 'cellsOnCell', cellsOnCell)
- call mpas_pool_get_array(mesh, 'landmask', landmask)
- call mpas_pool_get_array(mesh, 'latCell', latCell)
- call mpas_pool_get_array(mesh, 'lonCell', lonCell)
- call mpas_pool_get_array(mesh, 'varsso', varsso)
- call mpas_pool_get_array(mesh, 'meshDensity', meshDensity)
- call mpas_pool_get_array(mesh, 'dcEdge', dcEdge)
- call mpas_pool_get_array(mesh, 'con', con)
- call mpas_pool_get_array(mesh, 'oa1', oa1)
- call mpas_pool_get_array(mesh, 'oa2', oa2)
- call mpas_pool_get_array(mesh, 'oa3', oa3)
- call mpas_pool_get_array(mesh, 'oa4', oa4)
- call mpas_pool_get_array(mesh, 'ol1', ol1)
- call mpas_pool_get_array(mesh, 'ol2', ol2)
- call mpas_pool_get_array(mesh, 'ol3', ol3)
- call mpas_pool_get_array(mesh, 'ol4', ol4)
- call mpas_pool_get_array(mesh, 'var2d', var2d)
-
-
- call mpas_log_write('')
- call mpas_log_write('--- enter subroutine init_atm_static_orogwd:')
-
- call mpas_pool_get_config(configs, 'config_geog_data_path', config_geog_data_path)
-
- write(geog_data_path, '(a)') config_geog_data_path
- i = len_trim(geog_data_path)
- if (geog_data_path(i:i) /= '/') then
-    geog_data_path(i+1:i+1) = '/'
- end if
-
-!
-! Interpolate VARSSO:
- varsso(:) = 0.0_RKIND
- nx = 600
- ny = 600
- nz = 1
- isigned     = 0
- endian      = 0
- wordsize    = 4
- scalefactor = 1.0
-
- dx = 0.00833333
- dy = 0.00833333
- known_x = 1.0
- known_y = 1.0
- known_lat = -59.99583
- known_lon = -179.99583
-  
- allocate(rarray(nx,ny,nz))
- allocate(nhs(nCells))
- nhs(:) = 0
- rarray(:,:,:) = 0._RKIND
- do jTileStart = 1,13801,ny
-    jTileEnd = jTileStart + ny - 1
-
-    do iTileStart = 1,42601,nx
-       iTileEnd = iTileStart + nx -1
-       write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)//'varsso/', &
-             iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
-       call mpas_log_write(trim(fname))
-
-       call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
-                         scalefactor,wordsize,istatus)
-       call init_atm_check_read_error(istatus,fname)
-
-       iPoint = 1
-       do j = 1,ny
-       do i = 1,nx
-          lat_pt = known_lat + (jTileStart + j - 2) * dy
-          lon_pt = known_lon + (iTileStart + i - 2) * dx
-          lat_pt = lat_pt * PI / 180.0
-          lon_pt = lon_pt * PI / 180.0
-
-          iPoint = nearest_cell(lat_pt,lon_pt,iPoint,nCells,maxEdges, &
-                                nEdgesOnCell,cellsOnCell, &
-                                latCell,lonCell)
-          varsso(iPoint) = varsso(iPoint) + rarray(i,j,1)
-          nhs(iPoint) = nhs(iPoint) + 1
-       enddo
-       enddo
-
-    enddo
- enddo
-
- do iCell = 1,nCells
-    if(nhs(iCell) .gt. 0) &
-       varsso(iCell) = varsso(iCell) / real(nhs(iCell))
- enddo
- deallocate(rarray)
- deallocate(nhs)
- call mpas_log_write('--- end interpolate VARSSO')
-
-!... statistic fields needed for the parameterization of gravity wavwe drag over orography. The
-!input directory depends on the mesh resolution, and the mesh must be a uniform mesh.
- minMeshD  = minval(meshDensity(1:nCells))
- maxMeshD  = maxval(meshDensity(1:nCells))
- mindcEdge = minval(dcEdge(1:nEdges))
- maxdcEdge = maxval(dcEdge(1:nEdges))
+    end do
+    deallocate(rarray)
+    deallocate(vegfra)
 
- call mpas_log_write('')
- call mpas_log_write('BEGIN INTERPOLATION OF STATISTICAL FIELDS FOR GRAVITY WAVE DRAG OVER OROGRAPHY')
- call mpas_log_write('min MeshD  = $r', realArgs=(/minMeshD/))
- call mpas_log_write('max MeshD  = $r', realArgs=(/maxMeshD/))
- call mpas_log_write('min dcEdge = $r', realArgs=(/mindcEdge/))
- call mpas_log_write('max dcEdge = $r', realArgs=(/maxdcEdge/))
-
- dir_gwdo = '   '
- if(minMeshD == 1.0_RKIND .and. maxMeshD == 1.0_RKIND) then
-    !... uniform 10242 mesh:
-    if(mindcEdge .ge. 200000._RKIND .and. maxdcEdge .lt. 260000._RKIND) then
-       dir_gwdo = 'orogwd_2deg'
-    elseif(mindcEdge .ge. 90000._RKIND .and. maxdcEdge .lt. 150000_RKIND) then
-       dir_gwdo = 'orogwd_1deg'
-    elseif(mindcEdge .ge. 40000._RKIND .and. maxdcEdge .lt. 70000._RKIND) then
-       dir_gwdo = 'orogwd_30m'
-    else
-       call mpas_log_write('')
-       call mpas_log_write('GWDO: Interpolation not available. Set config_gwdo_scheme = .false.', messageType=MPAS_LOG_WARN)
-       return
-    endif
  else
-    call mpas_log_write('')
-    call mpas_log_write('GWDO: The input mesh must be a uniform mesh. Set config_gwdo_scheme = .false.', messageType=MPAS_LOG_WARN)
-    return
- endif
- call mpas_log_write('dir_gwdo   =    '//trim(dir_gwdo))
- call mpas_log_write('')
-
-!
-! Interpolate CON:
-!
- con(:) = 0.0_RKIND
-
- con_select: select case(dir_gwdo)
-    case("orogwd_2deg")
-       nx = 180
-       ny =  90
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.025
-       dx = 2.0
-       dy = 2.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.0
-       known_lon =   1.0
-    case("orogwd_1deg")
-       nx = 360
-       ny = 180
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.025
-       dx = 1.0
-       dy = 1.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.5
-       known_lon =   0.5
-    case("orogwd_30m")
-       nx = 720
-       ny = 360
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.025
-       dx = 0.5
-       dy = 0.5
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.75
-       known_lon = 0.25
-    case("orogwd_10m")
-       nx = 2160
-       ny = 1080
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.025
-       dx = 0.16666667
-       dy = 0.16666667
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.916667
-       known_lon = 0.0833333
-    case default
- end select con_select
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
-       trim(geog_data_path)//trim(dir_gwdo)//'/con/',1,'-',nx,'.',1,'-',ny
- call mpas_log_write(trim(fname))
-
- allocate(xarray(nx,ny))
- allocate(rarray(nx,ny,nz))
- call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
-                   scalefactor,wordsize,istatus)
- call init_atm_check_read_error(istatus,fname)
- xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
-
- call map_set(PROJ_LATLON, proj,  &
-              latinc = dy,        &
-              loninc = dx,        &
-              knowni = known_x,   &
-              knownj = known_y,   &
-              lat1   = known_lat, &
-              lon1   = known_lon)
-
- interp_list(1) = AVERAGE4
- interp_list(2) = AVERAGE4
- interp_list(3) = AVERAGE4
- interp_list(4) = AVERAGE4
- interp_list(5) = 0
-
- do iCell = 1,nCells
-    if(landmask(iCell) == 1) then
-       lat = latCell(iCell) * DEG_PER_RAD
-       lon = lonCell(iCell) * DEG_PER_RAD
-       call latlon_to_ij(proj, lat, lon, x, y)
-       con(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
-                                    0.0_RKIND,interp_list,1)
-    endif
- enddo
- deallocate(rarray)
- deallocate(xarray)
- call mpas_log_write('--- end interpolate CON')
-
-!
-! Interpolate OA1:
-!
- oa1(:) = 0.0_RKIND
-
- oa1_select: select case(dir_gwdo)
-    case("orogwd_2deg")
-       nx = 180
-       ny =  90
-       nz = 1
-       isigned     = 1
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 2.0
-       dy = 2.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.0
-       known_lon =   1.0
-    case("orogwd_1deg")
-       nx = 360
-       ny = 180
-       nz = 1
-       isigned     = 1
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 1.0
-       dy = 1.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.5
-       known_lon =   0.5
-    case("orogwd_30m")
-       nx = 720
-       ny = 360
-       nz = 1
-       isigned     = 1
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 0.5
-       dy = 0.5
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.75
-       known_lon = 0.25
-    case("orogwd_10m")
-       nx = 2160
-       ny = 1080
-       nz = 1
-       isigned     = 1
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 0.16666667
-       dy = 0.16666667
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.916667
-       known_lon = 0.0833333
-    case default
- end select oa1_select
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
-       trim(geog_data_path)//trim(dir_gwdo)//'/oa1/',1,'-',nx,'.',1,'-',ny
- call mpas_log_write(trim(fname))
-
- allocate(xarray(nx,ny))
- allocate(rarray(nx,ny,nz))
- call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
-                   scalefactor,wordsize,istatus)
- call init_atm_check_read_error(istatus,fname)
- xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
-
- call map_set(PROJ_LATLON, proj,  &
-              latinc = dy,        &
-              loninc = dx,        &
-              knowni = known_x,   &
-              knownj = known_y,   &
-              lat1   = known_lat, &
-              lon1   = known_lon)
-
- interp_list(1) = AVERAGE4
- interp_list(2) = AVERAGE4
- interp_list(3) = AVERAGE4
- interp_list(4) = AVERAGE4
- interp_list(5) = 0
-
- do iCell = 1,nCells
-    if(landmask(iCell) == 1) then
-       lat = latCell(iCell) * DEG_PER_RAD
-       lon = lonCell(iCell) * DEG_PER_RAD
-       call latlon_to_ij(proj, lat, lon, x, y)
-       oa1(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
-                                    0.0_RKIND,interp_list,1)
-    endif
- enddo
- deallocate(rarray)
- deallocate(xarray)
- call mpas_log_write('--- end interpolate OA1')
-
-!
-! Interpolate OA2:
- oa2(:) = 0.0_RKIND
-
- oa2_select: select case(dir_gwdo)
-    case("orogwd_2deg")
-       nx = 180
-       ny =  90
-       nz = 1
-       isigned     = 1
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 2.0
-       dy = 2.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.0
-       known_lon =   1.0
-    case("orogwd_1deg")
-       nx = 360
-       ny = 180
-       nz = 1
-       isigned     = 1
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 1.0
-       dy = 1.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.5
-       known_lon =   0.5
-    case("orogwd_30m")
-       nx = 720
-       ny = 360
-       nz = 1
-       isigned     = 1
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 0.5
-       dy = 0.5
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.75
-       known_lon = 0.25
-    case("orogwd_10m")
-       nx = 2160
-       ny = 1080
-       nz = 1
-       isigned     = 1
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 0.16666667
-       dy = 0.16666667
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.916667
-       known_lon = 0.0833333
-    case default
- end select oa2_select
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
-       trim(geog_data_path)//trim(dir_gwdo)//'/oa2/',1,'-',nx,'.',1,'-',ny
- call mpas_log_write(trim(fname))
-
- allocate(xarray(nx,ny))
- allocate(rarray(nx,ny,nz))
- call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
-                   scalefactor,wordsize,istatus)
- call init_atm_check_read_error(istatus,fname)
- xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
-
- call map_set(PROJ_LATLON, proj,  &
-              latinc = dy,        &
-              loninc = dx,        &
-              knowni = known_x,   &
-              knownj = known_y,   &
-              lat1   = known_lat, &
-              lon1   = known_lon)
-
- interp_list(1) = AVERAGE4
- interp_list(2) = AVERAGE4
- interp_list(3) = AVERAGE4
- interp_list(4) = AVERAGE4
- interp_list(5) = 0
-
- do iCell = 1,nCells
-    if(landmask(iCell) == 1) then
-       lat = latCell(iCell) * DEG_PER_RAD
-       lon = lonCell(iCell) * DEG_PER_RAD
-       call latlon_to_ij(proj, lat, lon, x, y)
-       oa2(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
-                                    0.0_RKIND,interp_list,1)
-     endif
- enddo
- deallocate(rarray)
- deallocate(xarray)
- call mpas_log_write('--- end interpolate OA2')
-
-!
-! Interpolate OA3:
-!
- oa3(:) = 0.0_RKIND
-
- oa3_select: select case(dir_gwdo)
-    case("orogwd_2deg")
-       nx = 180
-       ny =  90
-       nz = 1
-       isigned     = 1
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 2.0
-       dy = 2.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.0
-       known_lon =   1.0
-    case("orogwd_1deg")
-       nx = 360
-       ny = 180
-       nz = 1
-       isigned     = 1
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 1.0
-       dy = 1.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.5
-       known_lon =   0.5
-    case("orogwd_30m")
-       nx = 720
-       ny = 360
-       nz = 1
-       isigned     = 1
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 0.5
-       dy = 0.5
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.75
-       known_lon = 0.25
-    case("orogwd_10m")
-       nx = 2160
-       ny = 1080
-       nz = 1
-       isigned     = 1
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 0.16666667
-       dy = 0.16666667
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.916667
-       known_lon = 0.0833333
-    case default
- end select oa3_select
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
-       trim(geog_data_path)//trim(dir_gwdo)//'/oa3/',1,'-',nx,'.',1,'-',ny
- call mpas_log_write(trim(fname))
-
- allocate(xarray(nx,ny))
- allocate(rarray(nx,ny,nz))
- call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
-                   scalefactor,wordsize,istatus)
- call init_atm_check_read_error(istatus,fname)
- xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
-
- call map_set(PROJ_LATLON, proj,  &
-              latinc = dy,        &
-              loninc = dx,        &
-              knowni = known_x,   &
-              knownj = known_y,   &
-              lat1   = known_lat, &
-              lon1   = known_lon)
-
- interp_list(1) = AVERAGE4
- interp_list(2) = AVERAGE4
- interp_list(3) = AVERAGE4
- interp_list(4) = AVERAGE4
- interp_list(5) = 0
-
- do iCell = 1,nCells
-    if(landmask(iCell) == 1) then
-       lat = latCell(iCell) * DEG_PER_RAD
-       lon = lonCell(iCell) * DEG_PER_RAD
-       call latlon_to_ij(proj, lat, lon, x, y)
-       oa3(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
-                                    0.0_RKIND,interp_list,1)
-    endif
- enddo
- deallocate(rarray)
- deallocate(xarray)
- call mpas_log_write('--- end interpolate OA3')
-
-!
-! Interpolate OA4:
-!
- oa4(:) = 0.0_RKIND
-
- oa4_select: select case(dir_gwdo)
-    case("orogwd_2deg")
-       nx = 180
-       ny =  90
-       nz = 1
-       isigned     = 1
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 2.0
-       dy = 2.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.0
-       known_lon =   1.0
-    case("orogwd_1deg")
-       nx = 360
-       ny = 180
-       nz = 1
-       isigned     = 1
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 1.0
-       dy = 1.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.5
-       known_lon =   0.5
-    case("orogwd_30m")
-       nx = 720
-       ny = 360
-       nz = 1
-       isigned     = 1
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 0.5
-       dy = 0.5
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.75
-       known_lon = 0.25
-    case("orogwd_10m")
-       nx = 2160
-       ny = 1080
-       nz = 1
-       isigned     = 1
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 0.16666667
-       dy = 0.16666667
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.916667
-       known_lon = 0.0833333
-    case default
- end select oa4_select
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
-       trim(geog_data_path)//trim(dir_gwdo)//'/oa4/',1,'-',nx,'.',1,'-',ny
- call mpas_log_write(trim(fname))
-
- allocate(xarray(nx,ny))
- allocate(rarray(nx,ny,nz))
- call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
-                   scalefactor,wordsize,istatus)
- call init_atm_check_read_error(istatus,fname)
- xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
-
- call map_set(PROJ_LATLON, proj,  &
-              latinc = dy,        &
-              loninc = dx,        &
-              knowni = known_x,   &
-              knownj = known_y,   &
-              lat1   = known_lat, &
-              lon1   = known_lon)
-
- interp_list(1) = AVERAGE4
- interp_list(2) = AVERAGE4
- interp_list(3) = AVERAGE4
- interp_list(4) = AVERAGE4
- interp_list(5) = 0
-
- do iCell = 1,nCells
-    if(landmask(iCell) == 1) then
-       lat = latCell(iCell) * DEG_PER_RAD
-       lon = lonCell(iCell) * DEG_PER_RAD
-       call latlon_to_ij(proj, lat, lon, x, y)
-       oa4(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
-                                    0.0_RKIND,interp_list,1)
-    endif
- enddo
- deallocate(rarray)
- deallocate(xarray)
- call mpas_log_write('--- end interpolate OA4')
-
-!
-! Interpolate OL1:
-!
- ol1(:) = 0.0_RKIND
-
- ol1_select: select case(dir_gwdo)
-    case("orogwd_2deg")
-       nx = 180
-       ny =  90
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 2.0
-       dy = 2.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.0
-       known_lon =   1.0
-    case("orogwd_1deg")
-       nx = 360
-       ny = 180
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 1.0
-       dy = 1.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.5
-       known_lon =   0.5
-    case("orogwd_30m")
-       nx = 720
-       ny = 360
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 0.5
-       dy = 0.5
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.75
-       known_lon = 0.25
-    case("orogwd_10m")
-       nx = 2160
-       ny = 1080
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 0.16666667
-       dy = 0.16666667
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.916667
-       known_lon = 0.0833333
-    case default
- end select ol1_select
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
-       trim(geog_data_path)//trim(dir_gwdo)//'/ol1/',1,'-',nx,'.',1,'-',ny
- call mpas_log_write(trim(fname))
-
- allocate(xarray(nx,ny))
- allocate(rarray(nx,ny,nz))
- call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
-                   scalefactor,wordsize,istatus)
- call init_atm_check_read_error(istatus,fname)
- xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
-
- call map_set(PROJ_LATLON, proj,  &
-              latinc = dy,        &
-              loninc = dx,        &
-              knowni = known_x,   &
-              knownj = known_y,   &
-              lat1   = known_lat, &
-              lon1   = known_lon)
-
- interp_list(1) = AVERAGE4
- interp_list(2) = AVERAGE4
- interp_list(3) = AVERAGE4
- interp_list(4) = AVERAGE4
- interp_list(5) = 0
-
- do iCell = 1,nCells
-    if(landmask(iCell) == 1) then
-       lat = latCell(iCell) * DEG_PER_RAD
-       lon = lonCell(iCell) * DEG_PER_RAD
-       call latlon_to_ij(proj, lat, lon, x, y)
-       ol1(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
-                                    0.0_RKIND,interp_list,1)
-    endif
- enddo
- deallocate(rarray)
- deallocate(xarray)
- call mpas_log_write('--- end interpolate OL1')
-
-!
-! Interpolate OL2:
-!
- ol2(:) = 0.0_RKIND
-
- ol2_select: select case(dir_gwdo)
-    case("orogwd_2deg")
-       nx = 180
-       ny =  90
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 2.0
-       dy = 2.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.0
-       known_lon =   1.0
-    case("orogwd_1deg")
-       nx = 360
-       ny = 180
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 1.0
-       dy = 1.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.5
-       known_lon =   0.5
-    case("orogwd_30m")
-       nx = 720
-       ny = 360
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 0.5
-       dy = 0.5
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.75
-       known_lon = 0.25
-    case("orogwd_10m")
-       nx = 2160
-       ny = 1080
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 0.16666667
-       dy = 0.16666667
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.916667
-       known_lon = 0.0833333
-    case default
- end select ol2_select
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
-       trim(geog_data_path)//trim(dir_gwdo)//'/ol2/',1,'-',nx,'.',1,'-',ny
- call mpas_log_write(trim(fname))
-
- allocate(xarray(nx,ny))
- allocate(rarray(nx,ny,nz))
- call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
-                   scalefactor,wordsize,istatus)
- call init_atm_check_read_error(istatus,fname)
- xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
 
- call map_set(PROJ_LATLON, proj,  &
-              latinc = dy,        &
-              loninc = dx,        &
-              knowni = known_x,   &
-              knownj = known_y,   &
-              lat1   = known_lat, &
-              lon1   = known_lon)
-
- interp_list(1) = AVERAGE4
- interp_list(2) = AVERAGE4
- interp_list(3) = AVERAGE4
- interp_list(4) = AVERAGE4
- interp_list(5) = 0
+    call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_ERR)
+    call mpas_log_write('Invalid monthly albedo dataset '''//trim(config_albedo_data) &
+                                  //''' selected for config_albedo_data',                    messageType=MPAS_LOG_ERR)
+    call mpas_log_write('   Possible options are: ''MODIS'', ''NCEP''',                      messageType=MPAS_LOG_ERR)
+    call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_ERR)
+    call mpas_log_write('Please correct the namelist.', messageType=MPAS_LOG_CRIT)
 
- do iCell = 1,nCells
-    if(landmask(iCell) == 1) then
-       lat = latCell(iCell) * DEG_PER_RAD
-       lon = lonCell(iCell) * DEG_PER_RAD
-       call latlon_to_ij(proj, lat, lon, x, y)
-       ol2(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
-                                    0.0_RKIND,interp_list,1)
-    endif
- enddo
- deallocate(rarray)
- deallocate(xarray)
- call mpas_log_write('--- end interpolate OL2')
-
-!
-! Interpolate OL3:
-!
- ol3(:) = 0.0_RKIND
-
- ol3_select: select case(dir_gwdo)
-    case("orogwd_2deg")
-       nx = 180
-       ny =  90
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 2.0
-       dy = 2.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.0
-       known_lon =   1.0
-    case("orogwd_1deg")
-       nx = 360
-       ny = 180
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 1.0
-       dy = 1.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.5
-       known_lon =   0.5
-    case("orogwd_30m")
-       nx = 720
-       ny = 360
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 0.5
-       dy = 0.5
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.75
-       known_lon = 0.25
-    case("orogwd_10m")
-       nx = 2160
-       ny = 1080
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 0.16666667
-       dy = 0.16666667
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.916667
-       known_lon = 0.0833333
-    case default
- end select ol3_select
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
-       trim(geog_data_path)//trim(dir_gwdo)//'/ol3/',1,'-',nx,'.',1,'-',ny
- call mpas_log_write(trim(fname))
-
- allocate(xarray(nx,ny))
- allocate(rarray(nx,ny,nz))
- call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
-                   scalefactor,wordsize,istatus)
- call init_atm_check_read_error(istatus,fname)
- xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
-
- call map_set(PROJ_LATLON, proj,  &
-              latinc = dy,        &
-              loninc = dx,        &
-              knowni = known_x,   &
-              knownj = known_y,   &
-              lat1   = known_lat, &
-              lon1   = known_lon)
-
- interp_list(1) = AVERAGE4
- interp_list(2) = AVERAGE4
- interp_list(3) = AVERAGE4
- interp_list(4) = AVERAGE4
- interp_list(5) = 0
-
- do iCell = 1,nCells
-    if(landmask(iCell) == 1) then
-       lat = latCell(iCell) * DEG_PER_RAD
-       lon = lonCell(iCell) * DEG_PER_RAD
-       call latlon_to_ij(proj, lat, lon, x, y)
-       ol3(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
-                                    0.0_RKIND,interp_list,1)
-    endif
- enddo
- deallocate(rarray)
- deallocate(xarray)
- call mpas_log_write('--- end interpolate OL3')
-
-!
-! Interpolate OL4:
-!
- ol4(:) = 0.0_RKIND
-
- ol4_select: select case(dir_gwdo)
-    case("orogwd_2deg")
-       nx = 180
-       ny =  90
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 2.0
-       dy = 2.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.0
-       known_lon =   1.0
-    case("orogwd_1deg")
-       nx = 360
-       ny = 180
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 1.0
-       dy = 1.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.5
-       known_lon =   0.5
-    case("orogwd_30m")
-       nx = 720
-       ny = 360
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 0.5
-       dy = 0.5
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.75
-       known_lon = 0.25
-    case("orogwd_10m")
-       nx = 2160
-       ny = 1080
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.0001
-       dx = 0.16666667
-       dy = 0.16666667
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.916667
-       known_lon = 0.0833333
-    case default
- end select ol4_select
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
-       trim(geog_data_path)//trim(dir_gwdo)//'/ol4/',1,'-',nx,'.',1,'-',ny
- call mpas_log_write(trim(fname))
-
- allocate(xarray(nx,ny))
- allocate(rarray(nx,ny,nz))
- call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
-                   scalefactor,wordsize,istatus)
- call init_atm_check_read_error(istatus,fname)
- xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
-
- call map_set(PROJ_LATLON, proj,  &
-              latinc = dy,        &
-              loninc = dx,        &
-              knowni = known_x,   &
-              knownj = known_y,   &
-              lat1   = known_lat, &
-              lon1   = known_lon)
-
- interp_list(1) = AVERAGE4
- interp_list(2) = AVERAGE4
- interp_list(3) = AVERAGE4
- interp_list(4) = AVERAGE4
- interp_list(5) = 0
-
- do iCell = 1,nCells
-    if(landmask(iCell) == 1) then
-       lat = latCell(iCell) * DEG_PER_RAD
-       lon = lonCell(iCell) * DEG_PER_RAD
-       call latlon_to_ij(proj, lat, lon, x, y)
-       ol4(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
-                                    0.0_RKIND,interp_list,1)
-    endif
- enddo
- deallocate(rarray)
- deallocate(xarray)
- call mpas_log_write('--- end interpolate OL4')
-
-!
-! Interpolate VAR2D:
-!
- var2d(:) = 0.0_RKIND
-
- var2d_select: select case(dir_gwdo)
-    case("orogwd_2deg")
-       nx = 180
-       ny = 90
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 4
-       scalefactor = 0.02
-       dx = 2.0
-       dy = 2.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.0
-       known_lon =   1.0
-    case("orogwd_1deg")
-       nx = 360
-       ny = 180
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 4
-       scalefactor = 0.02
-       dx = 1.0
-       dy = 1.0
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.5
-       known_lon =   0.5
-    case("orogwd_30m")
-       nx = 720
-       ny = 360
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 4
-       scalefactor = 0.02
-       dx = 0.5
-       dy = 0.5
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.75
-       known_lon = 0.25
-    case("orogwd_10m")
-       nx = 2160
-       ny = 1080
-       nz = 1
-       isigned     = 0
-       endian      = 0
-       wordsize    = 2
-       scalefactor = 0.02
-       dx = 0.16666667
-       dy = 0.16666667
-       known_x = 1.0
-       known_y = 1.0
-       known_lat = -89.916667
-       known_lon = 0.0833333
-    case default
- end select var2d_select
-
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') &
-       trim(geog_data_path)//trim(dir_gwdo)//'/var/',1,'-',nx,'.',1,'-',ny
- call mpas_log_write(trim(fname))
-
-
- allocate(xarray(nx,ny))
- allocate(rarray(nx,ny,nz))
- call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, &
-                   scalefactor,wordsize,istatus)
- call init_atm_check_read_error(istatus,fname)
- xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1)
+ end if
 
- call map_set(PROJ_LATLON, proj,  &
-              latinc = dy,        &
-              loninc = dx,        &
-              knowni = known_x,   &
-              knownj = known_y,   &
-              lat1   = known_lat, &
-              lon1   = known_lon)
-
- interp_list(1) = AVERAGE4
- interp_list(2) = AVERAGE4
- interp_list(3) = AVERAGE4
- interp_list(4) = AVERAGE4
- interp_list(5) = 0
+ call mpas_log_write('--- end interpolate ALBEDO12M')
 
- do iCell = 1,nCells
-    if(landmask(iCell) == 1) then
-       lat = latCell(iCell) * DEG_PER_RAD
-       lon = lonCell(iCell) * DEG_PER_RAD
-       call latlon_to_ij(proj, lat, lon, x, y)
-       var2d(iCell) = interp_sequence(x,y,1,xarray,1,nx,1,ny,1,1, &
-                                      0.0_RKIND,interp_list,1)
-    endif
- enddo
- deallocate(rarray)
- deallocate(xarray)
- call mpas_log_write('--- end interpolate VAR2D')
 
- end subroutine init_atm_static_orogwd
+ end subroutine init_atm_static
 
 !==================================================================================================
  subroutine init_atm_check_read_error(istatus, fname)
@@ -2041,6 +1327,147 @@ real (kind=RKIND) function sphere_distance(lat1, lon1, lat2, lon2, radius)
 
  end function sphere_distance
 
+
+!-----------------------------------------------------------------------
+!  routine mirror_point
+!
+!> \brief Finds the "mirror" of a point about a great-circle arc
+!> \author Michael Duda
+!> \date   7 March 2019
+!> \details
+!>  Given the endpoints of a great-circle arc (A,B) and a point, computes
+!>  the location of the point on the opposite side of the arc along a great-
+!>  circle arc that intersects (A,B) at a right angle, and such that the arc
+!>  between the point and its mirror is bisected by (A,B).
+!>
+!>  Assumptions: A, B, and the point to be reflected all lie on the surface
+!>  of the unit sphere.
+!
+!-----------------------------------------------------------------------
+subroutine mirror_point(xPoint, yPoint, zPoint, xA, yA, zA, xB, yB, zB, xMirror, yMirror, zMirror)
+
+   implicit none
+
+   real(kind=RKIND), intent(in) :: xPoint, yPoint, zPoint
+   real(kind=RKIND), intent(in) :: xA, yA, zA
+   real(kind=RKIND), intent(in) :: xB, yB, zB
+   real(kind=RKIND), intent(out) :: xMirror, yMirror, zMirror
+
+   real(kind=RKIND) :: alpha
+
+   !
+   ! Find the spherical angle between arcs AP and AB (where P is the point to be reflected)
+   !
+   alpha = sphere_angle(xA, yA, zA, xPoint, yPoint, zPoint, xB, yB, zB)
+
+   !
+   ! Rotate the point to be reflected by twice alpha about the vector from the origin to A
+   !
+   call rotate_about_vector(xPoint, yPoint, zPoint, 2.0_RKIND * alpha, 0.0_RKIND, 0.0_RKIND, 0.0_RKIND, &
+                            xA, yA, zA, xMirror, yMirror, zMirror)
+
+end subroutine mirror_point
+
+
+!-----------------------------------------------------------------------
+!  routine rotate_about_vector
+!
+!> \brief Rotates a point about a vector in R3
+!> \author Michael Duda
+!> \date   7 March 2019
+!> \details
+!>  Rotates the point (x,y,z) through an angle theta about the vector
+!>  originating at (a, b, c) and having direction (u, v, w).
+!
+!>  Reference: https://sites.google.com/site/glennmurray/Home/rotation-matrices-and-formulas/rotation-about-an-arbitrary-axis-in-3-dimensions
+!
+!-----------------------------------------------------------------------
+subroutine rotate_about_vector(x, y, z, theta, a, b, c, u, v, w, xp, yp, zp)
+
+   implicit none
+
+   real (kind=RKIND), intent(in) :: x, y, z, theta, a, b, c, u, v, w
+   real (kind=RKIND), intent(out) :: xp, yp, zp
+
+   real (kind=RKIND) :: vw2, uw2, uv2
+   real (kind=RKIND) :: m
+
+   vw2 = v**2.0 + w**2.0
+   uw2 = u**2.0 + w**2.0
+   uv2 = u**2.0 + v**2.0
+   m = sqrt(u**2.0 + v**2.0 + w**2.0)
+
+   xp = (a*vw2 + u*(-b*v-c*w+u*x+v*y+w*z) + ((x-a)*vw2+u*(b*v+c*w-v*y-w*z))*cos(theta) + m*(-c*v+b*w-w*y+v*z)*sin(theta))/m**2.0
+   yp = (b*uw2 + v*(-a*u-c*w+u*x+v*y+w*z) + ((y-b)*uw2+v*(a*u+c*w-u*x-w*z))*cos(theta) + m*( c*u-a*w+w*x-u*z)*sin(theta))/m**2.0
+   zp = (c*uv2 + w*(-a*u-b*v+u*x+v*y+w*z) + ((z-c)*uv2+w*(a*u+b*v-u*x-v*y))*cos(theta) + m*(-b*u+a*v-v*x+u*y)*sin(theta))/m**2.0
+
+end subroutine rotate_about_vector
+
+
+!-----------------------------------------------------------------------
+!  routine in_cell
+!
+!> \brief Determines whether a point is within a Voronoi cell
+!> \author Michael Duda
+!> \date   7 March 2019
+!> \details
+!>  Given a point on the surface of the sphere, the corner points of a Voronoi
+!>  cell, and the generating point for that Voronoi cell, determines whether
+!>  the given point is within the Voronoi cell.
+!
+!-----------------------------------------------------------------------
+logical function in_cell(xPoint, yPoint, zPoint, xCell, yCell, zCell, &
+                         nEdgesOnCell, verticesOnCell, xVertex, yVertex, zVertex)
+
+   use mpas_geometry_utils, only : mpas_arc_length
+
+   implicit none
+
+   real(kind=RKIND), intent(in) :: xPoint, yPoint, zPoint
+   real(kind=RKIND), intent(in) :: xCell, yCell, zCell
+   integer, intent(in) :: nEdgesOnCell
+   integer, dimension(:), intent(in) :: verticesOnCell
+   real(kind=RKIND), dimension(:), intent(in) :: xVertex, yVertex, zVertex
+
+   integer :: i
+   integer :: vtx1, vtx2
+   real(kind=RKIND) :: xNeighbor, yNeighbor, zNeighbor
+   real(kind=RKIND) :: inDist, outDist
+   real(kind=RKIND) :: radius
+   real(kind=RKIND) :: radius_inv
+
+   radius = sqrt(xCell * xCell + yCell * yCell + zCell * zCell)
+   radius_inv = 1.0_RKIND / radius
+
+   inDist = mpas_arc_length(xPoint, yPoint, zPoint, xCell, yCell, zCell)
+
+   in_cell = .true.
+
+   do i=1,nEdgesOnCell
+      vtx1 = verticesOnCell(i)
+      vtx2 = verticesOnCell(mod(i,nEdgesOnCell)+1)
+
+      call mirror_point(xCell*radius_inv, yCell*radius_inv, zCell*radius_inv, &
+                        xVertex(vtx1)*radius_inv, yVertex(vtx1)*radius_inv, zVertex(vtx1)*radius_inv, &
+                        xVertex(vtx2)*radius_inv, yVertex(vtx2)*radius_inv, zVertex(vtx2)*radius_inv, &
+                        xNeighbor, yNeighbor, zNeighbor)
+
+      xNeighbor = xNeighbor * radius
+      yNeighbor = yNeighbor * radius
+      zNeighbor = zNeighbor * radius
+
+      outDist = mpas_arc_length(xPoint, yPoint, zPoint, xNeighbor, yNeighbor, zNeighbor)
+
+      if (outDist < inDist) then
+         in_cell = .false.
+         return
+      end if
+
+   end do
+
+end function in_cell
+
+
 !==================================================================================================
  end module mpas_init_atm_static
 !==================================================================================================
diff --git a/src/core_init_atmosphere/read_geogrid.c b/src/core_init_atmosphere/read_geogrid.c
index ef783e208f..e6ffc6d305 100644
--- a/src/core_init_atmosphere/read_geogrid.c
+++ b/src/core_init_atmosphere/read_geogrid.c
@@ -9,10 +9,6 @@
 
    Sample subroutine to read an array from the geogrid binary format.
 
-   Notes: Depending on the compiler and compiler flags, the name of 
-   the read_geogrid() routine may need to be adjusted with respect
-   to the number of trailing underscores when calling from Fortran.
-
    Michael G. Duda, NCAR/MMM
 */
 
@@ -20,27 +16,43 @@
 #include <stdio.h>
 #include <string.h>
 
-#ifdef UNDERSCORE
-#define read_geogrid read_geogrid_
-#endif
-#ifdef DOUBLEUNDERSCORE
-#define read_geogrid read_geogrid__
-#endif
 
 #define GEOG_BIG_ENDIAN    0
 #define GEOG_LITTLE_ENDIAN 1
 
+/*  In Fortran, use the following as an interface for read_geogrid:
+
+ use iso_c_binding, only : c_char, c_int, c_float, c_ptr, c_loc
+
+ interface
+    subroutine read_geogrid(fname, rarray, nx, ny, nz, isigned, endian, &
+                            scalefactor, wordsize, status) bind(C)
+       use iso_c_binding, only : c_char, c_int, c_float, c_ptr
+       character (c_char), dimension(*), intent(in) :: fname
+       type (c_ptr), value :: rarray
+       integer (c_int), intent(in), value :: nx
+       integer (c_int), intent(in), value :: ny
+       integer (c_int), intent(in), value :: nz
+       integer (c_int), intent(in), value :: isigned
+       integer (c_int), intent(in), value :: endian
+       real (c_float), intent(in), value :: scalefactor
+       integer (c_int), intent(in), value :: wordsize
+       integer (c_int), intent(inout) :: status
+    end subroutine read_geogrid
+ end interface
+
+*/
+
 int read_geogrid(
       char * fname,            /* The name of the file to read from */
-      int * len,               /* The length of the filename */
       float * rarray,          /* The array to be filled */
-      int * nx,                /* x-dimension of the array */
-      int * ny,                /* y-dimension of the array */
-      int * nz,                /* z-dimension of the array */
-      int * isigned,           /* 0=unsigned data, 1=signed data */
-      int * endian,            /* 0=big endian, 1=little endian */
-      float * scalefactor,     /* value to multiply array elements by before truncation to integers */
-      int * wordsize,          /* number of bytes to use for each array element */
+      int nx,                /* x-dimension of the array */
+      int ny,                /* y-dimension of the array */
+      int nz,                /* z-dimension of the array */
+      int isigned,           /* 0=unsigned data, 1=signed data */
+      int endian,            /* 0=big endian, 1=little endian */
+      float scalefactor,     /* value to multiply array elements by before truncation to integers */
+      int wordsize,          /* number of bytes to use for each array element */
       int * status)
 {
    int i, ival, cnt, narray;
@@ -48,27 +60,22 @@ int read_geogrid(
    int A3, B3, C3;
    int A4, B4, C4, D4;
    unsigned char * c;
-   char local_fname[1024];
    FILE * bfile;
 
    *status = 0;
 
-   narray = (*nx) * (*ny) * (*nz);
-
-   /* Make a null-terminated local copy of the filename */
-   strncpy(local_fname,fname,*len);
-   local_fname[*len]='\0';
+   narray = (nx) * (ny) * (nz);
 
    /* Attempt to open file for reading */
-   if (!(bfile = fopen(local_fname,"rb")))
+   if (!(bfile = fopen(fname,"rb")))
    {
       *status = 1;
       return 1;
    }
 
    /* Allocate memory to hold bytes from file and read data */ 
-   c = (unsigned char *)malloc(sizeof(unsigned char)*(*wordsize) * narray);
-   cnt = fread((void *)c, sizeof(unsigned char), narray*(*wordsize), bfile);
+   c = (unsigned char *)malloc(sizeof(unsigned char)* wordsize * narray);
+   cnt = fread((void *)c, sizeof(unsigned char), narray * wordsize, bfile);
  
    fclose(bfile);
 
@@ -83,7 +90,7 @@ int read_geogrid(
       A, B, C, D give the offsets of the LSB through MSB (i.e., for 
       word ABCD, A=MSB, D=LSB) in the array from the beginning of a word 
    */
-   if (*endian == GEOG_BIG_ENDIAN) {
+   if (endian == GEOG_BIG_ENDIAN) {
       A2 = 0; B2 = 1;
       A3 = 0; B3 = 1; C3 = 2;
       A4 = 0; B4 = 1; C4 = 2; D4 = 3;
@@ -95,12 +102,12 @@ int read_geogrid(
    }
 
    /* Convert words from native byte order */
-   switch(*wordsize) {
+   switch(wordsize) {
       case 1:
          for(i=0; i<narray; i++)
          {
             ival = (int)(c[i]);      
-            if ((*isigned) && (ival > (1 << 7))) ival -= (1 << 8);
+            if ((isigned) && (ival > (1 << 7))) ival -= (1 << 8);
             rarray[i] = (float)ival;
          }
          break;
@@ -109,7 +116,7 @@ int read_geogrid(
          for(i=0; i<narray; i++)
          {
             ival = (int)((c[2*i+A2]<<8) | (c[2*i+B2]));      
-            if ((*isigned) && (ival > (1 << 15))) ival -= (1 << 16);
+            if ((isigned) && (ival > (1 << 15))) ival -= (1 << 16);
             rarray[i] = (float)ival;
          }
          break;
@@ -118,7 +125,7 @@ int read_geogrid(
          for(i=0; i<narray; i++)
          {
             ival = (int)((c[3*i+A3]<<16) | (c[3*i+B3]<<8) | c[3*i+C3]);      
-            if ((*isigned) * (ival > (1 << 23))) ival -= (1 << 24);
+            if ((isigned) * (ival > (1 << 23))) ival -= (1 << 24);
             rarray[i] = (float)ival;
          }
          break;
@@ -127,7 +134,7 @@ int read_geogrid(
          for(i=0; i<narray; i++)
          {
             ival = (int)((c[4*i+A4]<<24) | (c[4*i+B4]<<16) | (c[4*i+C4]<<8) | c[4*i+D4]);      
-            if ((*isigned) && (ival > (1 << 31))) ival = -(~ival + 1);
+            if ((isigned) && (ival > (1 << 31))) ival = -(~ival + 1);
             rarray[i] = (float)ival;
          }
          break;
@@ -136,10 +143,10 @@ int read_geogrid(
    free(c);
 
    /* Scale real-valued array by scalefactor */
-   if (*scalefactor != 1.0)
+   if (scalefactor != 1.0)
    {
       for (i=0; i<narray; i++)
-         rarray[i] = rarray[i] * (*scalefactor);
+         rarray[i] = rarray[i] * (scalefactor);
    }
 
    return 0;
diff --git a/src/core_landice/Registry.xml b/src/core_landice/Registry.xml
index ea975e47b9..1e31339959 100644
--- a/src/core_landice/Registry.xml
+++ b/src/core_landice/Registry.xml
@@ -1,5 +1,5 @@
 <?xml version="1.0"?>
-<registry model="mpas" core="landice" core_abbrev="li" version="6.3">
+<registry model="mpas" core="landice" core_abbrev="li" version="7.0">
 
 
 <!-- ======================================================================= -->
diff --git a/src/core_ocean/Registry.xml b/src/core_ocean/Registry.xml
index 3ca267bd4f..fc0649047f 100644
--- a/src/core_ocean/Registry.xml
+++ b/src/core_ocean/Registry.xml
@@ -1,5 +1,5 @@
 <?xml version="1.0"?>
-<registry model="mpas" core="ocean" core_abbrev="ocn" version="6.3">
+<registry model="mpas" core="ocean" core_abbrev="ocn" version="7.0">
 
 	<dims>
 		<dim name="nCells" units="unitless"
diff --git a/src/core_ocean/analysis_members/Registry_lagrangian_particle_tracking.xml b/src/core_ocean/analysis_members/Registry_lagrangian_particle_tracking.xml
index 21ba816f5d..63b797d774 100644
--- a/src/core_ocean/analysis_members/Registry_lagrangian_particle_tracking.xml
+++ b/src/core_ocean/analysis_members/Registry_lagrangian_particle_tracking.xml
@@ -31,6 +31,10 @@
 			description="Number of times to apply filtering operation."
 			possible_values="0, 1, 2, ..."
 		/>
+		<nml_option name="config_AM_lagrPartTrack_timeIntegration" type="integer" default_value="2" units="unitless"
+			 description="type of temporal interpolation with possible_values='EE(1), RK2(2), RK4(4)' as ENUMs"
+			possible_values="1, 2, 4,..."
+		/>
 		<nml_option name="config_AM_lagrPartTrack_reset_criteria" type="character" default_value="none" units="unitless"
 			description="Specify whether particles should not be reset ('none'), be reset on a timer for each particle ('particle_time'), be reset on config_AM_lagrPartTrack_reset_time_globally value ('global_time'), be reset based on regions ('region'), or be reset for all conditions ('all')."
 			possible_values="'none','particle_time','global_time', 'region','all'"
@@ -92,16 +96,11 @@
 			<var name="resetTime"/>
 			<var name="numTimesReset"/>
 			<var name="buoyancyParticle"/>
-			<var name="vertexReconstMethod"/>
-			<var name="horizontalTreatment"/>
 			<var name="verticalTreatment"/>
 			<var name="dtParticle"/>
-			<var name="timeIntegration"/>
 			<var name="indexLevel"/>
 			<var name="cellOwnerBlock"/>
 			<var name="transfered"/>
-			<var name="lonVel"/>
-			<var name="latVel"/>
 			<var name="buoyancySurfaceValues"/>
 			<var name="buoyancySurfaceVelocityMeridional"/>
 			<var name="buoyancySurfaceVelocityZonal"/>
@@ -137,18 +136,10 @@
 			<var name="resetTime"/>
 			<var name="numTimesReset"/>
 			<var name="buoyancyParticle"/>
-			<var name="vertexReconstMethod"/>
-			<var name="horizontalTreatment"/>
 			<var name="verticalTreatment"/>
 			<var name="dtParticle"/>
-			<var name="timeIntegration"/>
 			<var name="indexLevel"/>
 			<var name="transfered"/>
-			<var name="sumU"/>
-			<var name="sumV"/>
-			<var name="sumUU"/>
-			<var name="sumUV"/>
-			<var name="sumVV"/>
 			<var name="buoyancySurfaceValues"/>
 		</stream>
 
@@ -174,11 +165,8 @@
 			<var name="currentCellReset"/>
 			<var name="resetTime"/>
 			<var name="buoyancyParticle"/>
-			<var name="vertexReconstMethod"/>
-			<var name="horizontalTreatment"/>
 			<var name="verticalTreatment"/>
 			<var name="dtParticle"/>
-			<var name="timeIntegration"/>
 			<var name="indexLevel"/>
 			<var name="transfered"/>
 			<var name="buoyancySurfaceValues"/>
@@ -304,15 +292,6 @@
 		<var name="numTimesReset" type ="integer" dimensions="nParticles Time" units="unitless"
 			 description="flag to specify how many times the particle was reset" default_value="0"
 		/>
-		<var name="vertexReconstMethod" type="integer" dimensions="nParticles Time" units="unitless"
-			 description="type of vertex reconstruction method, with possible_values='RBFlinear(1)' as ENUMs"
-		/>
-		<var name="timeIntegration" type="integer" dimensions="nParticles Time" units="unitless"
-			 description="type of temporal interpolation with possible_values='EE(1), RK2(2), RK4(4)' as ENUMs"
-		/>
-		<var name="horizontalTreatment" type="integer" dimensions="nParticles Time" units="unitless"
-			 description="select type of horizontal treatment to be used, with possible_values='wachspress' as ENUMs"
-		/>
 		<var name="verticalTreatment" type="integer" dimensions="nParticles Time" units="unitless"
 			 description="select type of vertical treatment to be used, with possible_values='indexLevel','fixedZLevel','passiveFloat','buoyancySurface','argoFloat' (ENUM)"
 		/>
@@ -328,30 +307,11 @@
 		<var name="transfered" type ="integer" dimensions="nParticles Time" units="unitless"
 			 description="flag to monitor if the particle was transfered"
 		/>
-		<var name="sumU" type="real" dimensions="nParticles Time" units="m s^{-1}"
-			 description="summed velocity: $\sum_i U_i$"
-		/>
-		<var name="sumV" type="real" dimensions="nParticles Time" units="m s^{-1}"
-			 description="summed velocity: $\sum_i V_i$"
-		/>
-		<var name="sumUU" type="real" dimensions="nParticles Time" units="m^2 s^{-2}"
-			 description="summed energy: $\sum_i U*U$"
-		/>
-		<var name="sumUV" type="real" dimensions="nParticles Time" units="m^2 s^{-2}"
-			 description="summed energy: $\sum_i U*V$"
-		/>
-		<var name="sumVV" type="real" dimensions="nParticles Time" units="m^2 s^{-2}"
-			 description="summed energy: $\sum_i V*V$"
-		/>
-		<var name="lonVel" type="real" dimensions="nParticles Time" units="m s^{-1}"
-			 description="u velocity of particle - zonal direction"
-		/>
-		<var name="latVel" type="real" dimensions="nParticles Time" units="m s^{-1}"
-			 description="v velocity of particle - meridional direction"
-		/>
 	</var_struct>
+<!--
 	<var_struct name="lagrPartTrackNonHalo" time_levs="1" packages="lagrPartTrackAMPKG">
 	</var_struct>
+-->
 	<var_struct name="lagrPartTrackScratch" time_levs="1" packages="lagrPartTrackAMPKG">
 		<var name="ucReconstructX" type="real" dimensions="nVertLevels nCells" units="m s^{-1}"
 			 description="reconstructed cell center velocity- x component"
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
index 1ac184bd8c..608f099c65 100644
--- a/src/core_ocean/analysis_members/mpas_ocn_lagrangian_particle_tracking.F
+++ b/src/core_ocean/analysis_members/mpas_ocn_lagrangian_particle_tracking.F
@@ -180,8 +180,8 @@ subroutine ocn_init_lagrangian_particle_tracking(domain, err)!{{{
       LIGHT_DEBUG_WRITE('g_compProcNeighsNearby = ' COMMA g_compProcNeighsNearby)
       !}}}
 
-      ! now set sums for autocorrelation calculation to be zero
-      call zero_autocorrelation_sums(domain)
+!      ! now set sums for autocorrelation calculation to be zero
+!      call zero_autocorrelation_sums(domain)
 
       ! previous compute startup calls
       call intialize_wachspress_coefficients(domain, err)
@@ -260,8 +260,8 @@ subroutine ocn_compute_lagrangian_particle_tracking(domain, timeLevel, err)!{{{
       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), pointer :: xParticle, yParticle, zParticle, buoyancyParticle !, &
+!        lonVel, latVel, 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
@@ -300,7 +300,7 @@ subroutine ocn_compute_lagrangian_particle_tracking(domain, timeLevel, err)!{{{
       real (kind=RKIND) :: diffSubStepVert, diffParticlePositionVert, particleVelocityVert, verticalVelocityInterp
       real (kind=RKIND) :: buoyancyInterp
       real (kind=RKIND), pointer :: sphereRadius
-      integer, pointer :: verticalTreatment, vertexReconstMethod, timeIntegration, indexLevel, filterNum
+      integer, pointer :: verticalTreatment, indexLevel, filterNum, timeIntegration
       character(len=StrKIND), pointer :: config_dt
       type (MPAS_timeInterval_type) :: timeStepESMF
       logical :: resetParticle, resetParticleAny
@@ -322,6 +322,7 @@ subroutine ocn_compute_lagrangian_particle_tracking(domain, timeLevel, err)!{{{
       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_compute_interval', config_AM_lagrPartTrack_compute_interval)
       call mpas_pool_get_config(ocnConfigs, 'config_AM_lagrPartTrack_output_stream', config_AM_lagrPartTrack_output_stream)
+      call mpas_pool_get_config(ocnConfigs, 'config_AM_lagrPartTrack_timeIntegration', timeIntegration)
 
       if (trim(config_AM_lagrPartTrack_reset_criteria) == 'none') then
         config_AM_lagrPartTrack_reset_particles = .False.
@@ -465,21 +466,19 @@ subroutine ocn_compute_lagrangian_particle_tracking(domain, timeLevel, err)!{{{
           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)
+!          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
@@ -746,27 +745,27 @@ subroutine ocn_compute_lagrangian_particle_tracking(domain, timeLevel, err)!{{{
 #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
+!          ! 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
+!          ! 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
@@ -907,35 +906,13 @@ subroutine ocn_restart_lagrangian_particle_tracking(domain, err)!{{{
       ! 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")
 
+        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_timer_start("build_halos_LPT")
-        call mpas_particle_list_build_halos(domain, err, 'ioBlock', g_ioProcNeighs)
-        call mpas_timer_stop("build_halos_LPT")
-        call mpas_timer_start("transfer_particles_LPT")
-        call mpas_particle_list_transfer_particles_from_block_to_named_block(domain, err, .True., .True., 'ioBlock', &
-          g_ioProcNeighs)
-        call mpas_timer_stop("transfer_particles_LPT")
-        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_timer_start("write_halo_LPT")
-        call mpas_particle_list_write_halo_data(domain, err)
-        call mpas_timer_stop("write_halo_LPT")
-        !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_timer_start("remove_block_particles_LPT")
-        call mpas_particle_list_remove_particles_not_on_current_block(domain,err)
-        call mpas_timer_stop("remove_block_particles_LPT")
+
+        ! note, difference here is that nonhalo data may not be needed for
+        ! restart, but including here for now for simplity of the code
+        call write_lagrangian_particle_tracking(domain, err)
 
         LIGHT_DEBUG_WRITE('end ocn_restart_lagrangian_particle_tracking')
         call mpas_timer_stop("restartLPT")
@@ -1016,7 +993,8 @@ subroutine write_lagrangian_particle_tracking(domain, err)!{{{
       ! 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)
+      ! there is not currently any halo data (don't need to communicate for now)
+      !call mpas_particle_list_write_nonhalo_data(domain, err)
 
 #ifdef MPAS_DEBUG
       call mpas_particle_list_test_num_current_particlelist(domain)
@@ -1668,8 +1646,8 @@ subroutine initialize_particle_properties(domain, timeLevel, err)!{{{
       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), pointer :: xParticle, yParticle, zParticle, lonVel, latVel, buoyancyParticle !, &
+!        lonVel, latVel, 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
@@ -1707,7 +1685,7 @@ subroutine initialize_particle_properties(domain, timeLevel, err)!{{{
       real (kind=RKIND) :: diffSubStepVert, diffParticlePositionVert, particleVelocityVert, verticalVelocityInterp
       real (kind=RKIND) :: buoyancyInterp
       real (kind=RKIND), pointer :: sphereRadius
-      integer, pointer :: verticalTreatment, vertexReconstMethod, timeIntegration, indexLevel, filterNum, iCell
+      integer, pointer :: verticalTreatment, indexLevel, filterNum, iCell
 
       err = 0
 
@@ -1768,6 +1746,8 @@ subroutine initialize_particle_properties(domain, timeLevel, err)!{{{
           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)
+          iCell = -1
+
           particlePosition(1) = xParticle
           particlePosition(2) = yParticle
           particlePosition(3) = zParticle
@@ -1775,20 +1755,18 @@ subroutine initialize_particle_properties(domain, timeLevel, err)!{{{
           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)
+!          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)
 
           !}}}
 
@@ -1842,9 +1820,8 @@ subroutine initialize_particle_properties(domain, timeLevel, err)!{{{
 
           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)
+!          ! 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
@@ -2153,52 +2130,52 @@ subroutine velocity_time_interpolation(particleVelocity, particleVelocityVert, &
 
   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 !}}}
+!  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 !}}}
 
 !***********************************************************************
 !
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
index edb8442cda..ecc530918b 100644
--- 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
@@ -181,7 +181,7 @@ subroutine ocn_evaluate_particle_reset_condition(domain, block, particle, dt, iC
      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
+!     real (kind=RKIND), pointer :: sumU, sumV, sumUU, sumUV, sumVV
      integer, pointer :: resetTime
      real (kind=RKIND), pointer :: globalResetTimeValue
 
@@ -301,11 +301,11 @@ subroutine ocn_evaluate_particle_reset_condition(domain, block, particle, dt, iC
        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)
+!       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
@@ -328,12 +328,12 @@ subroutine ocn_evaluate_particle_reset_condition(domain, block, particle, dt, iC
        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
+!       ! 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
 
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 621401731b..fc0aec96ac 100644
--- a/src/core_ocean/analysis_members/mpas_ocn_okubo_weiss.F
+++ b/src/core_ocean/analysis_members/mpas_ocn_okubo_weiss.F
@@ -79,7 +79,7 @@ end subroutine qsort!}}}
    end interface
 
    interface
-      subroutine compute_ev_2(A, wr, wi)!{{{
+      subroutine compute_ev_2(A, wr, wi) bind(C)!{{{
          use iso_c_binding, only: c_double
          real (c_double), dimension(2,2) :: A
          real (c_double), dimension(2) :: wr
@@ -88,7 +88,7 @@ end subroutine compute_ev_2!}}}
    end interface
 
    interface
-      subroutine compute_ev_3(A, wr, wi)!{{{
+      subroutine compute_ev_3(A, wr, wi) bind(C)!{{{
          use iso_c_binding, only: c_double
          real (c_double), dimension(3,3) :: A
          real (c_double), dimension(3) :: wr
diff --git a/src/core_ocean/analysis_members/mpas_ocn_okubo_weiss_eigenvalues.c b/src/core_ocean/analysis_members/mpas_ocn_okubo_weiss_eigenvalues.c
index 8b6783c77b..8ba1c2f5b5 100644
--- a/src/core_ocean/analysis_members/mpas_ocn_okubo_weiss_eigenvalues.c
+++ b/src/core_ocean/analysis_members/mpas_ocn_okubo_weiss_eigenvalues.c
@@ -19,17 +19,30 @@
 !-----------------------------------------------------------------------
 */
 
-#include <math.h>
+/* In Fortran, use the following as an interface for compute_ev_2 and
+ compute_ev_3:
+ 
+ interface
+    subroutine compute_ev_2(A, wr, wi) bind(C)!{{{
+       use iso_c_binding, only: c_double
+       real (c_double), dimension(2,2) :: A
+       real (c_double), dimension(2) :: wr
+       real (c_double), dimension(2) :: wi
+    end subroutine compute_ev_2!}}}
+ end interface
+
+ interface
+    subroutine compute_ev_3(A, wr, wi) bind(C)!{{{
+       use iso_c_binding, only: c_double
+       real (c_double), dimension(3,3) :: A
+       real (c_double), dimension(3) :: wr
+       real (c_double), dimension(3) :: wi
+    end subroutine compute_ev_3!}}}
+ end interface
+
+ */
 
-#ifdef UNDERSCORE
-#define compute_ev_2 compute_ev_2_
-#define compute_ev_3 compute_ev_3_
-#else
-#ifdef DOUBLEUNDERSCORE
-#define compute_ev_2 compute_ev_2__
-#define compute_ev_3 compute_ev_3__
-#endif
-#endif
+#include <math.h>
 
 #ifdef SINGLE_PRECISION
     typedef float real;
diff --git a/src/core_ocean/analysis_members/mpas_ocn_particle_list.F b/src/core_ocean/analysis_members/mpas_ocn_particle_list.F
index 43b9cc4b88..fa63c4e8ff 100644
--- a/src/core_ocean/analysis_members/mpas_ocn_particle_list.F
+++ b/src/core_ocean/analysis_members/mpas_ocn_particle_list.F
@@ -76,16 +76,16 @@ module ocn_particle_list
     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
+!   !(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
+! 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
@@ -99,17 +99,17 @@ module ocn_particle_list
     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
+!   !(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
+! 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
@@ -121,7 +121,7 @@ module ocn_particle_list
   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_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
@@ -181,16 +181,17 @@ subroutine mpas_particle_list_build_and_assign_particle_list(domain,err) !{{{
      call MPI_Barrier(domain % dminfo % comm, err)
 #endif
 
-     ! note that nonhalo data is just initialized with 0
-     ! values are not imported from netCDF input file
-     call read_nonhaloData(domain, err)
+     ! currently there is no nonhalo data
+     !! 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
-     LIGHT_DEBUG_ALL_WRITE('finished read_nonhaloData 1')
-     call MPI_Barrier(domain % dminfo % comm, err)
+     !LIGHT_DEBUG_ALL_WRITE('finished read_nonhaloData 1')
+     !call MPI_Barrier(domain % dminfo % comm, err)
 
-     call mpas_particle_list_test_num_current_particlelist(domain)
-     LIGHT_DEBUG_ALL_WRITE('finished test in mpas_particle_list_build_and_assign_particle_list')
-     call MPI_Barrier(domain % dminfo % comm, err)
+     !call mpas_particle_list_test_num_current_particlelist(domain)
+     !LIGHT_DEBUG_ALL_WRITE('finished test in mpas_particle_list_build_and_assign_particle_list')
+     !call MPI_Barrier(domain % dminfo % comm, err)
 #endif
      !! test to make sure deallocation is ok before transfer...!{{{
 #ifdef MPAS_DEBUG
@@ -198,7 +199,7 @@ subroutine mpas_particle_list_build_and_assign_particle_list(domain,err) !{{{
      call clear_block_particlelists(domain,err)
      call build_block_particlelists(domain, err)
      call read_haloData(domain, err)
-     call read_nonhaloData(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')
@@ -845,16 +846,18 @@ subroutine mpas_particle_list_transfer_particles_from_block_to_named_block(domai
      call mpas_timer_stop("communicate_data_halo_LPT")
      LIGHT_DEBUG_WRITE('finished communicate_particle_halo_data')
 
-     call mpas_timer_start("communicate_data_nonhalo_LPT")
-     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
-     call mpas_timer_stop("communicate_data_nonhalo_LPT")
+     ! note that at present there is no halo data
+     LIGHT_DEBUG_WRITE('there is no halo data to transfer currently')
+     !call mpas_timer_start("communicate_data_nonhalo_LPT")
+     !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
+     !call mpas_timer_stop("communicate_data_nonhalo_LPT")
 
      ! now there should be the complete particles on listPLRecv.  These, however, need moved to the blocks of the processor
      ! for use in calculations
@@ -971,13 +974,13 @@ subroutine mpas_particle_list_write_halo_data(domain, err)!{{{
               ! reorder
               field1DIntPointer % array = Array1DIntPointer(orderingVector)
             else
-              LIGHT_DEBUG_ALL_WRITE("Different field type than implemented in nonHalo write!")
+              LIGHT_DEBUG_ALL_WRITE("Different field type than implemented in Halo 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!"
+                              " in Halo data for write-- don't know what to do!"
             LIGHT_DEBUG_ALL_WRITE(message)
           end if
         end do
@@ -1004,102 +1007,102 @@ end subroutine mpas_particle_list_write_halo_data!}}}
 !>  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!}}}
+!  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!}}}
 
 !-----------------------------------------------------------------------
 !
@@ -1250,33 +1253,33 @@ end subroutine get_halo_data_from_particle_list_1Dreal !}}}
 !> \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 !}}}
+!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 !}}}
 
 !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 !
@@ -1288,38 +1291,38 @@ end subroutine get_nonhalo_data_from_particle_list_1Dint !}}}
 !> \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 !}}}
+!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 !}}}
 
 !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 !
@@ -1331,33 +1334,33 @@ end subroutine get_nonhalo_data_from_particle_list_1Dint_array !}}}
 !> \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 !}}}
+!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 !}}}
 
 !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 !
@@ -1369,38 +1372,38 @@ end subroutine get_nonhalo_data_from_particle_list_1Dreal !}}}
 !> \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 !}}}
+!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 !}}}
 
 !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 !
@@ -1416,33 +1419,33 @@ end subroutine get_nonhalo_data_from_particle_list_1Dreal_array !}}}
 !>  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 !}}}
+!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 !}}}
 
 !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 !
@@ -1635,35 +1638,35 @@ end subroutine add_halo_data_to_particle_list_1Dreal !}}}
 !>  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 !}}}
+!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 !}}}
 
 !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 !
@@ -1679,35 +1682,35 @@ end subroutine add_nonhalo_data_to_particle_list_1Dreal_array !}}}
 !>  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 !}}}
+!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 !}}}
 
 !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 !
@@ -1811,35 +1814,35 @@ end subroutine add_halo_data_to_particle_list_1Dint !}}}
 !>  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 !}}}
+!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 !}}}
 
 !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 !
@@ -1855,35 +1858,35 @@ end subroutine add_nonhalo_data_to_particle_list_1Dint_array !}}}
 !>  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 !}}}
+!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 !}}}
 
 !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 !
@@ -1968,7 +1971,7 @@ subroutine build_new_particlelist(nParticles, particlelist, ioBlock) !{{{
     ! allocate memory for the new particle
     allocate(particle)
     call mpas_pool_create_pool(particle % haloDataPool)
-    call mpas_pool_create_pool(particle % nonhaloDataPool)
+    !call mpas_pool_create_pool(particle % nonhaloDataPool)
     if (present(ioBlock)) then
       allocate(ioBlockfield)
       ioBlockfield % scalar = ioBlock
@@ -1987,7 +1990,7 @@ subroutine build_new_particlelist(nParticles, particlelist, ioBlock) !{{{
       ! allocate memory for the  new particle
       allocate(particle)
       call mpas_pool_create_pool(particle % haloDataPool)
-      call mpas_pool_create_pool(particle % nonhaloDataPool)
+      !call mpas_pool_create_pool(particle % nonhaloDataPool)
       if(present(ioBlock)) then
         allocate(ioBlockfield)
         ioBlockfield % scalar = ioBlock
@@ -2069,9 +2072,9 @@ subroutine destroy_particle(particle) !{{{
     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
+    !if(associated(particle % nonhaloDataPool)) then
+    !  call mpas_pool_destroy_pool(particle % nonhaloDataPool)
+    !end if
     deallocate(particle)
   end if
 
@@ -3223,213 +3226,213 @@ end function find_index !}}}
 !>  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(in) :: 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
-         !print *,  '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)))
-              !print *,  '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)))
-               !print *,  '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) call mpas_log_write('recv: mpi_ierr = ' COMMA mpi_ierr)
-#ifdef _MPI
-          call MPI_WaitAll(numSends, sendRequestID, MPI_STATUSES_IGNORE, mpi_ierr)
-#endif
-          if (mpi_ierr /= 0) call mpas_log_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
-          !call mpas_log_write( '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
-              !print *,  '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') print *,  '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)))
-              !print *,  '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') print *,  '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) call mpas_log_write('mpi_ierr = ' COMMA mpi_ierr)
-#ifdef _MPI
-          call MPI_WaitAll(numSends, sendRequestID, MPI_STATUSES_IGNORE, mpi_ierr)
-#endif
-          if (mpi_ierr /= 0) print *,  'mpi_ierr = ', mpi_ierr
-
-          !do i=1,numProcs
-          !  if(nPartRecv(i) > 0) print *,  '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
-          !call mpas_log_write( 'finished')
-        else
-           !call mpas_log_write( "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!}}}
+!  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(in) :: 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
+!        !print *,  '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)))
+!             !print *,  '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)))
+!              !print *,  '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) call mpas_log_write('recv: mpi_ierr = ' COMMA mpi_ierr)
+!ifdef _MPI
+!         call MPI_WaitAll(numSends, sendRequestID, MPI_STATUSES_IGNORE, mpi_ierr)
+!endif
+!         if (mpi_ierr /= 0) call mpas_log_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
+!         !call mpas_log_write( '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
+!             !print *,  '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') print *,  '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)))
+!             !print *,  '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') print *,  '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) call mpas_log_write('mpi_ierr = ' COMMA mpi_ierr)
+!ifdef _MPI
+!         call MPI_WaitAll(numSends, sendRequestID, MPI_STATUSES_IGNORE, mpi_ierr)
+!endif
+!         if (mpi_ierr /= 0) print *,  'mpi_ierr = ', mpi_ierr
+
+!         !do i=1,numProcs
+!         !  if(nPartRecv(i) > 0) print *,  '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
+!         !call mpas_log_write( 'finished')
+!       else
+!          !call mpas_log_write( "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!}}}
 
 !***********************************************************************
 !
@@ -3710,70 +3713,70 @@ end subroutine communicate_particle_halo_data!}}}
 !>  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 !}}}
+!  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 !}}}
 
 !***********************************************************************
 !
@@ -3942,11 +3945,11 @@ subroutine read_haloData(domain, err)!{{{
                               " 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!
+            !Different type expected in registry for key on_a_sphere in Halo data for read, don't know what to do!
+            !Different type expected in registry for key sphere_radius in Halo data for read, don't know what to do!
+            !Different type expected in registry for key is_periodic in Halo data for read, don't know what to do!
+            !Different type expected in registry for key x_period in Halo data for read, don't know what to do!
+            !Different type expected in registry for key y_period in Halo data for read, don't know what to do!
           end if
         end do
 
@@ -3967,69 +3970,69 @@ end subroutine read_haloData!}}}
 !>  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!}}}
+!  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!}}}
 
 !***********************************************************************
 !
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 12b56f224b..2192533529 100644
--- a/src/core_ocean/mode_forward/mpas_ocn_forward_mode.F
+++ b/src/core_ocean/mode_forward/mpas_ocn_forward_mode.F
@@ -372,6 +372,11 @@ function ocn_forward_mode_init(domain, startTimeStamp) result(ierr)!{{{
 
       endif
 
+      call mpas_dmpar_exch_group_create(domain, 'subcycleFields')
+      call mpas_dmpar_exch_group_add_field(domain, 'subcycleFields', 'sshSubcycle')
+      call mpas_dmpar_exch_group_add_field(domain, 'subcycleFields', 'normalBarotropicVelocitySubcycle')
+      call mpas_dmpar_exch_group_build_reusable_buffers(domain, 'subcycleFields')
+
    end function ocn_forward_mode_init!}}}
 
 !***********************************************************************
@@ -694,6 +699,8 @@ function ocn_forward_mode_finalize(domain) result(iErr)!{{{
 
       integer :: ierr
 
+      call mpas_dmpar_exch_group_destroy_reusable_buffers(domain, 'subcycleFields')
+
       call ocn_analysis_finalize(domain, ierr)
 
       call mpas_destroy_clock(domain % clock, ierr)
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 f85688fd4a..aaabc96c76 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
@@ -124,6 +124,9 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
       logical, pointer :: config_use_standardGM
       logical, pointer :: config_use_cvmix_kpp
       logical, pointer :: config_use_tracerGroup
+      logical, pointer :: config_disable_thick_all_tend
+      logical, pointer :: config_disable_vel_all_tend
+      logical, pointer :: config_disable_tr_all_tend
       real (kind=RKIND), pointer :: config_mom_del4
       character (len=StrKIND), pointer :: config_land_ice_flux_mode
 
@@ -191,6 +194,9 @@ subroutine ocn_time_integrator_rk4(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)
+      call mpas_pool_get_config(domain % configs, 'config_disable_vel_all_tend', config_disable_vel_all_tend)
+      call mpas_pool_get_config(domain % configs, 'config_disable_thick_all_tend', config_disable_thick_all_tend)
+      call mpas_pool_get_config(domain % configs, 'config_disable_tr_all_tend', config_disable_tr_all_tend)
 
       !
       ! Initialize time_levs(2) with state at current time
@@ -353,6 +359,11 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{
       ! BEGIN RK loop
       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       do rk_step = 1, 4
+
+        if (config_disable_thick_all_tend .and. config_disable_vel_all_tend .and. config_disable_tr_all_tend) then
+          exit ! don't compute in loop meant to update velocity, thickness, and tracers
+        end if
+
         call mpas_pool_get_subpool(domain % blocklist % structs, 'diagnostics', diagnosticsPool)
 
         ! Update halos for diagnostic variables.
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 73df467ef0..d94cb0db9b 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
@@ -125,6 +125,7 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
       logical :: activeTracersOnly ! if true only compute tendencies for active tracers  
       integer :: tsIter
       integer :: edgeHaloComputeCounter, cellHaloComputeCounter
+      integer :: neededHalos
 
       ! Config options
       character (len=StrKIND), pointer :: config_time_integrator
@@ -135,6 +136,9 @@ 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_disable_thick_all_tend
+      logical, pointer :: config_disable_vel_all_tend
+      logical, pointer :: config_disable_tr_all_tend
       logical, pointer :: config_use_cvmix_kpp
       logical, pointer :: config_use_tracerGroup
       logical, pointer :: config_compute_active_tracer_budgets
@@ -236,6 +240,9 @@ subroutine ocn_time_integrator_split(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_time_integrator', config_time_integrator)
       call mpas_pool_get_config(domain % configs, 'config_vel_correction', config_vel_correction)
+      call mpas_pool_get_config(domain % configs, 'config_disable_vel_all_tend', config_disable_vel_all_tend)
+      call mpas_pool_get_config(domain % configs, 'config_disable_thick_all_tend', config_disable_thick_all_tend)
+      call mpas_pool_get_config(domain % configs, 'config_disable_tr_all_tend', config_disable_tr_all_tend)
 
       call mpas_pool_get_config(domain % configs, 'config_prescribe_velocity', config_prescribe_velocity)
       call mpas_pool_get_config(domain % configs, 'config_prescribe_thickness', config_prescribe_thickness)
@@ -378,6 +385,11 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
       n_bcl_iter(config_n_ts_iter) = config_n_bcl_iter_end
 
       do split_explicit_step = 1, config_n_ts_iter
+
+         if (config_disable_thick_all_tend .and. config_disable_vel_all_tend .and. config_disable_tr_all_tend) then
+           exit ! don't compute in loop meant to update velocity, thickness, and tracers
+         end if
+
          call mpas_timer_start('se loop')
 
          stage1_tend_time = min(split_explicit_step,2)
@@ -744,12 +756,26 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
             call mpas_pool_get_field(scratchPool, 'btrvel_temp', btrvel_tempField)
             call mpas_allocate_scratch_field(btrvel_tempField, .false.)
 
+            cellHaloComputeCounter = 0
+            edgeHaloComputeCounter = 0
+            neededHalos = 1 + config_n_btr_cor_iter
+
             call mpas_threading_barrier()
 
             call mpas_timer_start('btr se subcycle loop')
             do j = 1, nBtrSubcycles * config_btr_subcycle_loop_factor
-               cellHaloComputeCounter = config_num_halos
-               edgeHaloComputeCounter = config_num_halos + 1
+               if(cellHaloComputeCounter < neededHalos) then
+
+                 call mpas_threading_barrier()
+                 call mpas_timer_start('se halo subcycle')
+                 call mpas_dmpar_exch_group_reuse_halo_exch(domain, subcycleGroupName, timeLevel=oldBtrSubcycleTime)
+                 call mpas_threading_barrier()
+                 call mpas_timer_stop('se halo subcycle')
+
+                 cellHaloComputeCounter = config_num_halos     - mod( config_num_halos, neededHalos )
+                 edgeHaloComputeCounter = config_num_halos + 1 - mod( config_num_halos, neededHalos )
+                 call mpas_threading_barrier()
+               end if
 
                !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                ! Barotropic subcycle: VELOCITY PREDICTOR STEP
@@ -1036,17 +1062,9 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
                    block => block % next
                 end do  ! block
 
-                ! mrp 170503 This is the original line.  Go back to this once I
-                ! verify that halo regions are truly three cells wide.
-                ! if ( edgeHaloComputeCounter == 1 .and. BtrCorIter /= config_n_btr_cor_iter ) then
-                ! replaced with this, to force a halo update on the first iteration:
-                if ( edgeHaloComputeCounter == 1 .or. BtrCorIter == 1 ) then
-                   edgeHaloComputeCounter = config_num_halos + 1
-                   call mpas_timer_start("se halo btr vel corr")
-                   call mpas_dmpar_field_halo_exch(domain, 'normalBarotropicVelocitySubcycle', timeLevel=newBtrSubcycleTime)
-                   call mpas_timer_stop("se halo btr vel corr")
-                else
-                   edgeHaloComputeCounter = edgeHaloComputeCounter - 1
+                edgeHaloComputeCounter = edgeHaloComputeCounter - 1
+                if ( BtrCorIter >= 1 .or. config_btr_solve_SSH2 .eqv. .false.) then
+                  cellHaloComputeCounter = cellHaloComputeCounter - 1
                 end if
 
               end do !do BtrCorIter=1,config_n_btr_cor_iter
@@ -1173,25 +1191,9 @@ subroutine ocn_time_integrator_split(domain, dt)!{{{
 
                    block => block % next
                 end do  ! block
+                edgeHaloComputeCounter = config_num_halos + 1
                endif ! config_btr_solve_SSH2
 
-               !   boundary update on SSHnew
-               call mpas_timer_start("se halo subcycle")
-               call mpas_dmpar_exch_group_create(domain, subcycleGroupName)
-               call mpas_dmpar_exch_group_add_field(domain, subcycleGroupName, 'sshSubcycle', timeLevel=newBtrSubcycleTime)
-               call mpas_dmpar_exch_group_add_field(domain, subcycleGroupName, 'normalBarotropicVelocitySubcycle', &
-                  timeLevel=newBtrSubcycleTime)
-
-               call mpas_threading_barrier()
-               call mpas_dmpar_exch_group_full_halo_exch(domain, subcycleGroupName)
-
-               call mpas_dmpar_exch_group_destroy(domain, subcycleGroupName)
-               call mpas_timer_stop("se halo subcycle")
-
-               ! Reset the halo counters
-               edgeHaloComputeCounter = config_num_halos + 1
-               cellHaloComputeCounter = config_num_halos
-
                !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                ! Barotropic subcycle: Accumulate running sums, advance timestep pointers
                !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
diff --git a/src/core_seaice/Registry.xml b/src/core_seaice/Registry.xml
index b6c9c20a4e..ec09f05f5e 100644
--- a/src/core_seaice/Registry.xml
+++ b/src/core_seaice/Registry.xml
@@ -1,5 +1,5 @@
 <?xml version="1.0"?>
-<registry model="mpas" core="seaice" core_abbrev="seaice" version="6.3">
+<registry model="mpas" core="seaice" core_abbrev="seaice" version="7.0">
 
 	<dims>
 		<dim name="nCells"
diff --git a/src/core_sw/Registry.xml b/src/core_sw/Registry.xml
index cdef47edef..a599b1377a 100644
--- a/src/core_sw/Registry.xml
+++ b/src/core_sw/Registry.xml
@@ -1,5 +1,5 @@
 <?xml version="1.0"?>
-<registry model="mpas" core="sw" core_abbrev="sw" version="6.3">
+<registry model="mpas" core="sw" core_abbrev="sw" version="7.0">
 	<dims>
 		<dim name="nCells"/>
 		<dim name="nEdges"/>
diff --git a/src/core_test/Registry.xml b/src/core_test/Registry.xml
index 066cbe8b80..481f15d4bd 100644
--- a/src/core_test/Registry.xml
+++ b/src/core_test/Registry.xml
@@ -1,5 +1,5 @@
 <?xml version="1.0"?>
-<registry model="mpas" core="test" core_abbrev="test" version="6.3">
+<registry model="mpas" core="test" core_abbrev="test" version="7.0">
 	<dims>
 		<dim name="nCells"/>
 		<dim name="nEdges"/>
diff --git a/src/framework/mpas_attlist_types.inc b/src/framework/mpas_attlist_types.inc
index 0d2652e063..8c664bdcbe 100644
--- a/src/framework/mpas_attlist_types.inc
+++ b/src/framework/mpas_attlist_types.inc
@@ -10,8 +10,8 @@
 
    ! Derived type for holding field attributes
    type att_list_type
-      character (len=StrKIND) :: attName
-      integer :: attType
+      character (len=StrKIND) :: attName = ''
+      integer :: attType = -1
       integer :: attValueInt
       integer, dimension(:), pointer :: attValueIntA => null()
       real (kind=RKIND) :: attValueReal
diff --git a/src/framework/mpas_field_types.inc b/src/framework/mpas_field_types.inc
index 7940728041..2f98f791eb 100644
--- a/src/framework/mpas_field_types.inc
+++ b/src/framework/mpas_field_types.inc
@@ -10,10 +10,10 @@
    type field5DReal
   
       ! Back-pointer to the containing block
-      type (block_type), pointer :: block
+      type (block_type), pointer :: block => null()
 
       ! Raw array holding field data on this block
-      real (kind=RKIND), dimension(:,:,:,:,:), pointer :: array
+      real (kind=RKIND), dimension(:,:,:,:,:), pointer :: array => null()
 
       ! Information used by the I/O layer
       character (len=StrKIND) :: fieldName
@@ -30,12 +30,13 @@
       type (att_lists_type), dimension(:), pointer :: attLists => null()     
 
       ! Pointers to the prev and next blocks for this field on this task
-      type (field5DReal), pointer :: prev, next
+      type (field5DReal), pointer :: prev => null()
+      type (field5DReal), pointer :: next => null()
 
       ! Halo communication lists
-      type (mpas_multihalo_exchange_list), pointer :: sendList
-      type (mpas_multihalo_exchange_list), pointer :: recvList
-      type (mpas_multihalo_exchange_list), pointer :: copyList
+      type (mpas_multihalo_exchange_list), pointer :: sendList => null()
+      type (mpas_multihalo_exchange_list), pointer :: recvList => null()
+      type (mpas_multihalo_exchange_list), pointer :: copyList => null()
    end type field5DReal
 
 
@@ -43,10 +44,10 @@
    type field4DReal
   
       ! Back-pointer to the containing block
-      type (block_type), pointer :: block
+      type (block_type), pointer :: block => null()
 
       ! Raw array holding field data on this block
-      real (kind=RKIND), dimension(:,:,:,:), pointer :: array
+      real (kind=RKIND), dimension(:,:,:,:), pointer :: array => null()
 
       ! Information used by the I/O layer
       character (len=StrKIND) :: fieldName
@@ -63,12 +64,13 @@
       type (att_lists_type), dimension(:), pointer :: attLists => null()     
 
       ! Pointers to the prev and next blocks for this field on this task
-      type (field4DReal), pointer :: prev, next
+      type (field4DReal), pointer :: prev => null()
+      type (field4DReal), pointer :: next => null()
 
       ! Halo communication lists
-      type (mpas_multihalo_exchange_list), pointer :: sendList
-      type (mpas_multihalo_exchange_list), pointer :: recvList
-      type (mpas_multihalo_exchange_list), pointer :: copyList
+      type (mpas_multihalo_exchange_list), pointer :: sendList => null()
+      type (mpas_multihalo_exchange_list), pointer :: recvList => null()
+      type (mpas_multihalo_exchange_list), pointer :: copyList => null()
    end type field4DReal
 
 
@@ -77,10 +79,10 @@
    type field3DReal
   
       ! Back-pointer to the containing block
-      type (block_type), pointer :: block
+      type (block_type), pointer :: block => null()
 
       ! Raw array holding field data on this block
-      real (kind=RKIND), dimension(:,:,:), pointer :: array
+      real (kind=RKIND), dimension(:,:,:), pointer :: array => null()
 
       ! Information used by the I/O layer
       character (len=StrKIND) :: fieldName
@@ -97,12 +99,13 @@
       type (att_lists_type), dimension(:), pointer :: attLists => null()     
 
       ! Pointers to the prev and next blocks for this field on this task
-      type (field3DReal), pointer :: prev, next
+      type (field3DReal), pointer :: prev => null()
+      type (field3DReal), pointer :: next => null()
 
       ! Halo communication lists
-      type (mpas_multihalo_exchange_list), pointer :: sendList
-      type (mpas_multihalo_exchange_list), pointer :: recvList
-      type (mpas_multihalo_exchange_list), pointer :: copyList
+      type (mpas_multihalo_exchange_list), pointer :: sendList => null()
+      type (mpas_multihalo_exchange_list), pointer :: recvList => null()
+      type (mpas_multihalo_exchange_list), pointer :: copyList => null()
    end type field3DReal
 
 
@@ -110,10 +113,10 @@
    type field2DReal
   
       ! Back-pointer to the containing block
-      type (block_type), pointer :: block
+      type (block_type), pointer :: block => null()
 
       ! Raw array holding field data on this block
-      real (kind=RKIND), dimension(:,:), pointer :: array
+      real (kind=RKIND), dimension(:,:), pointer :: array => null()
 
       ! Information used by the I/O layer
       character (len=StrKIND) :: fieldName
@@ -130,12 +133,13 @@
       type (att_lists_type), dimension(:), pointer :: attLists => null()     
 
       ! Pointers to the prev and next blocks for this field on this task
-      type (field2DReal), pointer :: prev, next
+      type (field2DReal), pointer :: prev => null()
+      type (field2DReal), pointer :: next => null()
 
       ! Halo communication lists
-      type (mpas_multihalo_exchange_list), pointer :: sendList
-      type (mpas_multihalo_exchange_list), pointer :: recvList
-      type (mpas_multihalo_exchange_list), pointer :: copyList
+      type (mpas_multihalo_exchange_list), pointer :: sendList => null()
+      type (mpas_multihalo_exchange_list), pointer :: recvList => null()
+      type (mpas_multihalo_exchange_list), pointer :: copyList => null()
    end type field2DReal
 
 
@@ -143,10 +147,10 @@
    type field1DReal
   
       ! Back-pointer to the containing block
-      type (block_type), pointer :: block
+      type (block_type), pointer :: block => null()
 
       ! Raw array holding field data on this block
-      real (kind=RKIND), dimension(:), pointer :: array
+      real (kind=RKIND), dimension(:), pointer :: array => null()
 
       ! Information used by the I/O layer
       character (len=StrKIND) :: fieldName
@@ -163,12 +167,13 @@
       type (att_lists_type), dimension(:), pointer :: attLists => null()     
 
       ! Pointers to the prev and next blocks for this field on this task
-      type (field1DReal), pointer :: prev, next
+      type (field1DReal), pointer :: prev => null()
+      type (field1DReal), pointer :: next => null()
 
       ! Halo communication lists
-      type (mpas_multihalo_exchange_list), pointer :: sendList
-      type (mpas_multihalo_exchange_list), pointer :: recvList
-      type (mpas_multihalo_exchange_list), pointer :: copyList
+      type (mpas_multihalo_exchange_list), pointer :: sendList => null()
+      type (mpas_multihalo_exchange_list), pointer :: recvList => null()
+      type (mpas_multihalo_exchange_list), pointer :: copyList => null()
    end type field1DReal
 
 
@@ -176,7 +181,7 @@
    type field0DReal
   
       ! Back-pointer to the containing block
-      type (block_type), pointer :: block
+      type (block_type), pointer :: block => null()
 
       ! Raw array holding field data on this block
       real (kind=RKIND) :: scalar
@@ -193,12 +198,13 @@
       type (att_lists_type), dimension(:), pointer :: attLists => null()     
 
       ! Pointers to the prev and next blocks for this field on this task
-      type (field0DReal), pointer :: prev, next
+      type (field0DReal), pointer :: prev => null()
+      type (field0DReal), pointer :: next => null()
 
       ! Halo communication lists
-      type (mpas_multihalo_exchange_list), pointer :: sendList
-      type (mpas_multihalo_exchange_list), pointer :: recvList
-      type (mpas_multihalo_exchange_list), pointer :: copyList
+      type (mpas_multihalo_exchange_list), pointer :: sendList => null()
+      type (mpas_multihalo_exchange_list), pointer :: recvList => null()
+      type (mpas_multihalo_exchange_list), pointer :: copyList => null()
    end type field0DReal
 
 
@@ -206,10 +212,10 @@
    type field3DInteger
   
       ! Back-pointer to the containing block
-      type (block_type), pointer :: block
+      type (block_type), pointer :: block => null()
 
       ! Raw array holding field data on this block
-      integer, dimension(:,:,:), pointer :: array
+      integer, dimension(:,:,:), pointer :: array => null()
 
       ! Information used by the I/O layer
       character (len=StrKIND) :: fieldName
@@ -226,12 +232,13 @@
       type (att_lists_type), dimension(:), pointer :: attLists => null()     
 
       ! Pointers to the prev and next blocks for this field on this task
-      type (field3DInteger), pointer :: prev, next
+      type (field3DInteger), pointer :: prev => null()
+      type (field3DInteger), pointer :: next => null()
 
       ! Halo communication lists
-      type (mpas_multihalo_exchange_list), pointer :: sendList
-      type (mpas_multihalo_exchange_list), pointer :: recvList
-      type (mpas_multihalo_exchange_list), pointer :: copyList
+      type (mpas_multihalo_exchange_list), pointer :: sendList => null()
+      type (mpas_multihalo_exchange_list), pointer :: recvList => null()
+      type (mpas_multihalo_exchange_list), pointer :: copyList => null()
    end type field3DInteger
 
 
@@ -239,10 +246,10 @@
    type field2DInteger
   
       ! Back-pointer to the containing block
-      type (block_type), pointer :: block
+      type (block_type), pointer :: block => null()
 
       ! Raw array holding field data on this block
-      integer, dimension(:,:), pointer :: array
+      integer, dimension(:,:), pointer :: array => null()
 
       ! Information used by the I/O layer
       character (len=StrKIND) :: fieldName
@@ -259,12 +266,13 @@
       type (att_lists_type), dimension(:), pointer :: attLists => null()     
 
       ! Pointers to the prev and next blocks for this field on this task
-      type (field2DInteger), pointer :: prev, next
+      type (field2DInteger), pointer :: prev => null()
+      type (field2DInteger), pointer :: next => null()
 
       ! Halo communication lists
-      type (mpas_multihalo_exchange_list), pointer :: sendList
-      type (mpas_multihalo_exchange_list), pointer :: recvList
-      type (mpas_multihalo_exchange_list), pointer :: copyList
+      type (mpas_multihalo_exchange_list), pointer :: sendList => null()
+      type (mpas_multihalo_exchange_list), pointer :: recvList => null()
+      type (mpas_multihalo_exchange_list), pointer :: copyList => null()
    end type field2DInteger
 
 
@@ -272,10 +280,10 @@
    type field1DInteger
   
       ! Back-pointer to the containing block
-      type (block_type), pointer :: block
+      type (block_type), pointer :: block => null()
 
       ! Raw array holding field data on this block
-      integer, dimension(:), pointer :: array
+      integer, dimension(:), pointer :: array => null()
 
       ! Information used by the I/O layer
       character (len=StrKIND) :: fieldName
@@ -292,12 +300,13 @@
       type (att_lists_type), dimension(:), pointer :: attLists => null()     
 
       ! Pointers to the prev and next blocks for this field on this task
-      type (field1DInteger), pointer :: prev, next
+      type (field1DInteger), pointer :: prev => null()
+      type (field1DInteger), pointer :: next => null()
 
       ! Halo communication lists
-      type (mpas_multihalo_exchange_list), pointer :: sendList
-      type (mpas_multihalo_exchange_list), pointer :: recvList
-      type (mpas_multihalo_exchange_list), pointer :: copyList
+      type (mpas_multihalo_exchange_list), pointer :: sendList => null()
+      type (mpas_multihalo_exchange_list), pointer :: recvList => null()
+      type (mpas_multihalo_exchange_list), pointer :: copyList => null()
    end type field1DInteger
 
 
@@ -305,7 +314,7 @@
    type field0DInteger
   
       ! Back-pointer to the containing block
-      type (block_type), pointer :: block
+      type (block_type), pointer :: block => null()
 
       ! Raw array holding field data on this block
       integer :: scalar
@@ -322,12 +331,13 @@
       type (att_lists_type), dimension(:), pointer :: attLists => null()     
 
       ! Pointers to the prev and next blocks for this field on this task
-      type (field0DInteger), pointer :: prev, next
+      type (field0DInteger), pointer :: prev => null()
+      type (field0DInteger), pointer :: next => null()
 
       ! Halo communication lists
-      type (mpas_multihalo_exchange_list), pointer :: sendList
-      type (mpas_multihalo_exchange_list), pointer :: recvList
-      type (mpas_multihalo_exchange_list), pointer :: copyList
+      type (mpas_multihalo_exchange_list), pointer :: sendList => null()
+      type (mpas_multihalo_exchange_list), pointer :: recvList => null()
+      type (mpas_multihalo_exchange_list), pointer :: copyList => null()
    end type field0DInteger
 
 
@@ -335,10 +345,10 @@
    type field1DChar
   
       ! Back-pointer to the containing block
-      type (block_type), pointer :: block
+      type (block_type), pointer :: block => null()
 
       ! Raw array holding field data on this block
-      character (len=StrKIND), dimension(:), pointer :: array
+      character (len=StrKIND), dimension(:), pointer :: array => null()
 
       ! Information used by the I/O layer
       character (len=StrKIND) :: fieldName
@@ -355,12 +365,13 @@
       type (att_lists_type), dimension(:), pointer :: attLists => null()     
 
       ! Pointers to the prev and next blocks for this field on this task
-      type (field1DChar), pointer :: prev, next
+      type (field1DChar), pointer :: prev => null()
+      type (field1DChar), pointer :: next => null()
 
       ! Halo communication lists
-      type (mpas_multihalo_exchange_list), pointer :: sendList
-      type (mpas_multihalo_exchange_list), pointer :: recvList
-      type (mpas_multihalo_exchange_list), pointer :: copyList
+      type (mpas_multihalo_exchange_list), pointer :: sendList => null()
+      type (mpas_multihalo_exchange_list), pointer :: recvList => null()
+      type (mpas_multihalo_exchange_list), pointer :: copyList => null()
    end type field1DChar
 
 
@@ -368,7 +379,7 @@
    type field0DChar
   
       ! Back-pointer to the containing block
-      type (block_type), pointer :: block
+      type (block_type), pointer :: block => null()
 
       ! Raw array holding field data on this block
       character (len=StrKIND) :: scalar
@@ -385,12 +396,13 @@
       type (att_lists_type), dimension(:), pointer :: attLists => null()     
 
       ! Pointers to the prev and next blocks for this field on this task
-      type (field0DChar), pointer :: prev, next
+      type (field0DChar), pointer :: prev => null()
+      type (field0DChar), pointer :: next => null()
 
       ! Halo communication lists
-      type (mpas_multihalo_exchange_list), pointer :: sendList
-      type (mpas_multihalo_exchange_list), pointer :: recvList
-      type (mpas_multihalo_exchange_list), pointer :: copyList
+      type (mpas_multihalo_exchange_list), pointer :: sendList => null()
+      type (mpas_multihalo_exchange_list), pointer :: recvList => null()
+      type (mpas_multihalo_exchange_list), pointer :: copyList => null()
    end type field0DChar
 
 
@@ -398,7 +410,7 @@
    type field0DLogical
   
       ! Back-pointer to the containing block
-      type (block_type), pointer :: block
+      type (block_type), pointer :: block => null()
 
       ! Raw array holding field data on this block
       logical :: scalar
@@ -415,11 +427,12 @@
       type (att_lists_type), dimension(:), pointer :: attLists => null()     
 
       ! Pointers to the prev and next blocks for this field on this task
-      type (field0DLogical), pointer :: prev, next
+      type (field0DLogical), pointer :: prev => null()
+      type (field0DLogical), pointer :: next => null()
 
       ! Halo communication lists
-      type (mpas_multihalo_exchange_list), pointer :: sendList
-      type (mpas_multihalo_exchange_list), pointer :: recvList
-      type (mpas_multihalo_exchange_list), pointer :: copyList
+      type (mpas_multihalo_exchange_list), pointer :: sendList => null()
+      type (mpas_multihalo_exchange_list), pointer :: recvList => null()
+      type (mpas_multihalo_exchange_list), pointer :: copyList => null()
    end type field0DLogical
 
diff --git a/src/framework/mpas_pool_routines.F b/src/framework/mpas_pool_routines.F
index 6d99e56be3..c362c770d8 100644
--- a/src/framework/mpas_pool_routines.F
+++ b/src/framework/mpas_pool_routines.F
@@ -710,7 +710,7 @@ recursive subroutine mpas_pool_clone_pool(srcPool, destPool, overrideTimeLevels)
                         deallocate(newmem % data % r0)
                      end do
 
-                     do j = minTimeLevels, newmem % data % contentsTimeLevs
+                     do j = minTimeLevels+1, newmem % data % contentsTimeLevs
                         call mpas_duplicate_field(dptr % r0a(dptr % contentsTimeLevs), newmem % data % r0)
                         newmem % data % r0a(j) = newmem % data % r0
                         deallocate(newmem % data % r0)
@@ -728,7 +728,7 @@ recursive subroutine mpas_pool_clone_pool(srcPool, destPool, overrideTimeLevels)
                         deallocate(newmem % data % r1)
                      end do
 
-                     do j = minTimeLevels, newmem % data % contentsTimeLevs
+                     do j = minTimeLevels+1, newmem % data % contentsTimeLevs
                         call mpas_duplicate_field(dptr % r1a(dptr % contentsTimeLevs), newmem % data % r1)
                         newmem % data % r1a(j) = newmem % data % r1
                         deallocate(newmem % data % r1)
@@ -746,7 +746,7 @@ recursive subroutine mpas_pool_clone_pool(srcPool, destPool, overrideTimeLevels)
                         deallocate(newmem % data % r2)
                      end do
 
-                     do j = minTimeLevels, newmem % data % contentsTimeLevs
+                     do j = minTimeLevels+1, newmem % data % contentsTimeLevs
                         call mpas_duplicate_field(dptr % r2a(dptr % contentsTimeLevs), newmem % data % r2)
                         newmem % data % r2a(j) = newmem % data % r2
                         deallocate(newmem % data % r2)
@@ -764,7 +764,7 @@ recursive subroutine mpas_pool_clone_pool(srcPool, destPool, overrideTimeLevels)
                         deallocate(newmem % data % r3)
                      end do
 
-                     do j = minTimeLevels, newmem % data % contentsTimeLevs
+                     do j = minTimeLevels+1, newmem % data % contentsTimeLevs
                         call mpas_duplicate_field(dptr % r3a(dptr % contentsTimeLevs), newmem % data % r3)
                         newmem % data % r3a(j) = newmem % data % r3
                         deallocate(newmem % data % r3)
@@ -782,7 +782,7 @@ recursive subroutine mpas_pool_clone_pool(srcPool, destPool, overrideTimeLevels)
                         deallocate(newmem % data % r4)
                      end do
 
-                     do j = minTimeLevels, newmem % data % contentsTimeLevs
+                     do j = minTimeLevels+1, newmem % data % contentsTimeLevs
                         call mpas_duplicate_field(dptr % r4a(dptr % contentsTimeLevs), newmem % data % r4)
                         newmem % data % r4a(j) = newmem % data % r4
                         deallocate(newmem % data % r4)
@@ -800,7 +800,7 @@ recursive subroutine mpas_pool_clone_pool(srcPool, destPool, overrideTimeLevels)
                         deallocate(newmem % data % r5)
                      end do
 
-                     do j = minTimeLevels, newmem % data % contentsTimeLevs
+                     do j = minTimeLevels+1, newmem % data % contentsTimeLevs
                         call mpas_duplicate_field(dptr % r5a(dptr % contentsTimeLevs), newmem % data % r5)
                         newmem % data % r5a(j) = newmem % data % r5
                         deallocate(newmem % data % r5)
@@ -818,7 +818,7 @@ recursive subroutine mpas_pool_clone_pool(srcPool, destPool, overrideTimeLevels)
                         deallocate(newmem % data % i0)
                      end do
 
-                     do j = minTimeLevels, newmem % data % contentsTimeLevs
+                     do j = minTimeLevels+1, newmem % data % contentsTimeLevs
                         call mpas_duplicate_field(dptr % i0a(dptr % contentsTimeLevs), newmem % data % i0)
                         newmem % data % i0a(j) = newmem % data % i0
                         deallocate(newmem % data % i0)
@@ -836,7 +836,7 @@ recursive subroutine mpas_pool_clone_pool(srcPool, destPool, overrideTimeLevels)
                         deallocate(newmem % data % i1)
                      end do
 
-                     do j = minTimeLevels, newmem % data % contentsTimeLevs
+                     do j = minTimeLevels+1, newmem % data % contentsTimeLevs
                         call mpas_duplicate_field(dptr % i1a(dptr % contentsTimeLevs), newmem % data % i1)
                         newmem % data % i1a(j) = newmem % data % i1
                         deallocate(newmem % data % i1)
@@ -854,7 +854,7 @@ recursive subroutine mpas_pool_clone_pool(srcPool, destPool, overrideTimeLevels)
                         deallocate(newmem % data % i2)
                      end do
 
-                     do j = minTimeLevels, newmem % data % contentsTimeLevs
+                     do j = minTimeLevels+1, newmem % data % contentsTimeLevs
                         call mpas_duplicate_field(dptr % i2a(dptr % contentsTimeLevs), newmem % data % i2)
                         newmem % data % i2a(j) = newmem % data % i2
                         deallocate(newmem % data % i2)
@@ -872,7 +872,7 @@ recursive subroutine mpas_pool_clone_pool(srcPool, destPool, overrideTimeLevels)
                         deallocate(newmem % data % i3)
                      end do
 
-                     do j = minTimeLevels, newmem % data % contentsTimeLevs
+                     do j = minTimeLevels+1, newmem % data % contentsTimeLevs
                         call mpas_duplicate_field(dptr % i3a(dptr % contentsTimeLevs), newmem % data % i3)
                         newmem % data % i3a(j) = newmem % data % i3
                         deallocate(newmem % data % i3)
@@ -890,7 +890,7 @@ recursive subroutine mpas_pool_clone_pool(srcPool, destPool, overrideTimeLevels)
                         deallocate(newmem % data % c0)
                      end do
 
-                     do j = minTimeLevels, newmem % data % contentsTimeLevs
+                     do j = minTimeLevels+1, newmem % data % contentsTimeLevs
                         call mpas_duplicate_field(dptr % c0a(dptr % contentsTimeLevs), newmem % data % c0)
                         newmem % data % c0a(j) = newmem % data % c0
                         deallocate(newmem % data % c0)
@@ -908,7 +908,7 @@ recursive subroutine mpas_pool_clone_pool(srcPool, destPool, overrideTimeLevels)
                         deallocate(newmem % data % c1)
                      end do
 
-                     do j = minTimeLevels, newmem % data % contentsTimeLevs
+                     do j = minTimeLevels+1, newmem % data % contentsTimeLevs
                         call mpas_duplicate_field(dptr % c1a(dptr % contentsTimeLevs), newmem % data % c1)
                         newmem % data % c1a(j) = newmem % data % c1
                         deallocate(newmem % data % c1)
@@ -926,7 +926,7 @@ recursive subroutine mpas_pool_clone_pool(srcPool, destPool, overrideTimeLevels)
                         deallocate(newmem % data % l0)
                      end do
 
-                     do j = minTimeLevels, newmem % data % contentsTimeLevs
+                     do j = minTimeLevels+1, newmem % data % contentsTimeLevs
                         call mpas_duplicate_field(dptr % l0a(dptr % contentsTimeLevs), newmem % data % l0)
                         newmem % data % l0a(j) = newmem % data % l0
                         deallocate(newmem % data % l0)
@@ -3271,7 +3271,7 @@ subroutine mpas_pool_get_field_info(inPool, key, info)!{{{
       info % isActive = .false.
 
       endl = len_trim(key)
-      call pool_hash(hash, key, endl)
+      call pool_hash(hash, key)
 
       hash = mod(hash, inPool % size) + 1
 
@@ -5703,7 +5703,7 @@ logical function pool_add_member(inPool, key, newmem)!{{{
       integer :: hash, oldLevel
       type (mpas_pool_member_type), pointer :: ptr
 
-      call pool_hash(hash, trim(newmem % key), newmem % keylen)
+      call pool_hash(hash, trim(newmem % key))
 
       hash = mod(hash, inPool % size) + 1
 
@@ -5762,7 +5762,7 @@ function pool_get_member(inPool, key, memType)!{{{
       nullify(pool_get_member)
 
       endl = len_trim(key)
-      call pool_hash(hash, key, endl)
+      call pool_hash(hash, key)
 
       hash = mod(hash, inPool % size) + 1
 
@@ -5797,7 +5797,7 @@ logical function pool_remove_member(inPool, key, memType)!{{{
       threadNum = mpas_threading_get_thread_num()
 
       endl = len_trim(key)
-      call pool_hash(hash, key, endl)
+      call pool_hash(hash, key)
 
       hash = mod(hash, inPool % size) + 1
 
@@ -5992,5 +5992,30 @@ integer function pool_get_member_decomp_type(dimName) result(decompType)!{{{
 
    end function pool_get_member_decomp_type!}}}
 
+   subroutine pool_hash(hash, key)!{{{
+
+      use iso_c_binding, only : c_int, c_char
+      use mpas_c_interfacing, only : mpas_f_to_c_string
+
+      implicit none
+
+      interface
+        subroutine c_pool_hash(hash, key) bind(c)
+           use iso_c_binding, only : c_int, c_char
+           integer (c_int), intent(inout) :: hash
+           character (c_char), dimension(*), intent(in) :: key
+        end subroutine c_pool_hash
+      end interface
+
+      integer (c_int), intent(inout) :: hash
+      character(len=*), intent(in) :: key
+
+      character(kind=c_char), dimension(StrKIND+1) :: c_key
+
+      call mpas_f_to_c_string(key, c_key)
+      call c_pool_hash(hash, c_key)
+
+   end subroutine pool_hash!}}}
+
 
 end module mpas_pool_routines
diff --git a/src/framework/mpas_stream_manager.F b/src/framework/mpas_stream_manager.F
index a74c0d643e..757327dbef 100644
--- a/src/framework/mpas_stream_manager.F
+++ b/src/framework/mpas_stream_manager.F
@@ -104,6 +104,11 @@ subroutine MPAS_stream_mgr_init(manager, ioContext, clock, allFields, allPackage
 
         implicit none
 
+        interface
+          subroutine seed_random() bind(c)
+          end subroutine seed_random
+        end interface
+
         character (len=*), parameter :: sub = 'MPAS_stream_mgr_init'
 
         type (MPAS_streamManager_type), pointer :: manager
@@ -3042,6 +3047,8 @@ end subroutine MPAS_stream_mgr_block_write !}}}
     !-----------------------------------------------------------------------
     subroutine write_stream(manager, stream, blockID, timeLevel, mgLevel, forceWritenow, writeTime, ierr) !{{{
 
+        use mpas_dmpar, only : IO_NODE
+
         implicit none
 
         type (MPAS_streamManager_type), intent(inout) :: manager
@@ -3149,7 +3156,10 @@ subroutine write_stream(manager, stream, blockID, timeLevel, mgLevel, forceWrite
                    STREAM_DEBUG_WRITE(' -- Cobber mode is overwrite or append...')
     
                    ! Check if the file exists
-                   inquire(file=trim(stream % filename), exist=recordSeek)
+                   if (manager % ioContext % dminfo % my_proc_id == IO_NODE) then
+                       inquire(file=trim(stream % filename), exist=recordSeek)
+                   end if
+                   call mpas_dmpar_bcast_logical(manager % ioContext % dminfo, recordSeek)
                end if
 
                !
@@ -3232,7 +3242,10 @@ subroutine write_stream(manager, stream, blockID, timeLevel, mgLevel, forceWrite
                        STREAM_DEBUG_WRITE(' -- Cobber mode is overwrite or append...')
            
                        ! Check if the file exists
-                       inquire(file=trim(stream % filename), exist=recordSeek)
+                       if (manager % ioContext % dminfo % my_proc_id == IO_NODE) then
+                           inquire(file=trim(stream % filename), exist=recordSeek)
+                       end if
+                       call mpas_dmpar_bcast_logical(manager % ioContext % dminfo, recordSeek)
                    end if
 
                    stream % nRecords = 1
@@ -3543,6 +3556,8 @@ end subroutine MPAS_stream_mgr_read !}}}
     !-----------------------------------------------------------------------
     subroutine read_stream(manager, stream, timeLevel, mgLevel, forceReadNow, when, whence, actualWhen, ierr) !{{{
 
+        use mpas_dmpar, only : IO_NODE
+
         implicit none
 
         type (MPAS_streamManager_type), intent(inout) :: manager
@@ -3808,13 +3823,18 @@ subroutine read_stream(manager, stream, timeLevel, mgLevel, forceReadNow, when,
 
               STREAM_DEBUG_WRITE(' --- Retesting filename is ' // trim(test_filename))
 
-              inquire(file=trim(test_filename), exist=retestFile)
+              if (manager % ioContext % dminfo % my_proc_id == IO_NODE) then
+                 inquire(file=trim(test_filename), exist=retestFile)
+              end if
+              call mpas_dmpar_bcast_logical(manager % ioContext % dminfo, retestFile)
 
               ! If file exists, the testing stream needs to be built.
               if ( retestFile ) then
                   call mpas_createStream(testStream, manager % ioContext, test_filename, stream % io_type, MPAS_IO_READ, precision=stream % precision, ierr=local_ierr)
               else
                   STREAM_DEBUG_WRITE(' Filename: ' // trim(test_filename) // ' does not exist.')
+                  ierr = MPAS_STREAM_MGR_ERROR
+                  return
               end if
            end if
 
@@ -4148,8 +4168,19 @@ end subroutine mpas_build_stream_filename !}}}
     !-----------------------------------------------------------------------
     subroutine build_stream(stream, direction, allFields, allPackages, timeLevelIn, mgLevelIn, ierr) !{{{
 
+        use iso_c_binding, only : c_int, c_char
+        use mpas_c_interfacing, only : mpas_c_to_f_string
+
         implicit none
 
+        interface
+          subroutine gen_random(len, id) bind(c)
+             use iso_c_binding, only : c_int, c_char
+             integer (c_int), intent(in), value :: len
+             character (c_char), dimension(*), intent(inout) :: id
+          end subroutine gen_random
+        end interface
+
         type (MPAS_stream_list_type), intent(inout) :: stream
         integer, intent(in) :: direction
         type (MPAS_Pool_type), intent(in) :: allFields
@@ -4184,8 +4215,9 @@ subroutine build_stream(stream, direction, allFields, allPackages, timeLevelIn,
 
         integer :: local_ierr
 
-        integer, parameter :: idLength = 10
-        character (len=idLength) :: file_id
+        integer (c_int), parameter :: idLength = 10
+        character(len=idLength) :: f_file_id
+        character(kind=c_char), dimension(idLength+1) :: c_file_id
 
         character (len=StrKIND), pointer :: packages
         logical :: active_field
@@ -4228,8 +4260,9 @@ subroutine build_stream(stream, direction, allFields, allPackages, timeLevelIn,
             !
             ! Generate file_id and write to stream
             !
-            call gen_random(idLength, file_id)
-            call mpas_writeStreamAtt(stream % stream, 'file_id', file_id, syncVal=.true., ierr=local_ierr)
+            call gen_random(idLength, c_file_id)
+            call mpas_c_to_f_string(c_file_id, f_file_id)
+            call mpas_writeStreamAtt(stream % stream, 'file_id', f_file_id, syncVal=.true., ierr=local_ierr)
             if (local_ierr /= MPAS_STREAM_NOERR) then
                 ierr = MPAS_STREAM_MGR_ERROR
                 return
@@ -4787,6 +4820,10 @@ subroutine prewrite_reindex(allFields, streamFields) !{{{
 
         implicit none
 
+        integer, parameter :: UNUSED_CELL = 0
+        integer, parameter :: UNUSED_EDGE = 0
+        integer, parameter :: UNUSED_VERTEX = 0
+
         type (mpas_pool_type), pointer :: allFields
         type (mpas_pool_type), pointer :: streamFields
 
@@ -4909,7 +4946,7 @@ subroutine prewrite_reindex(allFields, streamFields) !{{{
                            cellsOnCell % array(j,i) = indexToCellID % array(cellsOnCell_ptr % array(j,i))
                        end do
 
-                       cellsOnCell % array(nEdgesOnCell%array(i)+1:maxEdges,i) = nCells+1
+                       cellsOnCell % array(nEdgesOnCell%array(i)+1:maxEdges,i) = UNUSED_CELL
                    end do
 
                    cellsOnCell => cellsOnCell % next
@@ -4929,7 +4966,7 @@ subroutine prewrite_reindex(allFields, streamFields) !{{{
                            edgesOnCell % array(j,i) = indexToEdgeID % array(edgesOnCell_ptr % array(j,i))
                        end do
 
-                       edgesOnCell % array(nEdgesOnCell%array(i)+1:maxEdges,i) = nEdges+1
+                       edgesOnCell % array(nEdgesOnCell%array(i)+1:maxEdges,i) = UNUSED_EDGE
                    end do
 
                    edgesOnCell => edgesOnCell % next
@@ -4949,7 +4986,7 @@ subroutine prewrite_reindex(allFields, streamFields) !{{{
                            verticesOnCell % array(j,i) = indexToVertexID % array(verticesOnCell_ptr % array(j,i))
                        end do
 
-                       verticesOnCell % array(nEdgesOnCell%array(i)+1:maxEdges,i) = nVertices+1
+                       verticesOnCell % array(nEdgesOnCell%array(i)+1:maxEdges,i) = UNUSED_VERTEX
                    end do
 
                    verticesOnCell => verticesOnCell % next
@@ -5003,7 +5040,7 @@ subroutine prewrite_reindex(allFields, streamFields) !{{{
                            edgesOnEdge % array(j,i) = indexToEdgeID % array(edgesOnEdge_ptr % array(j,i))
                        end do
 
-                       edgesOnEdge % array(nEdgesOnEdge%array(i)+1:maxEdges2,i) = nEdges+1
+                       edgesOnEdge % array(nEdgesOnEdge%array(i)+1:maxEdges2,i) = UNUSED_EDGE
                    end do
 
                    edgesOnEdge => edgesOnEdge % next
diff --git a/src/framework/pool_hash.c b/src/framework/pool_hash.c
index a0930e91ae..ea305d6b05 100644
--- a/src/framework/pool_hash.c
+++ b/src/framework/pool_hash.c
@@ -1,21 +1,25 @@
-#include <stdlib.h>
+#define NULL_CHARACTER '\0'
 
-#ifdef UNDERSCORE
-#define pool_hash pool_hash_
-#else
-#ifdef DOUBLEUNDERSCORE
-#define pool_hash pool_hash__
-#endif
-#endif
+/*
+ use iso_c_binding, only : c_int, c_char
 
-void pool_hash(int* hash, char* key, int* len)
+ interface
+   subroutine c_pool_hash(hash, key) bind(c)
+      use iso_c_binding, only : c_int, c_char
+      integer (c_int), intent(inout) :: hash
+      character (c_char), dimension(*), intent(in) :: key
+   end subroutine c_pool_hash
+ end interface
+*/
+
+void c_pool_hash(int* hash, char* key)
 {
 	int i;
 	unsigned int whash;
 
 	whash = 0;
 
-	for (i=0; i<(*len); i++) {
+	for (i=0; key[i] != NULL_CHARACTER; i++) {
 		whash += (unsigned int)key[i];
 	} 
 
diff --git a/src/framework/random_id.c b/src/framework/random_id.c
index 567bc51887..fdaf3e29d0 100644
--- a/src/framework/random_id.c
+++ b/src/framework/random_id.c
@@ -9,28 +9,37 @@
 #include <stdlib.h>
 #include <time.h>
 
-#ifdef UNDERSCORE
-#define gen_random gen_random_
-#define seed_random seed_random_
-#else
-#ifdef DOUBLEUNDERSCORE
-#define gen_random gen_random__
-#define seed_random seed_random__
-#endif
-#endif
+/* Use the following interface in Fortran for seed_random()
 
+ interface
+   subroutine seed_random() bind(c)
+   end subroutine seed_random
+ end interface
+
+*/
 void seed_random() {
 	srand(time(NULL));
 }
 
-void gen_random(int * len, char * id) {/*{{{*/
+/* Use the following interface in Fortran for gen_random()
+
+  interface
+    subroutine gen_random(len, id) bind(c)
+       use iso_c_binding, only : c_int, c_char
+       integer (c_int), intent(in), value :: len
+       character (c_char), dimension(*), intent(inout) :: id
+    end subroutine gen_random
+  end interface
+
+*/
+void gen_random(int len, char * id) {/*{{{*/
 	int i;
 	int r;
 	static const char alphanum[] =
 		"0123456789"
 		"abcdefghijklmnopqrstuvwxyz";
 
-	for (i = 0; i < *len; ++i) {
+	for (i = 0; i < len; ++i) {
 		r = rand();
 		id[i] = alphanum[r % (sizeof(alphanum) - 1)]; 
 	}    
diff --git a/src/framework/xml_stream_parser.c b/src/framework/xml_stream_parser.c
index 6014b9b738..00b22fd009 100644
--- a/src/framework/xml_stream_parser.c
+++ b/src/framework/xml_stream_parser.c
@@ -26,9 +26,9 @@
  *  Interface routines for building streams at run-time; defined in mpas_stream_manager.F
  */
 void stream_mgr_create_stream_c(void *, const char *, int *, const char *, const char *, const char *, const char *, int *, int *, int *, int *, int *);
-void mpas_stream_mgr_add_field_c(void *, const char *, const char *, const char *, int *);
-void mpas_stream_mgr_add_immutable_stream_fields_c(void *, const char *, const char *, const char *, int *);
-void mpas_stream_mgr_add_pool_c(void *, const char *, const char *, const char *, int *);
+void stream_mgr_add_field_c(void *, const char *, const char *, const char *, int *);
+void stream_mgr_add_immutable_stream_fields_c(void *, const char *, const char *, const char *, int *);
+void stream_mgr_add_pool_c(void *, const char *, const char *, const char *, int *);
 void stream_mgr_add_alarm_c(void *, const char *, const char *, const char *, const char *, int *);
 void stream_mgr_add_pkg_c(void *, const char *, const char *, int *);
 
diff --git a/src/tools/registry/gen_inc.c b/src/tools/registry/gen_inc.c
index 90074576e5..06a31d2039 100644
--- a/src/tools/registry/gen_inc.c
+++ b/src/tools/registry/gen_inc.c
@@ -1316,26 +1316,14 @@ int parse_var_array(FILE *fd, ezxml_t registry, ezxml_t superStruct, ezxml_t var
 
 		fortprintf(fd, "\n");
 
-		if ( ndims > 0 ) {
-			fortprintf(fd, "      nullify(%s(%d) %% array)\n", pointer_name, time_lev);
-		} else {
+		if ( ndims == 0 ) {
 			fortprintf(fd, "      %s(%d) %% scalar = %s\n", pointer_name, time_lev, default_value);
 		}
 		fortprintf(fd, "      %s(%d) %% defaultValue = %s\n", pointer_name, time_lev, default_value);
-		fortprintf(fd, "      nullify(%s(%d) %% next)\n", pointer_name, time_lev);
-		fortprintf(fd, "      nullify(%s(%d) %% prev)\n", pointer_name, time_lev);
-		fortprintf(fd, "      nullify(%s(%d) %% sendList)\n", pointer_name, time_lev);
-		fortprintf(fd, "      nullify(%s(%d) %% recvList)\n", pointer_name, time_lev);
-		fortprintf(fd, "      nullify(%s(%d) %% copyList)\n", pointer_name, time_lev);
 		fortprintf(fd, "      allocate(%s(%d) %% attLists(size(%s(%d) %% constituentNames, dim=1)))\n", pointer_name, time_lev, pointer_name, time_lev);
 
 		fortprintf(fd, "      do index_counter = 1, size(%s(%d) %% constituentNames, dim=1)\n", pointer_name, time_lev);
 		fortprintf(fd, "         allocate(%s(%d) %% attLists(index_counter) %% attList)\n", pointer_name, time_lev);
-		fortprintf(fd, "         %s(%d) %% attLists(index_counter) %% attList %% attName = ''\n", pointer_name, time_lev);
-		fortprintf(fd, "         %s(%d) %% attLists(index_counter) %% attList %% attType = -1\n", pointer_name, time_lev);
-		fortprintf(fd, "         nullify(%s(%d) %% attLists(index_counter) %% attList %% next)\n", pointer_name, time_lev);
-		fortprintf(fd, "         nullify(%s(%d) %% attLists(index_counter) %% attList %% attValueIntA)\n", pointer_name, time_lev);
-		fortprintf(fd, "         nullify(%s(%d) %% attLists(index_counter) %% attList %% attValueRealA)\n", pointer_name, time_lev);
 		fortprintf(fd, "      end do\n");
 
 		for(var_xml = ezxml_child(var_arr_xml, "var"); var_xml; var_xml = var_xml->next){
@@ -1554,25 +1542,12 @@ int parse_var(FILE *fd, ezxml_t registry, ezxml_t superStruct, ezxml_t currentVa
 			free(tofree);
 		}
 
-		fortprintf(fd, "     %s(%d) %% defaultValue = %s\n", pointer_name, time_lev, default_value);
-		fortprintf(fd, "     %s(%d) %% defaultValue = %s\n", pointer_name, time_lev, default_value);
-		if ( ndims > 0 ) {
-			fortprintf(fd, "     nullify(%s(%d) %% array)\n", pointer_name, time_lev);
-		} else {
-			fortprintf(fd, "     %s(%d) %% scalar = %s\n", pointer_name, time_lev, default_value);
+		fortprintf(fd, "      %s(%d) %% defaultValue = %s\n", pointer_name, time_lev, default_value);
+		if ( ndims == 0 ) {
+			fortprintf(fd, "      %s(%d) %% scalar = %s\n", pointer_name, time_lev, default_value);
 		}
-		fortprintf(fd, "      nullify(%s(%d) %% next)\n", pointer_name, time_lev);
-		fortprintf(fd, "      nullify(%s(%d) %% prev)\n", pointer_name, time_lev);
-		fortprintf(fd, "      nullify(%s(%d) %% sendList)\n", pointer_name, time_lev);
-		fortprintf(fd, "      nullify(%s(%d) %% recvList)\n", pointer_name, time_lev);
-		fortprintf(fd, "      nullify(%s(%d) %% copyList)\n", pointer_name, time_lev);
 		fortprintf(fd, "      allocate(%s(%d) %% attLists(1))\n", pointer_name, time_lev);
 		fortprintf(fd, "      allocate(%s(%d) %% attLists(1) %% attList)\n", pointer_name, time_lev);
-		fortprintf(fd, "      %s(%d) %% attLists(1) %% attList %% attName = ''\n", pointer_name, time_lev);
-		fortprintf(fd, "      %s(%d) %% attLists(1) %% attList %% attType = -1\n", pointer_name, time_lev);
-		fortprintf(fd, "      nullify(%s(%d) %% attLists(1) %% attList %% next)\n", pointer_name, time_lev);
-		fortprintf(fd, "      nullify(%s(%d) %% attLists(1) %% attList %% attValueIntA)\n", pointer_name, time_lev);
-		fortprintf(fd, "      nullify(%s(%d) %% attLists(1) %% attList %% attValueRealA)\n", pointer_name, time_lev);
 
 		if ( varunits != NULL ) {
 			string = strdup(varunits);
@@ -2553,7 +2528,7 @@ int parse_structs_from_registry(ezxml_t registry)/*{{{*/
 	fd = fopen("structs_and_variables.inc", "w+");
 
 	for (structs_xml = ezxml_child(registry, "var_struct"); structs_xml; structs_xml = structs_xml->next){
-		err = parse_struct(fd, registry, structs_xml, 0, '\0', corename);
+		err = parse_struct(fd, registry, structs_xml, 0, "\0", corename);
 	}
 
 	fortprintf(fd, "   subroutine %s_generate_structs(block, structPool, dimensionPool, packagePool)\n", core_string);
diff --git a/src/tools/registry/gen_inc.h b/src/tools/registry/gen_inc.h
index 765dc0a230..0859823fb9 100644
--- a/src/tools/registry/gen_inc.h
+++ b/src/tools/registry/gen_inc.h
@@ -33,8 +33,8 @@ int generate_field_halo_exchanges_and_copies(ezxml_t registry);
 int generate_field_inputs(FILE *fd, int curLevel, ezxml_t superStruct);
 int generate_field_outputs(FILE *fd, int curLevel, ezxml_t superStruct);
 int generate_field_reads_and_writes(ezxml_t registry);
+int generate_immutable_streams(ezxml_t registry);
 int push_attributes(ezxml_t currentPosition);
 int merge_structs_and_var_arrays(ezxml_t currentPosition);
 int merge_streams(ezxml_t registry);
 int parse_structs_from_registry(ezxml_t registry);
-
diff --git a/testing_and_setup/compass/clean_testcase.py b/testing_and_setup/compass/clean_testcase.py
index 499c94f645..99d4034384 100755
--- a/testing_and_setup/compass/clean_testcase.py
+++ b/testing_and_setup/compass/clean_testcase.py
@@ -6,6 +6,10 @@
 It will remove directories / driver scripts that were generated as part of
 setting up a test case.
 """
+
+from __future__ import absolute_import, division, print_function, \
+    unicode_literals
+
 import sys
 import os
 import shutil
@@ -21,7 +25,7 @@
             description=__doc__, formatter_class=argparse.RawTextHelpFormatter)
 
     parser.add_argument("-o", "--core", dest="core",
-                        help="Core that conatins configurations to clean",
+                        help="Core that contains configurations to clean",
                         metavar="CORE")
     parser.add_argument("-c", "--configuration", dest="configuration",
                         help="Configuration to clean", metavar="CONFIG")
@@ -51,16 +55,16 @@
     if not args.case_num and (not args.core and not args.configuration and
                               not args.resolution and not args.test) \
             and not args.clean_all:
-        print 'Must be run with either the --case_number argument, the ' \
-              '--all argument, or all of the core, configuration, ' \
-              'resolution, and test arguments.'
+        print('Must be run with either the --case_number argument, the '
+              '--all argument, or all of the core, configuration, '
+              'resolution, and test arguments.')
         parser.error(' Invalid configuration. Exiting...')
 
     if args.case_num and args.core and args.configuration and args.resoltuion \
             and args.test and args.clean_all:
-        print 'Can only be configured with either --case_number (-n), --all ' \
-              '(-a), or all of --core (-o), --configuration (-c), ' \
-              '--resolution (-r), and --test (-t).'
+        print('Can only be configured with either --case_number (-n), --all '
+              '(-a), or all of --core (-o), --configuration (-c), '
+              '--resolution (-r), and --test (-t).')
         parser.error(' Invalid configuration. Too many options used. '
                      'Exiting...')
 
@@ -153,8 +157,8 @@
                         if os.path.isdir('{}/{}'.format(work_dir, case_base)):
                             shutil.rmtree('{}/{}'.format(work_dir, case_base))
                             write_history = True
-                            print ' -- Removed case {}/{}'.format(work_dir,
-                                                                  case_base)
+                            print(' -- Removed case {}/{}'.format(work_dir,
+                                                                  case_base))
 
                 # Process <driver_script> files
                 elif config_root.tag == 'driver_script':
@@ -164,8 +168,8 @@
                     if os.path.exists('{}/{}'.format(work_dir, script_name)):
                         os.remove('{}/{}'.format(work_dir, script_name))
                         write_history = True
-                        print ' -- Removed driver script ' \
-                              '{}/{}'.format(work_dir, script_name)
+                        print(' -- Removed driver script '
+                              '{}/{}'.format(work_dir, script_name))
 
                 del config_tree
                 del config_root
diff --git a/testing_and_setup/compass/list_testcases.py b/testing_and_setup/compass/list_testcases.py
index 2d744910d7..f4e8f6a346 100755
--- a/testing_and_setup/compass/list_testcases.py
+++ b/testing_and_setup/compass/list_testcases.py
@@ -12,6 +12,9 @@
 it will only print the flags needed to setup that specific test case.
 """
 
+from __future__ import absolute_import, division, print_function, \
+    unicode_literals
+
 import os
 import fnmatch
 import argparse
@@ -19,9 +22,7 @@
 import re
 
 
-def print_case(quiet, args, core_dir, config_dir, res_dir, test_dir, case_num,
-               print_num):  # {{{
-    # Xylar: the indentation got out of hand and I had to make this a function
+def print_case(quiet, args, core_dir, config_dir, res_dir, test_dir, case_num):
 
     # Print the options if a case file was found.
     if not quiet:
@@ -30,16 +31,14 @@ def print_case(quiet, args, core_dir, config_dir, res_dir, test_dir, case_num,
                                                     config_dir):
                 if (not args.resolution) or re.match(args.resolution, res_dir):
                     if (not args.test) or re.match(args.test, test_dir):
-                        print "  {:d}: -o {} -c {} -r {} -t {}".format(
-                            case_num, core_dir, config_dir, res_dir, test_dir)
-    if quiet and case_num == print_num:
-        print "-o {} -c {} -r {} -t {}".format(
-            core_dir, config_dir, res_dir, test_dir)
+                        print("  {:d}: -o {} -c {} -r {} -t {}".format(
+                            case_num, core_dir, config_dir, res_dir, test_dir))
+    if quiet and case_num == args.number:
+        print("-o {} -c {} -r {} -t {}".format(
+            core_dir, config_dir, res_dir, test_dir))
     case_num += 1
     return case_num
 
-# }}}
-
 
 if __name__ == "__main__":
     # Define and process input arguments
@@ -55,25 +54,16 @@ def print_case(quiet, args, core_dir, config_dir, res_dir, test_dir, case_num,
                         help="Resolution to search for", metavar="RES")
     parser.add_argument("-t", "--test", dest="test",
                         help="Test name to search for", metavar="TEST")
-    parser.add_argument("-n", "--number", dest="number",
+    parser.add_argument("-n", "--number", dest="number", type=int,
                         help="If set, script will print the flags to use a "
-                             "the N'th configuraiton.")
+                             "the N'th configuration.")
 
     args = parser.parse_args()
 
-    quiet = False
-
-    try:
-        print_num = 0
-        if args.number:
-            quiet = True
-            print_num = int(args.number)
-    except ValueError:
-        args.number = 0
-        print_num = 0
+    quiet = args.number is not None
 
     if not quiet:
-        print "Available test cases are:"
+        print("Available test cases are:")
 
     # Start case numbering at 1
     case_num = 1
@@ -82,23 +72,24 @@ def print_case(quiet, args, core_dir, config_dir, res_dir, test_dir, case_num,
     os.chdir(script_path)
 
     # Iterate over all cores
-    for core_dir in os.listdir('.'):
+    for core_dir in sorted(os.listdir('.')):
         if os.path.isdir(core_dir) and core_dir != '.git':
             # Iterate over all configurations within a core
-            for config_dir in os.listdir(core_dir):
+            for config_dir in sorted(os.listdir(core_dir)):
                 config_path = '{}/{}'.format(core_dir, config_dir)
                 if os.path.isdir(config_path):
                     # Iterate over all resolutions within a configuration
-                    for res_dir in os.listdir(config_path):
+                    for res_dir in sorted(os.listdir(config_path)):
                         res_path = '{}/{}'.format(config_path, res_dir)
                         if os.path.isdir(res_path):
                             # Iterate over all tests within a resolution
-                            for test_dir in os.listdir(res_path):
+                            for test_dir in sorted(os.listdir(res_path)):
                                 test_path = '{}/{}'.format(res_path, test_dir)
                                 if os.path.isdir(test_path):
                                     do_print = False
                                     # Iterate over all files within a test
-                                    for case_file in os.listdir(test_path):
+                                    for case_file in sorted(
+                                            os.listdir(test_path)):
                                         if fnmatch.fnmatch(case_file, '*.xml'):
                                             tree = ET.parse('{}/{}'.format(
                                                 test_path, case_file))
@@ -118,7 +109,6 @@ def print_case(quiet, args, core_dir, config_dir, res_dir, test_dir, case_num,
                                     if do_print:
                                         case_num = print_case(
                                             quiet, args, core_dir, config_dir,
-                                            res_dir, test_dir, case_num,
-                                            print_num)
+                                            res_dir, test_dir, case_num)
 
 # vim: foldmethod=marker ai ts=4 sts=4 et sw=4 ft=python
diff --git a/testing_and_setup/compass/manage_regression_suite.py b/testing_and_setup/compass/manage_regression_suite.py
index ac332ecdb5..a8ef17551a 100755
--- a/testing_and_setup/compass/manage_regression_suite.py
+++ b/testing_and_setup/compass/manage_regression_suite.py
@@ -12,6 +12,9 @@
 for each individual test case, and the run script that runs all test cases.
 """
 
+from __future__ import absolute_import, division, print_function, \
+    unicode_literals
+
 import sys
 import os
 import fnmatch
@@ -26,8 +29,8 @@ def process_test_setup(test_tag, config_file, work_dir, model_runtime,
     if verbose:
         stdout = open(work_dir + '/manage_regression_suite.py.out', 'a')
         stderr = stdout
-        print '     Script setup outputs to {}'.format(
-            work_dir + '/manage_regression_suite.py.out')
+        print('     Script setup outputs to {}'.format(
+            work_dir + '/manage_regression_suite.py.out'))
     else:
         dev_null = open('/dev/null', 'a')
         stderr = dev_null
@@ -37,40 +40,40 @@ def process_test_setup(test_tag, config_file, work_dir, model_runtime,
     try:
         test_name = test_tag.attrib['name']
     except KeyError:
-        print "ERROR: <test> tag is missing 'name' attribute."
-        print "Exiting..."
+        print("ERROR: <test> tag is missing 'name' attribute.")
+        print("Exiting...")
         sys.exit(1)
 
     try:
         test_core = test_tag.attrib['core']
     except KeyError:
-        print "ERROR: <test> tag with name '{}' is missing 'core' " \
-              "attribute.".format(test_name)
-        print "Exiting..."
+        print("ERROR: <test> tag with name '{}' is missing 'core' "
+              "attribute.".format(test_name))
+        print("Exiting...")
         sys.exit(1)
 
     try:
         test_configuration = test_tag.attrib['configuration']
     except KeyError:
-        print "ERROR: <test> tag with name '{}' is missing 'configuration' " \
-              "attribute.".format(test_name)
-        print "Exiting..."
+        print("ERROR: <test> tag with name '{}' is missing 'configuration' "
+              "attribute.".format(test_name))
+        print("Exiting...")
         sys.exit(1)
 
     try:
         test_resolution = test_tag.attrib['resolution']
     except KeyError:
-        print "ERROR: <test> tag with name '{}' is missing 'resolution' " \
-              "attribute.".format(test_name)
-        print "Exiting..."
+        print("ERROR: <test> tag with name '{}' is missing 'resolution' "
+              "attribute.".format(test_name))
+        print("Exiting...")
         sys.exit(1)
 
     try:
         test_test = test_tag.attrib['test']
     except KeyError:
-        print "ERROR: <test> tag with name '{}' is missing 'test' " \
-               "attribute.".format(test_name)
-        print "Exiting..."
+        print("ERROR: <test> tag with name '{}' is missing 'test' "
+              "attribute.".format(test_name))
+        print("Exiting...")
         sys.exit(1)
 
     # Determine the file name for the test case output
@@ -91,8 +94,8 @@ def process_test_setup(test_tag, config_file, work_dir, model_runtime,
              '-r', test_resolution, '-t', test_test,  '-m', model_runtime,
              '-b', baseline_dir], stdout=stdout, stderr=stderr)
 
-    print "   -- Setup case '{}': -o {} -c {} -r {} -t {}".format(
-        test_name, test_core, test_configuration, test_resolution, test_test)
+    print("   -- Setup case '{}': -o {} -c {} -r {} -t {}".format(
+        test_name, test_core, test_configuration, test_resolution, test_test))
 
     # Write step into suite script to cd into the base of the regression suite
     suite_script.write("os.chdir(base_path)\n")
@@ -111,8 +114,8 @@ def process_test_setup(test_tag, config_file, work_dir, model_runtime,
             try:
                 script_name = script.attrib['name']
             except KeyError:
-                print "ERROR: <script> tag is missing 'name' attribute."
-                print 'Exiting...'
+                print("ERROR: <script> tag is missing 'name' attribute.")
+                print('Exiting...')
                 sys.exit(1)
 
             command = "subprocess.check_call(['time', '-p', " \
@@ -123,14 +126,14 @@ def process_test_setup(test_tag, config_file, work_dir, model_runtime,
                 command)
 
             # Write test case run step
-            suite_script.write("print ' ** Running case {}'\n".format(
+            suite_script.write("print(' ** Running case {}')\n".format(
                 test_name))
             suite_script.write('try:\n')
             suite_script.write('    {}\n'.format(command))
-            suite_script.write("    print '      PASS'\n")
+            suite_script.write("    print('      PASS')\n")
             suite_script.write('except subprocess.CalledProcessError:\n')
-            suite_script.write("    print '   ** FAIL (See case_outputs/{} "
-                               "for more information)'\n".format(
+            suite_script.write("    print('   ** FAIL (See case_outputs/{} "
+                               "for more information)')\n".format(
                                        case_output_name))
             suite_script.write("    test_failed = True\n")
 
@@ -151,40 +154,40 @@ def process_test_clean(test_tag, work_dir, suite_script):  # {{{
     try:
         test_name = test_tag.attrib['name']
     except KeyError:
-        print "ERROR: <test> tag is missing 'name' attribute."
-        print "Exiting..."
+        print("ERROR: <test> tag is missing 'name' attribute.")
+        print("Exiting...")
         sys.exit(1)
 
     try:
         test_core = test_tag.attrib['core']
     except KeyError:
-        print "ERROR: <test> tag with name '{}' is missing 'core' " \
-              "attribute.".format(test_name)
-        print "Exiting..."
+        print("ERROR: <test> tag with name '{}' is missing 'core' "
+              "attribute.".format(test_name))
+        print("Exiting...")
         sys.exit(1)
 
     try:
         test_configuration = test_tag.attrib['configuration']
     except KeyError:
-        print "ERROR: <test> tag with name '{}' is missing 'configuration' " \
-              "attribute.".format(test_name)
-        print "Exiting..."
+        print("ERROR: <test> tag with name '{}' is missing 'configuration' "
+              "attribute.".format(test_name))
+        print("Exiting...")
         sys.exit(1)
 
     try:
         test_resolution = test_tag.attrib['resolution']
     except KeyError:
-        print "ERROR: <test> tag with name '{}' is missing 'resolution' " \
-              "attribute.".format(test_name)
-        print "Exiting..."
+        print("ERROR: <test> tag with name '{}' is missing 'resolution' "
+              "attribute.".format(test_name))
+        print("Exiting...")
         sys.exit(1)
 
     try:
         test_test = test_tag.attrib['test']
     except KeyError:
-        print "ERROR: <test> tag with name '{}' is missing 'test' " \
-              "attribute.".format(test_name)
-        print "Exiting..."
+        print("ERROR: <test> tag with name '{}' is missing 'test' "
+              "attribute.".format(test_name))
+        print("Exiting...")
         sys.exit(1)
 
     # Clean test case
@@ -193,8 +196,8 @@ def process_test_clean(test_tag, work_dir, suite_script):  # {{{
          '-c',  test_configuration, '-r', test_resolution, '-t', test_test],
         stdout=dev_null, stderr=dev_null)
 
-    print "   -- Cleaned case '{}': -o {} -c {} -r {} -t {}".format(
-        test_name, test_core, test_configuration, test_resolution, test_test)
+    print("   -- Cleaned case '{}': -o {} -c {} -r {} -t {}".format(
+        test_name, test_core, test_configuration, test_resolution, test_test))
 
     dev_null.close()
 
@@ -207,8 +210,8 @@ def setup_suite(suite_tag, work_dir, model_runtime, config_file, baseline_dir,
     try:
         suite_name = suite_tag.attrib['name']
     except KeyError:
-        print "ERROR: <regression_suite> tag is missing 'name' attribute."
-        print 'Exiting...'
+        print("ERROR: <regression_suite> tag is missing 'name' attribute.")
+        print('Exiting...')
         sys.exit(1)
 
     if not os.path.exists('{}'.format(work_dir)):
@@ -248,7 +251,7 @@ def setup_suite(suite_tag, work_dir, model_runtime, config_file, baseline_dir,
             process_test_setup(child, config_file, work_dir, model_runtime,
                                regression_script, baseline_dir, verbose)
 
-    regression_script.write("print 'TEST RUNTIMES:'\n")
+    regression_script.write("print('TEST RUNTIMES:')\n")
     regression_script.write("case_output = '/case_outputs/'\n")
     regression_script.write("totaltime = 0\n")
     regression_script.write("for _, _, files in os.walk(base_path + "
@@ -259,16 +262,16 @@ def setup_suite(suite_tag, work_dir, model_runtime, config_file, baseline_dir,
     regression_script.write("        runtime = np.ceil(float(subprocess."
                             "check_output(\n"
                             "                ['grep', 'real', outputfile])."
-                            "split('\\n')[-2].split()[1]))\n")
+                            "decode('utf-8').split('\\n')[-2].split()[1]))\n")
     regression_script.write("        totaltime += runtime\n")
     regression_script.write("        mins = int(np.floor(runtime/60.0))\n")
     regression_script.write("        secs = int(np.ceil(runtime - mins*60))\n")
-    regression_script.write("        print '{:02d}:{:02d} {}'.format(mins, "
-                            "secs, afile)\n")
+    regression_script.write("        print('{:02d}:{:02d} {}'.format(mins, "
+                            "secs, afile))\n")
     regression_script.write("mins = int(np.floor(totaltime/60.0))\n")
     regression_script.write("secs = int(np.ceil(totaltime - mins*60))\n")
-    regression_script.write("print 'Total runtime {:02d}:{:02d}'.format(mins, "
-                            "secs)\n")
+    regression_script.write("print('Total runtime {:02d}:{:02d}'.format(mins, "
+                            "secs))\n")
     regression_script.write("\n")
 
     regression_script.write("if test_failed:\n")
@@ -289,8 +292,8 @@ def clean_suite(suite_tag, work_dir):  # {{{
     try:
         suite_name = suite_tag.attrib['name']
     except KeyError:
-        print "ERROR: <regression_suite> tag is missing 'name' attribute."
-        print 'Exiting...'
+        print("ERROR: <regression_suite> tag is missing 'name' attribute.")
+        print('Exiting...')
         sys.exit(1)
 
     # Remove the regression suite script, if it exists
@@ -316,44 +319,57 @@ def summarize_suite(suite_tag):  # {{{
             try:
                 test_name = child.attrib['name']
             except KeyError:
-                print "<test> tag is missing a 'name' attribute"
-                print "Exiting..."
+                print("<test> tag is missing a 'name' attribute")
+                print("Exiting...")
                 sys.exit(1)
 
             try:
                 test_core = child.attrib['core']
             except KeyError:
-                print "<test> tag named '{}' is missing a 'core' " \
-                      "attribute".format(test_name)
-                print "Exiting..."
+                print("<test> tag named '{}' is missing a 'core' "
+                      "attribute".format(test_name))
+                print("Exiting...")
                 sys.exit(1)
 
             try:
                 test_configuration = child.attrib['configuration']
             except KeyError:
-                print "<test> tag named '{}' is missing a 'configuration' " \
-                      "attribute".format(test_name)
-                print "Exiting..."
+                print("<test> tag named '{}' is missing a 'configuration' "
+                      "attribute".format(test_name))
+                print("Exiting...")
                 sys.exit(1)
 
             try:
                 test_resolution = child.attrib['resolution']
             except KeyError:
-                print "<test> tag named '{}' is missing a 'resolution' " \
-                      "attribute".format(test_name)
-                print "Exiting..."
+                print("<test> tag named '{}' is missing a 'resolution' "
+                      "attribute".format(test_name))
+                print("Exiting...")
                 sys.exit(1)
 
             try:
                 test_test = child.attrib['test']
             except KeyError:
-                print "<test> tag named '{}' is missing a 'test' " \
-                      "attribute".format(test_name)
-                print "Exiting..."
+                print("<test> tag named '{}' is missing a 'test' "
+                      "attribute".format(test_name))
+                print("Exiting...")
                 sys.exit(1)
 
             test_path = '{}/{}/{}/{}'.format(test_core, test_configuration,
                                              test_resolution, test_test)
+            driver_path = '{}/config_driver.xml'.format(test_path)
+            config_tree = ET.parse(driver_path)
+            config_root = config_tree.getroot()
+
+            cases = []
+            assert(config_root.tag == 'driver_script')
+            for case in config_root.iter('case'):
+                name = case.attrib['name']
+                cases.append(name)
+
+            del config_root
+            del config_tree
+
             # Loop over all files in test_path that have the .xml extension.
             for file in os.listdir('{}'.format(test_path)):
                 if fnmatch.fnmatch(file, '*.xml'):
@@ -364,38 +380,40 @@ def summarize_suite(suite_tag):  # {{{
                     config_root = config_tree.getroot()
 
                     if config_root.tag == 'config':
-                        for model_run in config_root.iter('model_run'):
-                            try:
-                                procs_str = model_run.attrib['procs']
-                                procs = int(procs_str)
-                            except (KeyError, ValueError):
-                                procs = 1
+                        case = config_root.attrib['case']
+                        if case in cases:
+                            for model_run in config_root.iter('model_run'):
+                                try:
+                                    procs_str = model_run.attrib['procs']
+                                    procs = int(procs_str)
+                                except (KeyError, ValueError):
+                                    procs = 1
 
-                            try:
-                                threads_str = model_run.attrib['threads']
-                                threads = int(threads_str)
-                            except (KeyError, ValueError):
-                                threads = 1
+                                try:
+                                    threads_str = model_run.attrib['threads']
+                                    threads = int(threads_str)
+                                except (KeyError, ValueError):
+                                    threads = 1
 
-                            cores = threads * procs
+                                cores = threads * procs
 
-                            if procs > max_procs:
-                                max_procs = procs
+                                if procs > max_procs:
+                                    max_procs = procs
 
-                            if threads > max_threads:
-                                max_threads = threads
+                                if threads > max_threads:
+                                    max_threads = threads
 
-                            if cores > max_cores:
-                                max_cores = cores
+                                if cores > max_cores:
+                                    max_cores = cores
 
                     del config_root
                     del config_tree
 
-    print "\n"
-    print " Summary of test cases:"
-    print "      Maximum MPI tasks used: {:d}".format(max_procs)
-    print "      Maximum OpenMP threads used: {:d}".format(max_threads)
-    print "      Maximum Total Cores used: {:d}".format(max_cores)
+    print("\n")
+    print(" Summary of test cases:")
+    print("      Maximum MPI tasks used: {:d}".format(max_procs))
+    print("      Maximum OpenMP threads used: {:d}".format(max_threads))
+    print("      Maximum Total Cores used: {:d}".format(max_cores))
 # }}}
 
 
@@ -432,8 +450,8 @@ def summarize_suite(suite_tag):  # {{{
     args = parser.parse_args()
 
     if not args.config_file:
-        print "WARNING: Not configuration file specified. Using the default " \
-              "of 'local.config'"
+        print("WARNING: Not configuration file specified. Using the default "
+              "of 'local.config'")
         args.config_file = 'local.config'
 
     if not os.path.exists(args.config_file):
@@ -449,16 +467,16 @@ def summarize_suite(suite_tag):  # {{{
     if not args.model_runtime:
         args.model_runtime = '{}/runtime_definitions/mpirun.xml'.format(
             os.path.dirname(os.path.realpath(__file__)))
-        print 'WARNING: No model runtime specified. Using the default of ' \
-              '{}'.format(args.model_runtime)
+        print('WARNING: No model runtime specified. Using the default of '
+              '{}'.format(args.model_runtime))
 
     if not args.baseline_dir:
         args.baseline_dir = 'NONE'
 
     if not args.setup and not args.clean:
-        print 'WARNING: Neither the setup (-s/--setup) nor the clean ' \
-              '(-c/--clean) flags were provided. Script will perform no ' \
-              'actions.'
+        print('WARNING: Neither the setup (-s/--setup) nor the clean '
+              '(-c/--clean) flags were provided. Script will perform no '
+              'actions.')
 
     write_history = False
 
@@ -470,21 +488,21 @@ def summarize_suite(suite_tag):  # {{{
     if suite_root.tag == 'regression_suite':
         # If cleaning, clean the suite
         if args.clean:
-            print "Cleaning Test Cases:"
+            print("Cleaning Test Cases:")
             clean_suite(suite_root, args.work_dir)
             write_history = True
         # If setting up, set up the suite
         if args.setup:
-            print "\n"
-            print "Setting Up Test Cases:"
+            print("\n")
+            print("Setting Up Test Cases:")
             setup_suite(suite_root, args.work_dir, args.model_runtime,
                         args.config_file, args.baseline_dir, args.verbose)
             summarize_suite(suite_root)
             if args.verbose:
                 cmd = ['cat',
                        args.work_dir + '/manage_regression_suite.py.out']
-                print '\nCase setup output:'
-                print subprocess.check_output(cmd)
+                print('\nCase setup output:')
+                print(subprocess.check_output(cmd))
             write_history = True
 
     # Write the history of this command to the command_history file, for
@@ -495,7 +513,7 @@ def summarize_suite(suite_tag):  # {{{
         os.chdir(os.path.dirname(os.path.realpath(__file__)))
         git_version = subprocess.check_output(
             ['git', 'describe', '--tags', '--dirty'])
-        git_version = git_version.strip('\n')
+        git_version = git_version.decode('utf-8').strip('\n')
         os.chdir(old_dir)
         calling_command = ""
         for arg in sys.argv:
diff --git a/testing_and_setup/compass/ocean/templates/analysis_members/lagrangian_particle_tracking.xml b/testing_and_setup/compass/ocean/templates/analysis_members/lagrangian_particle_tracking.xml
index 3f93587418..fa436a1bb2 100644
--- a/testing_and_setup/compass/ocean/templates/analysis_members/lagrangian_particle_tracking.xml
+++ b/testing_and_setup/compass/ocean/templates/analysis_members/lagrangian_particle_tracking.xml
@@ -45,11 +45,8 @@
 				<member name="resetTime" type="var"/>
 				<member name="numTimesReset" type="var"/>
 				<member name="buoyancyParticle" type="var"/>
-				<member name="vertexReconstMethod" type="var"/>
-				<member name="horizontalTreatment" type="var"/>
 				<member name="verticalTreatment" type="var"/>
 				<member name="dtParticle" type="var"/>
-				<member name="timeIntegration" type="var"/>
 				<member name="indexLevel" type="var"/>
 				<member name="uVertexVelocity" type="var"/>
 				<member name="vVertexVelocity" type="var"/>
@@ -96,11 +93,8 @@
 				<member name="resetTime" type="var"/>
 				<member name="numTimesReset" type="var"/>
 				<member name="buoyancyParticle" type="var"/>
-				<member name="vertexReconstMethod" type="var"/>
-				<member name="horizontalTreatment" type="var"/>
 				<member name="verticalTreatment" type="var"/>
 				<member name="dtParticle" type="var"/>
-				<member name="timeIntegration" type="var"/>
 				<member name="indexLevel" type="var"/>
 				<member name="transfered" type="var"/>
 				<member name="buoyancySurfaceValues" type="var"/>
@@ -133,11 +127,8 @@
 				<member name="resetTime" type="var"/>
 				<member name="numTimesReset" type="var"/>
 				<member name="buoyancyParticle" type="var"/>
-				<member name="vertexReconstMethod" type="var"/>
-				<member name="horizontalTreatment" type="var"/>
 				<member name="verticalTreatment" type="var"/>
 				<member name="dtParticle" type="var"/>
-				<member name="timeIntegration" type="var"/>
 				<member name="indexLevel" type="var"/>
 				<member name="transfered" type="var"/>
 				<member name="buoyancySurfaceValues" type="var"/>
diff --git a/testing_and_setup/compass/setup_testcase.py b/testing_and_setup/compass/setup_testcase.py
index d914ce88b6..d0ed603ed3 100755
--- a/testing_and_setup/compass/setup_testcase.py
+++ b/testing_and_setup/compass/setup_testcase.py
@@ -13,13 +13,16 @@
 requirements as far as what is required within a configuration file.
 """
 
+from __future__ import absolute_import, division, print_function, \
+    unicode_literals
+
 import sys
 import os
 import fnmatch
 import argparse
 import xml.etree.ElementTree as ET
 import subprocess
-import ConfigParser
+from six.moves import configparser
 import textwrap
 import netCDF4
 
@@ -40,22 +43,22 @@ def generate_namelist_files(config_file, case_path, configs):  # {{{
         try:
             namelist_file = '{}/{}'.format(case_path, namelists.attrib['name'])
         except KeyError:
-            print "ERROR: <namelist> tag is missing the 'name' attribute"
-            print "Exiting..."
+            print("ERROR: <namelist> tag is missing the 'name' attribute")
+            print("Exiting...")
             sys.exit(1)
 
         try:
             namelist_mode = namelists.attrib['mode']
         except KeyError:
-            print "ERROR: <namelist> tag is missing the 'mode' attribute."
-            print "Exiting..."
+            print("ERROR: <namelist> tag is missing the 'mode' attribute.")
+            print("Exiting...")
             sys.exit(1)
 
         if not configs.has_option("namelists", namelist_mode):
-            print "Error. Configuration file '{}' requires paths for " \
+            print("Error. Configuration file '{}' requires paths for "
                   "streams and namelist files for '{}' mode.".format(
-                      config_file, namelist_mode)
-            print "Exiting..."
+                      config_file, namelist_mode))
+            print("Exiting...")
             sys.exit(1)
 
         template_namelist = configs.get("namelists", namelist_mode)
@@ -198,15 +201,15 @@ def generate_streams_files(config_file, case_path, configs):  # {{{
             try:
                 streams_mode = streams.attrib['mode']
             except KeyError:
-                print "ERROR: <streams> tag is missing the 'mode' attribute."
-                print "Exiting..."
+                print("ERROR: <streams> tag is missing the 'mode' attribute.")
+                print("Exiting...")
                 sys.exit(1)
 
             if not configs.has_option("streams", streams_mode):
-                print "Error. Configuration file '{}' requires paths for " \
+                print("Error. Configuration file '{}' requires paths for "
                       "streams and namelist files for '{}' mode.".format(
-                          config_file, streams_mode)
-                print "Exiting..."
+                          config_file, streams_mode))
+                print("Exiting...")
                 sys.exit(1)
 
             template_streams = configs.get("streams", streams_mode)
@@ -256,8 +259,8 @@ def modify_stream_definition(streams_file, stream_conf):  # {{{
                     found = True
                     stream_to_modify = stream
                 else:
-                    print "ERROR: Stream {} found multiple times in " \
-                          "template. Exiting...".format(name.strip())
+                    print("ERROR: Stream {} found multiple times in "
+                          "template. Exiting...".format(name.strip()))
                     sys.exit(1)
 
     # If not found, need to create it
@@ -292,8 +295,8 @@ def modify_stream_definition(streams_file, stream_conf):  # {{{
                         if child.attrib['name'] == member_name:
                             stream_to_modify.remove(child)
                     except KeyError:
-                        print "   --- Tag: {} is missing a name " \
-                              "attribute".format(child.tag)
+                        print("   --- Tag: {} is missing a name "
+                              "attribute".format(child.tag))
 
 # }}}
 
@@ -527,7 +530,6 @@ def generate_driver_scripts(config_file, configs):  # {{{
         script.write('import shutil\n')
         script.write('import glob\n')
         script.write('import subprocess\n')
-        script.write("import xml.etree.ElementTree as ET\n")
         script.write('import argparse\n')
         script.write('\n\n')
         script.write('# This script was generated by setup_testcases.py as '
@@ -544,10 +546,10 @@ def generate_driver_scripts(config_file, configs):  # {{{
                 case_name = child.attrib['name']
                 case_dict[case_name] = '1'
             if child.tag == 'template':
-                print " WARNING: use of templates outside of a case in a " \
-                      "driver_script is not supported!"
-                print "          (name of template file is {})".format(
-                    child.attrib['file'])
+                print(" WARNING: use of templates outside of a case in a "
+                      "driver_script is not supported!")
+                print("          (name of template file is {})".format(
+                    child.attrib['file']))
         for case_name in case_dict.keys():
             script.write('parser.add_argument("--no_{}", dest="no_{}",\n'
                          '                    help="If set, {} case will not '
@@ -640,15 +642,15 @@ def process_env_define_step(var_tag, configs, indentation, script_file):  # {{{
     try:
         var_name = var_tag.attrib['name']
     except KeyError:
-        print "ERROR: <define_env_var> tag is missing 'name' attribte"
-        print 'Exiting...'
+        print("ERROR: <define_env_var> tag is missing 'name' attribte")
+        print('Exiting...')
         sys.exit(1)
 
     try:
         var_val = var_tag.attrib['value']
     except KeyError:
-        print "ERROR: <define_env_var> tag is missing 'value' attribute"
-        print 'Exiting...'
+        print("ERROR: <define_env_var> tag is missing 'value' attribute")
+        print('Exiting...')
         sys.exit(1)
 
     # Write line to define the environment variable
@@ -662,9 +664,9 @@ def process_script_step(step, configs, indentation, script_file):  # {{{
     # Determine step attributes.
     if 'executable_name' in step.attrib.keys() and 'executable' in \
             step.attrib.keys():
-        print "ERROR: <step> tag has both an 'executable' and " \
-              "'executable_name' attribute. Only one is allowed per step."
-        print "Exiting..."
+        print("ERROR: <step> tag has both an 'executable' and "
+              "'executable_name' attribute. Only one is allowed per step.")
+        print("Exiting...")
         sys.exit(1)
 
     try:
@@ -700,8 +702,8 @@ def process_script_step(step, configs, indentation, script_file):  # {{{
     # If a pre_message attribute was supplied, write it before adding the
     # command.
     if write_pre_message:
-        script_file.write('{}print "{}"\n'.format(indentation,
-                                                  step_pre_message))
+        script_file.write('{}print("{}")\n'.format(indentation,
+                                                   step_pre_message))
 
     script_file.write("{}# Run command is:\n".format(indentation))
 
@@ -729,8 +731,8 @@ def process_script_step(step, configs, indentation, script_file):  # {{{
 
     # If a post_message attribute was supplied, write it after the command.
     if write_post_message:
-        script_file.write('{}print "{}"\n'.format(indentation,
-                                                  step_post_message))
+        script_file.write('{}print("{}")\n'.format(indentation,
+                                                   step_post_message))
 
 # }}}
 
@@ -760,9 +762,9 @@ def process_compare_fields_step(compare_tag, configs, script):  # {{{
         missing_file2 = True
 
     if missing_file1 and missing_file2:
-        print "ERROR: <compare_fields> tag is missing both 'file1' and " \
-              "'file2' tags. At least one is required."
-        print "Exiting..."
+        print("ERROR: <compare_fields> tag is missing both 'file1' and "
+              "'file2' tags. At least one is required.")
+        print("Exiting...")
         sys.exit(1)
 
     baseline_root = configs.get('script_paths', 'baseline_dir')
@@ -809,9 +811,9 @@ def apply_compare_fields_template(template_tag, compare_tag, configs, script):
         missing_file2 = True
 
     if missing_file1 and missing_file2:
-        print "ERROR: <compare_fields> tag is missing both 'file1' and " \
-              "'file2' tags. At least one is required."
-        print "Exiting..."
+        print("ERROR: <compare_fields> tag is missing both 'file1' and "
+              "'file2' tags. At least one is required.")
+        print("Exiting...")
         sys.exit(1)
 
     # Build the path to the baselines
@@ -891,11 +893,11 @@ def process_field_definition(field_tag, configs, script, file1, file2,
     # Write the pass/fail logic.
     script.write('try:\n')
     script.write('{}\n'.format(command))
-    script.write("    print ' ** PASS Comparison of {} between {} and\\n' \\\n"
-                 "          '    {}'\n".format(field_name, file1, file2))
+    script.write("    print(' ** PASS Comparison of {} between {} and\\n'\n"
+                 "          '    {}')\n".format(field_name, file1, file2))
     script.write('except subprocess.CalledProcessError:\n')
-    script.write("    print ' ** FAIL Comparison of {} between {} and\\n' \\\n"
-                 "          '    {}'\n".format(field_name, file1, file2))
+    script.write("    print(' ** FAIL Comparison of {} between {} and\\n'\n"
+                 "          '    {}')\n".format(field_name, file1, file2))
     script.write('    error = True\n')
 # }}}
 # }}}
@@ -1013,8 +1015,8 @@ def process_timer_definition(timer_tag, configs, script, basedir, compdir):
     try:
         timer_name = timer_tag.attrib['name']
     except KeyError:
-        print "ERROR: <timer> tag is missing the 'name' attribute."
-        print "Exiting..."
+        print("ERROR: <timer> tag is missing the 'name' attribute.")
+        print("Exiting...")
         sys.exit(1)
 
     command = 'subprocess.check_call(["{}", "-b", "{}", "-c", "{}", "-t", ' \
@@ -1025,15 +1027,15 @@ def process_timer_definition(timer_tag, configs, script, basedir, compdir):
                  '        os.path.exists("{}"):\n'.format(compdir, basedir))
     script.write('    try:\n')
     script.write('        {}\n'.format(command))
-    script.write("        print ' ** PASS Comparison of timer {} between {} "
-                 "and\\n' \\\n"
-                 "              '    {}'\n".format(timer_name, compdir,
-                                                   basedir))
+    script.write("        print(' ** PASS Comparison of timer {} between {} "
+                 "and\\n'\n"
+                 "              '    {}')\n".format(timer_name, compdir,
+                                                    basedir))
     script.write('    except subprocess.CalledProcessError:\n')
-    script.write("        print ' ** FAIL Comparison of timer {} between {} "
-                 "and\\n' \\\n"
-                 "              '    {}'\n".format(timer_name, compdir,
-                                                   basedir))
+    script.write("        print(' ** FAIL Comparison of timer {} between {} "
+                 "and\\n'\n"
+                 "              '    {}')\n".format(timer_name, compdir,
+                                                    basedir))
     script.write("        error = True\n")
 # }}}
 # }}}
@@ -1052,11 +1054,11 @@ def process_model_run_step(model_run_tag, configs, script):  # {{{
     except KeyError:
         executable_name = 'model'
 
-    script.write('print "\\n"\n')
-    script.write('print "     *****************************"\n')
-    script.write('print "     ** Starting model run step **"\n')
-    script.write('print "     *****************************"\n')
-    script.write('print "\\n"\n')
+    script.write('print("\\n")\n')
+    script.write('print("     *****************************")\n')
+    script.write('print("     ** Starting model run step **")\n')
+    script.write('print("     *****************************")\n')
+    script.write('print("\\n")\n')
 
     # Process each part of the run script
     for child in run_config_root:
@@ -1083,17 +1085,17 @@ def process_model_run_step(model_run_tag, configs, script):  # {{{
                              config.get('executables', executable_name),
                              link_path],
                             stdout=dev_null, stderr=dev_null)
-                        grandchild.text = executable_link
+                        grandchild.text = './{}'.format(executable_link)
                     elif arg_text.find('attr_') >= 0:
                         attr_array = arg_text.split('_')
                         try:
                             grandchild.text = \
                                 model_run_tag.attrib[attr_array[1]]
                         except KeyError:
-                            print " <step> tag defined within a <model_run> " \
-                                  "tag requires attribute '{}', but it is " \
-                                  "not defined.".format(attr_array[1])
-                            print " Exiting..."
+                            print(" <step> tag defined within a <model_run> "
+                                  "tag requires attribute '{}', but it is "
+                                  "not defined.".format(attr_array[1]))
+                            print(" Exiting...")
                             sys.exit(1)
 
             # Process the resulting element, instead of the original step.
@@ -1105,19 +1107,19 @@ def process_model_run_step(model_run_tag, configs, script):  # {{{
                 try:
                     child.attrib['value'] = model_run_tag.attrib[attr_array[1]]
                 except KeyError:
-                    print " <define_env_var> tag defined within a " \
-                          "<model_run> tag requires attribute '{}', but it " \
-                          "is not defined.".format(attr_array[1])
-                    print " Exiting..."
+                    print(" <define_env_var> tag defined within a "
+                          "<model_run> tag requires attribute '{}', but it "
+                          "is not defined.".format(attr_array[1]))
+                    print(" Exiting...")
                     sys.exit(1)
 
             process_env_define_step(child, configs, '', script)
 
-    script.write('print "\\n"\n')
-    script.write('print "     *****************************"\n')
-    script.write('print "     ** Finished model run step **"\n')
-    script.write('print "     *****************************"\n')
-    script.write('print "\\n"\n')
+    script.write('print("\\n")\n')
+    script.write('print("     *****************************")\n')
+    script.write('print("     ** Finished model run step **")\n')
+    script.write('print("     *****************************")\n')
+    script.write('print("\\n")\n')
     dev_null.close()
 # }}}
 
@@ -1135,7 +1137,7 @@ def wrap_subprocess_comment(command_args, indentation):  # {{{
 def wrap_subprocess_command(command_args, indentation, quiet):  # {{{
     # Setup command redirection
     if quiet:
-        redirect = ", stdout=dev_null, stderr=dev_null"
+        redirect = ", stdout=dev_null, stderr=None"
     else:
         redirect = ""
 
@@ -1177,8 +1179,8 @@ def add_links(config_file, configs):  # {{{
             try:
                 source = child.attrib['source']
             except KeyError:
-                print " add_link tag missing a 'source' attribute."
-                print " Exiting..."
+                print(" add_link tag missing a 'source' attribute.")
+                print(" Exiting...")
                 sys.exit(1)
 
             try:
@@ -1191,24 +1193,23 @@ def add_links(config_file, configs):  # {{{
                     keyword_path = True
 
                 if not keyword_path:
-                    try:
+                    if configs.has_option('paths', source_path_name):
                         source_path = configs.get('paths', source_path_name)
-                    except (ConfigParser.NoOptionError,
-                            ConfigParser.NoSectionError):
+                    else:
                         source_path = 'NONE'
 
                     if source_path == 'NONE':
-                        try:
+                        if configs.has_option('script_paths',
+                                              source_path_name):
                             source_path = configs.get('script_paths',
                                                       source_path_name)
-                        except (ConfigParser.NoOptionError,
-                                ConfigParser.NoSectionError):
+                        else:
                             source_path = 'NONE'
 
                     if source_path == 'NONE':
-                        print "ERROR: source_path on <add_link> tag is '{}' " \
-                              "which is not defined".format(source_path_name)
-                        print "Exiting..."
+                        print("ERROR: source_path on <add_link> tag is '{}' "
+                              "which is not defined".format(source_path_name))
+                        print("Exiting...")
                         sys.exit(1)
 
                 else:
@@ -1246,8 +1247,8 @@ def add_links(config_file, configs):  # {{{
             source_attr = child.attrib['source']
             dest = child.attrib['dest']
             if not configs.has_option("executables", source_attr):
-                print 'ERROR: Configuration {} requires a definition of ' \
-                      '{}.'.format(config_file, source_attr)
+                print('ERROR: Configuration {} requires a definition of '
+                      '{}.'.format(config_file, source_attr))
                 sys.exit(1)
             else:
                 source = configs.get("executables", source_attr)
@@ -1294,16 +1295,16 @@ def get_defined_files(config_file, init_path, configs):  # {{{
             try:
                 dest_path_name = get_file.attrib['dest_path']
             except KeyError:
-                print " get_file tag is missing the 'dest_path' attribute."
-                print " Exiting..."
+                print(" get_file tag is missing the 'dest_path' attribute.")
+                print(" Exiting...")
                 sys.exit(1)
 
             # Determine file_name
             try:
                 file_name = get_file.attrib['file_name']
             except KeyError:
-                print " get_file tag is missing a 'file_name' attribute."
-                print " Exiting..."
+                print(" get_file tag is missing a 'file_name' attribute.")
+                print(" Exiting...")
                 sys.exit(1)
 
             # Build out the dest path
@@ -1313,15 +1314,14 @@ def get_defined_files(config_file, init_path, configs):  # {{{
             elif dest_path_name.find('script_') >= 0:
                 keyword_path = True
             else:
-                try:
+                if configs.has_option('paths', dest_path_name):
                     dest_path = '{}'.format(
                         configs.get('paths', dest_path_name))
-                except (ConfigParser.NoOptionError,
-                        ConfigParser.NoSectionError):
-                    print " Path '{}' is not defined in the config file, " \
+                else:
+                    print(" Path '{}' is not defined in the config file, "
                           "but is required to get a file.".format(
-                              dest_path_name)
-                    print " Exiting..."
+                              dest_path_name))
+                    print(" Exiting...")
                     sys.exit(1)
 
             if keyword_path:
@@ -1340,8 +1340,8 @@ def get_defined_files(config_file, init_path, configs):  # {{{
                         configs.get('script_paths', base_path),
                         configs.get('script_paths', subname))
                 else:
-                    print " Path '{}' is not defined.".format(dest_path_name)
-                    print " Exiting..."
+                    print(" Path '{}' is not defined.".format(dest_path_name))
+                    print(" Exiting...")
                     sys.exit(1)
 
             # if the dest_path doesn't exist, create it
@@ -1359,9 +1359,9 @@ def get_defined_files(config_file, init_path, configs):  # {{{
                             try:
                                 protocol = mirror.attrib['protocol']
                             except KeyError:
-                                print "Mirror is missing the 'protocol' " \
-                                      "attribute."
-                                print "Exiting..."
+                                print("Mirror is missing the 'protocol' "
+                                      "attribute.")
+                                print("Exiting...")
                                 sys.exit(1)
 
                             # Process a wget mirror
@@ -1372,9 +1372,9 @@ def get_defined_files(config_file, init_path, configs):  # {{{
                                         path = '{}/{}'.format(
                                             mirror.attrib['url'], file_name)
                                     except KeyError:
-                                        print " Mirror with protocol 'wget' " \
-                                              "is missing a 'url' attribute"
-                                        print " Exiting..."
+                                        print(" Mirror with protocol 'wget' "
+                                              "is missing a 'url' attribute")
+                                        print(" Exiting...")
                                         sys.exit(1)
 
                                     try:
@@ -1382,7 +1382,7 @@ def get_defined_files(config_file, init_path, configs):  # {{{
                                             ['wget', '-q', '{}'.format(path)],
                                             stdout=dev_null, stderr=dev_null)
                                     except subprocess.CalledProcessError:
-                                        print " Wget failed...."
+                                        print(" Wget failed....")
 
                                     try:
                                         subprocess.check_call(
@@ -1391,8 +1391,8 @@ def get_defined_files(config_file, init_path, configs):  # {{{
                                                             file_name)],
                                             stdout=dev_null, stderr=dev_null)
                                     except subprocess.CalledProcessError:
-                                        print "  -- Web mirror attempt " \
-                                              "failed. Trying other mirrors..."
+                                        print("  -- Web mirror attempt failed."
+                                              " Trying other mirrors...")
 
                         # If the file exists in dest_path, determine if it
                         # should be validated
@@ -1415,10 +1415,10 @@ def get_defined_files(config_file, init_path, configs):  # {{{
                                         file_hash = nc.file_id
                                     except AttributeError:
                                         nc.close()
-                                        print " Downloaded file '{}' does " \
-                                              "not have a 'file_id' " \
-                                              "attribute.".format(file_name)
-                                        print " Deleting file and exiting..."
+                                        print(" Downloaded file '{}' does "
+                                              "not have a 'file_id' "
+                                              "attribute.".format(file_name))
+                                        print(" Deleting file and exiting...")
                                         subprocess.check_call(
                                             ['rm', '-f',
                                              '{}/{}'.format(dest_path,
@@ -1430,12 +1430,12 @@ def get_defined_files(config_file, init_path, configs):  # {{{
 
                                     if file_hash.strip() != \
                                             expected_hash.strip():
-                                        print "*** ERROR: Base mesh has " \
-                                              "hash of '{}' which does not " \
-                                              "match expected hash of " \
+                                        print("*** ERROR: Base mesh has "
+                                              "hash of '{}' which does not "
+                                              "match expected hash of "
                                               "'{}'.".format(file_hash,
-                                                             expected_hash)
-                                        print " Deleting file..."
+                                                             expected_hash))
+                                        print(" Deleting file...")
                                         subprocess.check_call(
                                             ['rm', '-f',
                                              '{}/{}'.format(dest_path,
@@ -1445,9 +1445,9 @@ def get_defined_files(config_file, init_path, configs):  # {{{
                     # IF validation valied, exit.
                     if not os.path.exists('{}/{}'.format(dest_path,
                                                          file_name)):
-                        print " Failed to acquire required file '{}'.".format(
-                            file_name)
-                        print " Exiting..."
+                        print(" Failed to acquire required file '{}'.".format(
+                            file_name))
+                        print(" Exiting...")
                         sys.exit(1)
 
     del config_tree
@@ -1461,15 +1461,15 @@ def get_template_info(template, configs):  # {{{
     try:
         template_file = template.attrib['file']
     except KeyError:
-        print "ERROR: <template> tag is missing 'file' attribute."
-        print 'Exiting...'
+        print("ERROR: <template> tag is missing 'file' attribute.")
+        print('Exiting...')
         sys.exit(1)
 
     try:
         template_path_base = template.attrib['path_base']
     except KeyError:
-        print "ERROR: <template> tag is missing 'path_base' attribute."
-        print 'Exiting...'
+        print("ERROR: <template> tag is missing 'path_base' attribute.")
+        print('Exiting...')
         sys.exit(1)
 
     try:
@@ -1499,9 +1499,9 @@ def get_template_info(template, configs):  # {{{
                 configs.get('script_paths', base_path),
                 configs.get('script_paths', sub_path), template_path_modifier)
         else:
-            print " Template path_base '{}' does not exist".format(
-                template_path_base)
-            print " Exiting..."
+            print(" Template path_base '{}' does not exist".format(
+                template_path_base))
+            print(" Exiting...")
             sys.exit(1)
 
     info = {}
@@ -1584,8 +1584,8 @@ def get_case_name(config_file):  # {{{
     args = parser.parse_args()
 
     if not args.config_file:
-        print "WARNING: No configuration file specified. Using the default " \
-              "of 'local.config'"
+        print("WARNING: No configuration file specified. Using the default "
+              "of 'local.config'")
         args.config_file = 'local.config'
 
     if not os.path.exists(args.config_file):
@@ -1595,15 +1595,15 @@ def get_case_name(config_file):  # {{{
 
     if not args.case_num and not (args.core and args.configuration and
                                   args.resolution and args.test):
-        print 'Must be run with either the --case_number argument, or the ' \
-              'core, configuration, resolution, and test arguments.'
+        print('Must be run with either the --case_number argument, or the '
+              'core, configuration, resolution, and test arguments.')
         parser.error(' Invalid configuration. Exiting...')
 
     if args.case_num and args.core and args.configuration and args.resoltuion \
             and args.test:
-        print 'Can only be configured with either --case_number (-n) or ' \
-              '--core (-o), --configuration (-c), --resolution (-r), and ' \
-              '--test (-t).'
+        print('Can only be configured with either --case_number (-n) or '
+              '--core (-o), --configuration (-c), --resolution (-r), and '
+              '--test (-t).')
         parser.error(' Invalid configuration. Too many options used. '
                      'Exiting...')
 
@@ -1615,7 +1615,10 @@ def get_case_name(config_file):  # {{{
         case_list = list()
         case_list.append(0)
 
-    config = ConfigParser.SafeConfigParser()
+    if sys.version_info >= (3, 2):
+        config = configparser.ConfigParser()
+    else:
+        config = configparser.SafeConfigParser()
     config.read(args.config_file)
 
     if not args.no_download:
@@ -1658,9 +1661,9 @@ def get_case_name(config_file):  # {{{
         config.set('script_input_arguments', 'model_runtime',
                    '{}/runtime_definitions/mpirun.xml'.format(
                        config.get('script_paths', 'script_path')))
-        print ' WARNING: No runtime definition selected. Using the default ' \
+        print(' WARNING: No runtime definition selected. Using the default '
               'of {}'.format(config.get('script_input_arguments',
-                                        'model_runtime'))
+                                        'model_runtime')))
     else:
         config.set('script_input_arguments', 'model_runtime',
                    args.model_runtime)
@@ -1669,7 +1672,7 @@ def get_case_name(config_file):  # {{{
     old_dir = os.getcwd()
     os.chdir(config.get('script_paths', 'script_path'))
     git_version = subprocess.check_output(
-        ['git', 'describe', '--tags', '--dirty'])
+        ['git', 'describe', '--tags', '--dirty']).decode('utf-8')
     git_version = git_version.strip('\n')
     calling_command = ""
     for arg in sys.argv:
@@ -1686,7 +1689,7 @@ def get_case_name(config_file):  # {{{
             core_configuration = subprocess.check_output(
                 ['{}/list_testcases.py'.format(config.get('script_paths',
                                                           'script_path')),
-                 '-n', '{:d}'.format(int(case_num))])
+                 '-n', '{:d}'.format(int(case_num))]).decode('utf-8')
             config_options = core_configuration.strip('\n').split(' ')
             config.set('script_input_arguments', 'core', config_options[1])
             config.set('script_input_arguments', 'configuration',
@@ -1766,14 +1769,14 @@ def get_case_name(config_file):  # {{{
                     generate_run_scripts(config_file, '{}'.format(case_path),
                                          config)
 
-                    print " -- Set up case: {}/{}".format(work_dir, case_dir)
+                    print(" -- Set up case: {}/{}".format(work_dir, case_dir))
                 # Process driver scripts
                 elif config_type == 'driver_script':
                     write_history = True
 
                     # Generate driver scripts.
                     generate_driver_scripts(config_file, config)
-                    print " -- Set up driver script in {}".format(work_dir)
+                    print(" -- Set up driver script in {}".format(work_dir))
 
     # Write the history of this command to the command_history file, for
     # provenance.
@@ -1795,7 +1798,7 @@ def get_case_name(config_file):  # {{{
             for case_num in case_list:
                 core_configuration = subprocess.check_output(
                     ['./list_testcases.py', '-n',
-                     '{:d}'.format(int(case_num))])
+                     '{:d}'.format(int(case_num))]).decode('utf-8')
                 config_options = core_configuration.strip('\n').split(' ')
                 history_file.write('\n')
                 history_file.write('    core: {}\n'.format(config_options[1]))
diff --git a/testing_and_setup/compass/utility_scripts/check_progress.py b/testing_and_setup/compass/utility_scripts/check_progress.py
index f04aee6834..b9fa841d94 100755
--- a/testing_and_setup/compass/utility_scripts/check_progress.py
+++ b/testing_and_setup/compass/utility_scripts/check_progress.py
@@ -7,8 +7,8 @@
 checks that the current date does not exceed the end
 date specified by the -e flag with format
 YYYY-MM-DD_hh:mm:ss. (Note: only years between 0001
-and 9999 are supported.)  If this date is exceeded, 
-exits 1, indicating that the run should stop.  
+and 9999 are supported.)  If this date is exceeded,
+exits 1, indicating that the run should stop.
 Otherwise, exits 0, indicating the run has not yet
 completed.
 
@@ -52,10 +52,12 @@
 
 A number of jobs could be chained with this script. If one of
 these jobs exits with exit status 1, this could be made to
-cancel dependent jobs (depending on the capabilities of the 
+cancel dependent jobs (depending on the capabilities of the
 job scheduler).  Even if not, the next job would immediately
 exit once it runs, thus using negligible computing time.
 """
+from __future__ import absolute_import, division, print_function, \
+    unicode_literals
 
 import os
 import argparse
@@ -91,6 +93,6 @@
 inFile.close()
 endDate = datetime.strptime(args.endDate, '%Y-%m-%d_%H:%M:%S')
 if restartDate >= endDate:
-    print 'Run has completed.'
+    print('Run has completed.')
     sys.exit(1)
 sys.exit(0)
diff --git a/testing_and_setup/compass/utility_scripts/compare_fields.py b/testing_and_setup/compass/utility_scripts/compare_fields.py
index 70dc8f53d2..e0c3e43cd0 100755
--- a/testing_and_setup/compass/utility_scripts/compare_fields.py
+++ b/testing_and_setup/compass/utility_scripts/compare_fields.py
@@ -1,8 +1,11 @@
 #!/usr/bin/env python
-import sys, os, glob, shutil
+from __future__ import absolute_import, division, print_function, \
+    unicode_literals
+
+import sys
+import os
 import numpy as np
 
-from netCDF4 import *
 from netCDF4 import Dataset as NetCDFFile
 import argparse
 
@@ -18,153 +21,153 @@
 args = parser.parse_args()
 
 if not args.filename1:
-	parser.error("Two filenames are required inputs.")
+    parser.error("Two filenames are required inputs.")
 
 if not args.filename2:
-	parser.error("Two filenames are required inputs.")
+    parser.error("Two filenames are required inputs.")
 
 if not args.variable:
-	parser.error("Variable is a required input.")
+    parser.error("Variable is a required input.")
 
 if (not args.l2_norm) and (not args.l1_norm) and (not args.linf_norm):
-	print "WARNING: Script will pass since no norm values have been defined."
+    print("WARNING: Script will pass since no norm values have been defined.")
 
 files_exist = True
 
 if not os.path.exists(args.filename1):
-	print "ERROR: File %s does not exist. Comparison will FAIL."%(args.filename1)
-	files_exist = False
+    print("ERROR: File %s does not exist. Comparison will FAIL."%(args.filename1))
+    files_exist = False
 
 if not os.path.exists(args.filename2):
-	print "ERROR: File %s does not exist. Comparison will FAIL."%(args.filename2)
-	files_exist = False
+    print("ERROR: File %s does not exist. Comparison will FAIL."%(args.filename2))
+    files_exist = False
 
 if not files_exist:
-	sys.exit(1)
+    sys.exit(1)
 
 f1 = NetCDFFile(args.filename1,'r')
 f2 = NetCDFFile(args.filename2,'r')
 
 try:
-	time_length = f1.variables['xtime'].shape[0]
+    time_length = f1.variables['xtime'].shape[0]
 except:
-	time_length = 1
+    time_length = 1
 
 try:
-	field1 = f1.variables[args.variable]
-	field2 = f2.variables[args.variable]
+    field1 = f1.variables[args.variable]
+    field2 = f2.variables[args.variable]
 except:
-	print "ERROR: Field '%s' does not exist in both"%(args.variable)
-	print "           file1: %s"%(args.filename1)
-	print "       and file2: %s"%(args.filename2)
-	print "Exiting with a failed comparision, since no comparision can be done but a comparison was requested."
-	sys.exit(1)
+    print("ERROR: Field '%s' does not exist in both"%(args.variable))
+    print("           file1: %s"%(args.filename1))
+    print("       and file2: %s"%(args.filename2))
+    print("Exiting with a failed comparision, since no comparision can be done but a comparison was requested.")
+    sys.exit(1)
 
 if not field1.shape == field2.shape:
-	print "ERROR: Field sizes don't match in different files."
-	sys.exit(1)
+    print("ERROR: Field sizes don't match in different files.")
+    sys.exit(1)
 
 linf_norm = -(sys.float_info.max)
 
 pass_val = True
 
-print "Beginning variable comparisons for all time levels of field '%s'. Note any time levels reported are 0-based."%(args.variable)
+print("Beginning variable comparisons for all time levels of field '%s'. Note any time levels reported are 0-based."%(args.variable))
 if ( args.l2_norm or args.l1_norm or args.linf_norm ):
-	print "    Pass thresholds are:"
-	if ( args.l1_norm ):
-		print "       L1: %16.14e"%(float(args.l1_norm))
-	if ( args.l2_norm ):
-		print "       L2: %16.14e"%(float(args.l2_norm))
-	if ( args.linf_norm ):
-		print "       L_Infinity: %16.14e"%(float(args.linf_norm))
+    print("    Pass thresholds are:")
+    if ( args.l1_norm ):
+        print("       L1: %16.14e"%(float(args.l1_norm)))
+    if ( args.l2_norm ):
+        print("       L2: %16.14e"%(float(args.l2_norm)))
+    if ( args.linf_norm ):
+        print("       L_Infinity: %16.14e"%(float(args.linf_norm)))
 
 field_dims = field1.dimensions
 
 if "Time" in field_dims:
-	for t in range( 0, time_length):
-		pass_time = True
-		if len(field_dims) >= 2:
-			diff = np.absolute(field1[t][:] - field2[t][:])
-		else:
-			diff = np.absolute(field1[t] - field2[t])
-
-		l2_norm = np.sum(diff * diff)
-		l2_norm = np.sqrt(l2_norm)
-
-		l1_norm = np.sum(diff)
-		if len(field_dims) >= 2:
-			l1_norm = l1_norm / np.sum(field1[t][:].shape)
-		l1_norm = np.max(l1_norm)
-
-		if np.amax(diff) > linf_norm:
-			linf_norm = np.amax(diff)
-
-		diff_str = '%d: '%(t)
-		if args.l1_norm:
-			if float(args.l1_norm) < l1_norm:
-				pass_time = False
-		diff_str = '%s l1: %16.14e '%(diff_str, l1_norm)
-
-		if args.l2_norm:
-			if float(args.l2_norm) < l2_norm:
-				pass_time = False
-		diff_str = '%s l2: %16.14e '%(diff_str, l2_norm)
-
-		if args.linf_norm:
-			if float(args.linf_norm) < linf_norm:
-				pass_time = False
-		diff_str = '%s linf: %16.14e '%(diff_str, linf_norm)
-
-		if not args.quiet:
-			print diff_str
-		elif not pass_time:
-			print diff_str
-
-		if not pass_time:
-			pass_val = False
-
-		del diff
+    for t in range( 0, time_length):
+        pass_time = True
+        if len(field_dims) >= 2:
+            diff = np.absolute(field1[t][:] - field2[t][:])
+        else:
+            diff = np.absolute(field1[t] - field2[t])
+
+        l2_norm = np.sum(diff * diff)
+        l2_norm = np.sqrt(l2_norm)
+
+        l1_norm = np.sum(diff)
+        if len(field_dims) >= 2:
+            l1_norm = l1_norm / np.sum(field1[t][:].shape)
+        l1_norm = np.max(l1_norm)
+
+        if np.amax(diff) > linf_norm:
+            linf_norm = np.amax(diff)
+
+        diff_str = '%d: '%(t)
+        if args.l1_norm:
+            if float(args.l1_norm) < l1_norm:
+                pass_time = False
+        diff_str = '%s l1: %16.14e '%(diff_str, l1_norm)
+
+        if args.l2_norm:
+            if float(args.l2_norm) < l2_norm:
+                pass_time = False
+        diff_str = '%s l2: %16.14e '%(diff_str, l2_norm)
+
+        if args.linf_norm:
+            if float(args.linf_norm) < linf_norm:
+                pass_time = False
+        diff_str = '%s linf: %16.14e '%(diff_str, linf_norm)
+
+        if not args.quiet:
+            print(diff_str)
+        elif not pass_time:
+            print(diff_str)
+
+        if not pass_time:
+            pass_val = False
+
+        del diff
 else:
-	if len(field_dims) >= 2:
-		diff = np.absolute(field1[:] - field2[:])
-	else:
-		diff = np.absolute(field1[0] - field2[0])
+    if len(field_dims) >= 2:
+        diff = np.absolute(field1[:] - field2[:])
+    else:
+        diff = np.absolute(field1[0] - field2[0])
 
-	l2_norm = np.sum(diff * diff)
-	l2_norm = np.sqrt(l2_norm)
+    l2_norm = np.sum(diff * diff)
+    l2_norm = np.sqrt(l2_norm)
 
-	l1_norm = np.sum(diff)
-	if len(field_dims) >= 2:
-		l1_norm = l1_norm / np.sum(field1[:].shape)
-	l1_norm = np.max(l1_norm)
+    l1_norm = np.sum(diff)
+    if len(field_dims) >= 2:
+        l1_norm = l1_norm / np.sum(field1[:].shape)
+    l1_norm = np.max(l1_norm)
 
-	if np.amax(diff) > linf_norm:
-		linf_norm = np.amax(diff)
+    if np.amax(diff) > linf_norm:
+        linf_norm = np.amax(diff)
 
-	diff_str = ''
-	if args.l1_norm:
-		if float(args.l1_norm) < l1_norm:
-			pass_val = False
-	diff_str = '%s l1: %16.14e '%(diff_str, l1_norm)
+    diff_str = ''
+    if args.l1_norm:
+        if float(args.l1_norm) < l1_norm:
+            pass_val = False
+    diff_str = '%s l1: %16.14e '%(diff_str, l1_norm)
 
-	if args.l2_norm:
-		if float(args.l2_norm) < l2_norm:
-			pass_val = False
-	diff_str = '%s l2: %16.14e '%(diff_str, l2_norm)
+    if args.l2_norm:
+        if float(args.l2_norm) < l2_norm:
+            pass_val = False
+    diff_str = '%s l2: %16.14e '%(diff_str, l2_norm)
 
-	if args.linf_norm:
-		if float(args.linf_norm) < linf_norm:
-			pass_val = False
-	diff_str = '%s linf: %16.14e '%(diff_str, linf_norm)
+    if args.linf_norm:
+        if float(args.linf_norm) < linf_norm:
+            pass_val = False
+    diff_str = '%s linf: %16.14e '%(diff_str, linf_norm)
 
-	if not args.quiet:
-		print diff_str
-	elif not pass_val:
-		print diff_str
+    if not args.quiet:
+        print(diff_str)
+    elif not pass_val:
+        print(diff_str)
 
-	del diff
+    del diff
 
 if pass_val:
-	sys.exit(0)
+    sys.exit(0)
 else:
-	sys.exit(1)
+    sys.exit(1)
diff --git a/testing_and_setup/compass/utility_scripts/compare_timers.py b/testing_and_setup/compass/utility_scripts/compare_timers.py
index cf8bc86df9..018157b9ae 100755
--- a/testing_and_setup/compass/utility_scripts/compare_timers.py
+++ b/testing_and_setup/compass/utility_scripts/compare_timers.py
@@ -1,49 +1,52 @@
 #!/usr/bin/env python
+from __future__ import absolute_import, division, print_function, \
+    unicode_literals
 
-import sys, os, fnmatch
+import os
+import fnmatch
 import argparse
 import re
 
 def find_timer_value(timer_name, directory):#{{{
-	# Build a regular expression for any two characters with a space between them.
-	regex = re.compile(r'(\S) (\S)')
+    # Build a regular expression for any two characters with a space between them.
+    regex = re.compile(r'(\S) (\S)')
 
-	sub_timer_name = timer_name.replace(' ', '_')
+    sub_timer_name = timer_name.replace(' ', '_')
 
-	timer = 0.0
-	timer_found = False
-	for file in os.listdir(directory):
-		if not timer_found:
-			process_file = False
-			# Compare files written using built in MPAS timers
-			if fnmatch.fnmatch(file, "log.*.out"):
-				timer_line_size = 6
-				name_index = 0
-				total_index = 1
-				process_file = True
-			# Compare files written using GPTL timers
-			elif fnmatch.fnmatch(file, "timing.*"):
-				timer_line_size = 6
-				name_index = 0
-				total_index = 3
-				process_file = True
+    timer = 0.0
+    timer_found = False
+    for file in os.listdir(directory):
+        if not timer_found:
+            process_file = False
+            # Compare files written using built in MPAS timers
+            if fnmatch.fnmatch(file, "log.*.out"):
+                timer_line_size = 6
+                name_index = 0
+                total_index = 1
+                process_file = True
+            # Compare files written using GPTL timers
+            elif fnmatch.fnmatch(file, "timing.*"):
+                timer_line_size = 6
+                name_index = 0
+                total_index = 3
+                process_file = True
 
-			if process_file:
-				stats_file = open('%s/%s'%(directory, file), "r")
-				for block in iter(lambda: stats_file.readline(), ""):
-					new_block = regex.sub(r"\1_\2", block[2:])
-					new_block_arr = new_block.split()
-					if len(new_block_arr) >= timer_line_size:
-						if sub_timer_name.find(new_block_arr[name_index]) >= 0:
-							try:
-								timer = timer + float(new_block_arr[total_index])
-								timer_found = True
-							except ValueError:
-								timer = timer
-						del new_block
-					del new_block_arr
+            if process_file:
+                stats_file = open('%s/%s'%(directory, file), "r")
+                for block in iter(lambda: stats_file.readline(), ""):
+                    new_block = regex.sub(r"\1_\2", block[2:])
+                    new_block_arr = new_block.split()
+                    if len(new_block_arr) >= timer_line_size:
+                        if sub_timer_name.find(new_block_arr[name_index]) >= 0:
+                            try:
+                                timer = timer + float(new_block_arr[total_index])
+                                timer_found = True
+                            except ValueError:
+                                timer = timer
+                        del new_block
+                    del new_block_arr
 
-	return timer_found, timer
+    return timer_found, timer
 #}}}
 
 # Define and process input arguments
@@ -59,18 +62,18 @@ def find_timer_value(timer_name, directory):#{{{
 timer2_found, timer2 = find_timer_value(args.timer, args.comparison_directory)
 
 if timer1_found and timer2_found:
-	try:
-		speedup = timer1 / timer2
-	except:
-		speedup = 1.0
+    try:
+        speedup = timer1 / timer2
+    except:
+        speedup = 1.0
 
-	percent = (timer2 - timer1) / timer1
+    percent = (timer2 - timer1) / timer1
 
-	if not args.speedup:
-		print "Comparing timer %s:"%(args.timer)
-		print "             Base: %lf"%(timer1)
-		print "          Compare: %lf"%(timer2)
-		print "   Percent Change: %lf%%"%(percent*100)
-		print "          Speedup: %lf"%(speedup)
-	else:
-		print "%lf"%(speedup)
+    if not args.speedup:
+        print("Comparing timer %s:"%(args.timer))
+        print("             Base: %lf"%(timer1))
+        print("          Compare: %lf"%(timer2))
+        print("   Percent Change: %lf%%"%(percent*100))
+        print("          Speedup: %lf"%(speedup))
+    else:
+        print("%lf"%(speedup))
diff --git a/testing_and_setup/compass/utility_scripts/make_graph_file.py b/testing_and_setup/compass/utility_scripts/make_graph_file.py
index 2fd2b1c360..cbbac6a4eb 100755
--- a/testing_and_setup/compass/utility_scripts/make_graph_file.py
+++ b/testing_and_setup/compass/utility_scripts/make_graph_file.py
@@ -1,4 +1,7 @@
 #!/usr/bin/env python
+from __future__ import absolute_import, division, print_function, \
+    unicode_literals
+
 import os
 import numpy as np
 
@@ -14,10 +17,10 @@
 args = parser.parse_args()
 
 if not args.weight_field:
-	print "Weight field missing. Defaulting to unweighted graphs."
-	weighted_parts = False
+    print("Weight field missing. Defaulting to unweighted graphs.")
+    weighted_parts = False
 else:
-	weighted_parts = True
+    weighted_parts = True
 
 dev_null = open(os.devnull, 'w')
 grid = NetCDFFile(args.filename, 'r')
@@ -28,34 +31,34 @@
 nEdgesOnCell = grid.variables['nEdgesOnCell'][:]
 cellsOnCell = grid.variables['cellsOnCell'][:] - 1
 if weighted_parts:
-	try:
-		weights = grid.variables[args.weight_field][:]
-	except:
-		print args.weight_field, ' not found in file. Defaulting to un-weighted partitions.'
-		weighted_parts = False
+    try:
+        weights = grid.variables[args.weight_field][:]
+    except:
+        print(args.weight_field, ' not found in file. Defaulting to un-weighted partitions.')
+        weighted_parts = False
 grid.close()
 
 nEdges = 0
 for i in np.arange(0, nCells):
-	for j in np.arange(0,nEdgesOnCell[i]):
-		if cellsOnCell[i][j] != -1:
-			nEdges = nEdges + 1
+    for j in np.arange(0,nEdgesOnCell[i]):
+        if cellsOnCell[i][j] != -1:
+            nEdges = nEdges + 1
 
 nEdges = nEdges/2
 
 graph = open('graph.info', 'w+')
 if weighted_parts:
-	graph.write('%s %s 010\n'%(nCells, nEdges))
+    graph.write('%s %s 010\n'%(nCells, nEdges))
 else:
-	graph.write('%s %s\n'%(nCells, nEdges))
+    graph.write('%s %s\n'%(nCells, nEdges))
 
 for i in np.arange(0, nCells):
-	if weighted_parts:
-		graph.write('%s '%int(weights[i]))
+    if weighted_parts:
+        graph.write('%s '%int(weights[i]))
 
-	for j in np.arange(0,nEdgesOnCell[i]):
-		if(cellsOnCell[i][j] >= 0):
-			graph.write('%s '%(cellsOnCell[i][j]+1))
-	graph.write('\n')
+    for j in np.arange(0,nEdgesOnCell[i]):
+        if(cellsOnCell[i][j] >= 0):
+            graph.write('%s '%(cellsOnCell[i][j]+1))
+    graph.write('\n')
 graph.close()
 
diff --git a/testing_and_setup/compass/utility_scripts/make_parameter_study_configs.py b/testing_and_setup/compass/utility_scripts/make_parameter_study_configs.py
index a3667ab007..59e6dd0491 100755
--- a/testing_and_setup/compass/utility_scripts/make_parameter_study_configs.py
+++ b/testing_and_setup/compass/utility_scripts/make_parameter_study_configs.py
@@ -11,6 +11,8 @@
 The number of parameter values must be the same for all parameters and all
 parameters are varied simultaneously.
 """
+from __future__ import absolute_import, division, print_function, \
+    unicode_literals
 
 import argparse
 
diff --git a/testing_and_setup/compass/utility_scripts/setup_restart.py b/testing_and_setup/compass/utility_scripts/setup_restart.py
index 3ae6f22d7c..6685c18794 100755
--- a/testing_and_setup/compass/utility_scripts/setup_restart.py
+++ b/testing_and_setup/compass/utility_scripts/setup_restart.py
@@ -11,6 +11,8 @@
 the first beginning from an initial-condition file
 and subsequent runs continuing from a restart file.
 """
+from __future__ import absolute_import, division, print_function, \
+    unicode_literals
 
 import os
 import argparse